From 7115d1ec162b4059b3e8e8f84bd8d5898c1db025 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 May 2014 19:41:05 -0400 Subject: moved source code to src This is to work around OSX's brain-damange regarding filename case insensitivity. Avoided moving config.hs, because it's a config file. Put in a symlink to make build work. --- src/Propellor/Property/Docker/Shim.hs | 61 +++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 src/Propellor/Property/Docker/Shim.hs (limited to 'src/Propellor/Property/Docker') diff --git a/src/Propellor/Property/Docker/Shim.hs b/src/Propellor/Property/Docker/Shim.hs new file mode 100644 index 00000000..c2f35d0c --- /dev/null +++ b/src/Propellor/Property/Docker/Shim.hs @@ -0,0 +1,61 @@ +-- | Support for running propellor, as built outside a docker container, +-- inside the container. +-- +-- Note: This is currently Debian specific, due to glibcLibs. + +module Propellor.Property.Docker.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 -- cgit v1.2.3