summaryrefslogtreecommitdiff
path: root/src/Propellor/Shim.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-20 15:15:28 -0400
committerJoey Hess2014-11-20 15:15:28 -0400
commita4f04fcb02d76d9903c5bbc65827565bad6c2d8c (patch)
treeda5e6584ca447a0091b2001bae3d9033095b5339 /src/Propellor/Shim.hs
parent4d155864fadb5571d788ed645c842ad853f55d71 (diff)
propellor spin
Diffstat (limited to 'src/Propellor/Shim.hs')
-rw-r--r--src/Propellor/Shim.hs62
1 files changed, 62 insertions, 0 deletions
diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs
new file mode 100644
index 00000000..5b5aa68e
--- /dev/null
+++ b/src/Propellor/Shim.hs
@@ -0,0 +1,62 @@
+-- | Support for running propellor, as built outside a container,
+-- inside the container, without needing to install anything into the
+-- container.
+--
+-- Note: This is currently Debian specific, due to glibcLibs.
+
+module Propellor.Shim (setup, cleanEnv, file) where
+
+import Propellor
+import Utility.LinuxMkLibs
+import Utility.SafeCommand
+import Utility.Path
+import Utility.FileMode
+
+import Data.List
+import System.Posix.Files
+
+-- | Sets up a shimmed version of the program, in a directory, and
+-- returns its path.
+setup :: FilePath -> FilePath -> IO FilePath
+setup propellorbin dest = do
+ createDirectoryIfMissing True dest
+
+ libs <- parseLdd <$> readProcess "ldd" [propellorbin]
+ glibclibs <- glibcLibs
+ let libs' = nub $ libs ++ glibclibs
+ libdirs <- map (dest ++) . nub . catMaybes
+ <$> mapM (installLib installFile dest) libs'
+
+ let linker = (dest ++) $
+ fromMaybe (error "cannot find ld-linux linker") $
+ headMaybe $ filter ("ld-linux" `isInfixOf`) libs'
+ let gconvdir = (dest ++) $ parentDir $
+ fromMaybe (error "cannot find gconv directory") $
+ headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs
+ let linkerparams = ["--library-path", intercalate ":" libdirs ]
+ let shim = file propellorbin dest
+ writeFile shim $ unlines
+ [ "#!/bin/sh"
+ , "GCONV_PATH=" ++ shellEscape gconvdir
+ , "export GCONV_PATH"
+ , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++
+ " " ++ shellEscape propellorbin ++ " \"$@\""
+ ]
+ modifyFileMode shim (addModes executeModes)
+ return shim
+
+cleanEnv :: IO ()
+cleanEnv = void $ unsetEnv "GCONV_PATH"
+
+file :: FilePath -> FilePath -> FilePath
+file propellorbin dest = dest </> takeFileName propellorbin
+
+installFile :: FilePath -> FilePath -> IO ()
+installFile top f = do
+ createDirectoryIfMissing True destdir
+ nukeFile dest
+ createLink f dest `catchIO` (const copy)
+ where
+ copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
+ destdir = inTop top $ parentDir f
+ dest = inTop top f