From 1c381c5246b2836ca0f535b9ac65eddcaa000024 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 3 Apr 2014 21:22:37 -0400 Subject: [PATCH] library shimming for docker (untested) --- Propellor/Property/Docker.hs | 38 ++++++++++--------- Propellor/Property/Docker/Shim.hs | 52 ++++++++++++++++++++++++++ Utility/LinuxMkLibs.hs | 61 +++++++++++++++++++++++++++++++ propellor.cabal | 2 + 4 files changed, 136 insertions(+), 17 deletions(-) create mode 100644 Propellor/Property/Docker/Shim.hs create mode 100644 Utility/LinuxMkLibs.hs diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index 5f819f2..88adb06 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -4,13 +4,6 @@ -- -- The existance of a docker container is just another Property of a system, -- which propellor can set up. See config.hs for an example. --- --- Note that propellor provisions a container by running itself, inside the --- container. Currently, to avoid the overhead of building propellor --- inside the container, the binary from outside is reused inside. --- So, the libraries that propellor is linked against need to be available --- in the container with compatable versions. This can cause a problem --- if eg, mixing Debian stable and unstable. module Propellor.Property.Docker where @@ -18,6 +11,7 @@ import Propellor import Propellor.SimpleSh import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Docker.Shim as Shim import Utility.SafeCommand import Utility.Path @@ -256,15 +250,14 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci , name (fromContainerId cid) ] - chaincmd = [localdir "propellor", "--docker", fromContainerId cid] - go img = do clearProvisionedFlag cid createDirectoryIfMissing True (takeDirectory $ identFile cid) + shim <- Shim.setup "./propellor" (localdir shimdir cid) writeFile (identFile cid) (show ident) ensureProperty $ boolProperty "run" $ runContainer img (runps ++ ["-i", "-d", "-t"]) - chaincmd + [shim, "--docker", fromContainerId cid] -- | Called when propellor is running inside a docker container. -- The string should be the container's ContainerId. @@ -290,8 +283,9 @@ chain s = case toContainerId s of writeFile propellorIdent . show =<< readIdentFile cid -- Run boot provisioning before starting simpleSh, -- to avoid ever provisioning twice at the same time. - whenM (checkProvisionedFlag cid) $ - unlessM (boolSystem "./propellor" [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $ + whenM (checkProvisionedFlag cid) $ do + let shim = Shim.file "./propellor" (localdir shimdir cid) + unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain $ fromContainerId cid]) $ warningMessage "Boot provision failed!" void $ async $ simpleSh $ namedPipe cid forever $ do @@ -310,7 +304,8 @@ chain s = case toContainerId s of -- 1 minute. provisionContainer :: ContainerId -> Property provisionContainer cid = containerDesc cid $ Property "provision" $ do - r <- simpleShClientRetry 60 (namedPipe cid) "./propellor" params (go Nothing) + let shim = Shim.file "./propellor" (localdir shimdir cid) + r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing) when (r /= FailedChange) $ setProvisionedFlag cid return r @@ -342,11 +337,17 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId stoppedContainer :: ContainerId -> Property stoppedContainer cid = containerDesc cid $ Property desc $ ifM (elem cid <$> listContainers RunningContainers) - ( ensureProperty $ boolProperty desc $ stopContainer cid + ( cleanup `after` ensureProperty + (boolProperty desc $ stopContainer cid) , return NoChange ) where desc = "stopped" + cleanup = do + nukeFile $ namedPipe cid + nukeFile $ identFile cid + removeDirectoryRecursive $ shimdir cid + clearProvisionedFlag cid removeContainer :: ContainerId -> IO Bool removeContainer cid = catchBoolIO $ @@ -396,10 +397,10 @@ propellorIdent = "/.propellor-ident" -- | Named pipe used for communication with the container. namedPipe :: ContainerId -> FilePath -namedPipe cid = "docker/" ++ fromContainerId cid +namedPipe cid = "docker" fromContainerId cid provisionedFlag :: ContainerId -> FilePath -provisionedFlag cid = "docker/" ++ fromContainerId cid ++ ".provisioned" +provisionedFlag cid = "docker" fromContainerId cid ++ ".provisioned" clearProvisionedFlag :: ContainerId -> IO () clearProvisionedFlag = nukeFile . provisionedFlag @@ -412,8 +413,11 @@ setProvisionedFlag cid = do checkProvisionedFlag :: ContainerId -> IO Bool checkProvisionedFlag = doesFileExist . provisionedFlag +shimdir :: ContainerId -> FilePath +shimdir cid = "docker" fromContainerId cid ++ ".shim" + identFile :: ContainerId -> FilePath -identFile cid = "docker/" ++ fromContainerId cid ++ ".ident" +identFile cid = "docker" fromContainerId cid ++ ".ident" readIdentFile :: ContainerId -> IO ContainerIdent readIdentFile cid = fromMaybe (error "bad ident in identFile") diff --git a/Propellor/Property/Docker/Shim.hs b/Propellor/Property/Docker/Shim.hs new file mode 100644 index 0000000..0e0f55e --- /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 diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs new file mode 100644 index 0000000..76e6266 --- /dev/null +++ b/Utility/LinuxMkLibs.hs @@ -0,0 +1,61 @@ +{- Linux library copier and binary shimmer + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.LinuxMkLibs where + +import Control.Applicative +import Data.Maybe +import System.Directory +import Data.List.Utils +import System.Posix.Files +import Data.Char +import Control.Monad.IfElse + +import Utility.PartialPrelude +import Utility.Directory +import Utility.Process +import Utility.Monad +import Utility.Path + +{- Installs a library. If the library is a symlink to another file, + - install the file it links to, and update the symlink to be relative. -} +installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath) +installLib installfile top lib = ifM (doesFileExist lib) + ( do + installfile top lib + checksymlink lib + return $ Just $ parentDir lib + , return Nothing + ) + where + checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do + l <- readSymbolicLink (inTop top f) + let absl = absPathFrom (parentDir f) l + let target = relPathDirToFile (parentDir f) absl + installfile top absl + nukeFile (top ++ f) + createSymbolicLink target (inTop top f) + checksymlink absl + +-- Note that f is not relative, so cannot use +inTop :: FilePath -> FilePath -> FilePath +inTop top f = top ++ f + +{- Parse ldd output, getting all the libraries that the input files + - link to. Note that some of the libraries may not exist + - (eg, linux-vdso.so) -} +parseLdd :: String -> [FilePath] +parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines + where + getlib l = headMaybe . words =<< lastMaybe (split " => " l) + +{- Get all glibc libs and other support files, including gconv files + - + - XXX Debian specific. -} +glibcLibs :: IO [FilePath] +glibcLibs = lines <$> readProcess "sh" + ["-c", "dpkg -L libc6:$(dpkg --print-architecture) libgcc1:$(dpkg --print-architecture) | egrep '\\.so|gconv'"] diff --git a/propellor.cabal b/propellor.cabal index b06d107..c85a3e7 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -87,6 +87,7 @@ Library Other-Modules: Propellor.CmdLine Propellor.SimpleSh + Propellor.Property.Docker.Shim Utility.Applicative Utility.Data Utility.Directory @@ -94,6 +95,7 @@ Library Utility.Exception Utility.FileMode Utility.FileSystemEncoding + Utility.LinuxMkLibs Utility.Misc Utility.Monad Utility.Path