From 1c381c5246b2836ca0f535b9ac65eddcaa000024 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 21:22:37 -0400 Subject: library shimming for docker (untested) --- Propellor/Property/Docker/Shim.hs | 52 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 Propellor/Property/Docker/Shim.hs (limited to 'Propellor/Property/Docker') diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs new file mode 100644 index 00000000..0e0f55e7 --- /dev/null +++ b/Propellor/Property/Docker/Shim.hs @@ -0,0 +1,52 @@ +-- | 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, 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 linkerparams = ["--library-path", intercalate ":" libdirs ] + let shim = file propellorbin dest + writeFile shim $ unlines + [ "#!/bin/sh" + , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++ + " " ++ shellEscape propellorbin ++ " \"$@\"" + ] + modifyFileMode shim (addModes executeModes) + return shim + +file :: FilePath -> FilePath -> FilePath +file propellorbin dest = dest propellorbin + +installFile :: FilePath -> FilePath -> IO () +installFile top f = do + createDirectoryIfMissing True destdir + 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.3-2-g0d8e From 5499b2a612d9379fc8a3ed3ea2e70165e0bdefad Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:16:34 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'Propellor/Property/Docker') diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index 0e0f55e7..402f1c12 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -45,6 +45,7 @@ file propellorbin dest = dest 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] -- cgit v1.3-2-g0d8e From fbc57d684509180f518c84469c45e2d85bb20708 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 23:35:36 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 2 +- Propellor/Property/Hostname.hs | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) (limited to 'Propellor/Property/Docker') diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index 402f1c12..a210e162 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -40,7 +40,7 @@ setup propellorbin dest = do return shim file :: FilePath -> FilePath -> FilePath -file propellorbin dest = dest propellorbin +file propellorbin dest = dest takeFileName propellorbin installFile :: FilePath -> FilePath -> IO () installFile top f = do diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs index f5aa5da7..a2e3c7c6 100644 --- a/Propellor/Property/Hostname.hs +++ b/Propellor/Property/Hostname.hs @@ -10,3 +10,5 @@ set :: HostName -> Property set hostname = "/etc/hostname" `File.hasContent` [hostname] `onChange` cmdProperty "hostname" [hostname] `describe` ("hostname " ++ hostname) + where + (host, domain) = separate (== '.') hostname -- cgit v1.3-2-g0d8e From ba8a259f24e15c1e1005bed628ceed8e374e963a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 00:29:19 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'Propellor/Property/Docker') diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index a210e162..7d4f56f6 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -29,10 +29,15 @@ setup propellorbin dest = do 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" + , "set GCONV_PATH=" ++ shellEscape gconvdir + , "export GCONV_PATH" , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++ " " ++ shellEscape propellorbin ++ " \"$@\"" ] -- cgit v1.3-2-g0d8e From eb8dcfd99513131f95e067d0480164684793b1e9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Apr 2014 00:44:29 -0400 Subject: propellor spin --- Propellor/Property/Docker/Shim.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Propellor/Property/Docker') diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs index 7d4f56f6..01c2b22f 100644 --- a/Propellor/Property/Docker/Shim.hs +++ b/Propellor/Property/Docker/Shim.hs @@ -36,7 +36,7 @@ setup propellorbin dest = do let shim = file propellorbin dest writeFile shim $ unlines [ "#!/bin/sh" - , "set GCONV_PATH=" ++ shellEscape gconvdir + , "GCONV_PATH=" ++ shellEscape gconvdir , "export GCONV_PATH" , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++ " " ++ shellEscape propellorbin ++ " \"$@\"" -- cgit v1.3-2-g0d8e