From a4f04fcb02d76d9903c5bbc65827565bad6c2d8c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 20 Nov 2014 15:15:28 -0400 Subject: propellor spin --- propellor.cabal | 2 +- src/Propellor/CmdLine.hs | 6 ++- src/Propellor/Engine.hs | 18 +++++++++ src/Propellor/Property/Chroot.hs | 76 +++++++++++++++++++++++++++++++++-- src/Propellor/Property/Docker.hs | 14 +------ src/Propellor/Property/Docker/Shim.hs | 61 ---------------------------- src/Propellor/Shim.hs | 62 ++++++++++++++++++++++++++++ src/Propellor/Types.hs | 1 + 8 files changed, 161 insertions(+), 79 deletions(-) delete mode 100644 src/Propellor/Property/Docker/Shim.hs create mode 100644 src/Propellor/Shim.hs diff --git a/propellor.cabal b/propellor.cabal index 7f2b2376..23708fd2 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -121,7 +121,7 @@ Library Propellor.Ssh Propellor.PrivData.Paths Propellor.Protocol - Propellor.Property.Docker.Shim + Propellor.Shim Utility.Applicative Utility.Data Utility.Directory diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 061c9700..466b60f5 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -15,7 +15,8 @@ import Propellor.Git import Propellor.Ssh import Propellor.Server import qualified Propellor.Property.Docker as Docker -import qualified Propellor.Property.Docker.Shim as DockerShim +import qualified Propellor.Property.Chroot as Chroot +import qualified Propellor.Shim as Shim import Utility.SafeCommand usage :: Handle -> IO () @@ -72,7 +73,7 @@ processCmdLine = go =<< getArgs -- | Runs propellor on hosts, as controlled by command-line options. defaultMain :: [Host] -> IO () defaultMain hostlist = do - DockerShim.cleanEnv + Shim.cleanEnv checkDebugMode cmdline <- processCmdLine debug ["command line: ", show cmdline] @@ -85,6 +86,7 @@ defaultMain hostlist = do go _ ListFields = listPrivDataFields hostlist go _ (AddKey keyid) = addKey keyid go _ (DockerChain hn cid) = Docker.chain hostlist hn cid + go _ (ChrootChain hn loc) = Chroot.chain hostlist hn loc go _ (DockerInit hn) = Docker.init hn go _ (GitPush fin fout) = gitPushHelper fin fout go _ (Update _) = forceConsole >> fetchFirst (onlyprocess update) diff --git a/src/Propellor/Engine.hs b/src/Propellor/Engine.hs index 3fa9ffc0..0cbf6247 100644 --- a/src/Propellor/Engine.hs +++ b/src/Propellor/Engine.hs @@ -11,12 +11,15 @@ import "mtl" Control.Monad.Reader import Control.Exception (bracket) import System.PosixCompat import System.Posix.IO +import Data.Maybe import Propellor.Types import Propellor.Message import Propellor.Exception import Propellor.Info import Utility.Exception +import Utility.PartialPrelude +import Utility.Monad runPropellor :: Host -> Propellor a -> IO a runPropellor host a = runReaderT (runWithHost a) host @@ -62,3 +65,18 @@ onlyProcess lockfile a = bracket lock unlock (const a) return l unlock = closeFd alreadyrunning = error "Propellor is already running on this host!" + +-- | Reads and displays each line from the Handle, except for the last line +-- which is a Result. +processChainOutput :: Handle -> IO Result +processChainOutput h = go Nothing + where + go lastline = do + v <- catchMaybeIO (hGetLine h) + case v of + Nothing -> pure $ fromMaybe FailedChange $ + readish =<< lastline + Just s -> do + maybe noop putStrLn lastline + hFlush stdout + go (Just s) diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index e5046937..38e09b52 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -2,12 +2,17 @@ module Propellor.Property.Chroot ( Chroot, chroot, provisioned, + chain, ) where import Propellor import qualified Propellor.Property.Debootstrap as Debootstrap +import qualified Propellor.Shim as Shim +import Utility.SafeCommand import qualified Data.Map as M +import Data.List.Utils +import System.Posix.Directory data Chroot = Chroot FilePath System Host @@ -35,8 +40,7 @@ provisioned c@(Chroot loc system _) = RevertableProperty (propigateChrootInfo c (go "exists" setup)) (go "removed" teardown) where - go desc a = property ("chroot " ++ loc ++ " " ++ desc) $ do - ensureProperties [a] + go desc a = property (chrootDesc c desc) $ ensureProperties [a] setup = provisionChroot c `requires` built @@ -53,5 +57,71 @@ propigateChrootInfo c@(Chroot loc _ h) p = propigateInfo c p (<> chrootinfo) where chrootinfo = mempty $ mempty { _chroots = M.singleton loc h } +-- | Propellor is run inside the chroot to provision it. +-- +-- Strange and wonderful tricks let the host's /usr/local/propellor +-- be used inside the chroot, without needing to install anything. provisionChroot :: Chroot -> Property -provisionChroot = undefined +provisionChroot c@(Chroot loc _ _) = property (chrootDesc c "provisioned") $ do + let d = localdir shimdir c + let me = localdir "propellor" + shim <- liftIO $ ifM (doesDirectoryExist d) + ( pure (Shim.file me d) + , Shim.setup me d + ) + ifM (liftIO $ bindmount shim) + ( chainprovision shim + , return FailedChange + ) + where + bindmount shim = ifM (doesFileExist (loc ++ shim)) + ( return True + , do + let mntpnt = loc ++ localdir + createDirectoryIfMissing True mntpnt + boolSystem "mount" + [ Param "--bind" + , File localdir, File mntpnt + ] + ) + + chainprovision shim = do + parenthost <- asks hostName + let p = inChrootProcess c + [ shim + , "--continue" + , show $ toChain parenthost c + ] + liftIO $ withHandle StdoutHandle createProcessSuccess p + processChainOutput + +toChain :: HostName -> Chroot -> CmdLine +toChain parenthost (Chroot loc _ _) = ChrootChain parenthost loc + +chain :: [Host] -> HostName -> FilePath -> IO () +chain hostlist hn loc = case findHostNoAlias hostlist hn of + Nothing -> errorMessage ("cannot find host " ++ hn) + Just parenthost -> case M.lookup loc (_chroots $ _chrootinfo $ hostInfo parenthost) of + Nothing -> errorMessage ("cannot find chroot " ++ loc ++ " on host " ++ hn) + Just h -> go h + where + go h = do + changeWorkingDirectory localdir + onlyProcess (provisioningLock loc) $ do + r <- runPropellor h $ ensureProperties $ hostProperties h + putStrLn $ "\n" ++ show r + +inChrootProcess :: Chroot -> [String] -> CreateProcess +inChrootProcess (Chroot loc _ _) cmd = proc "chroot" (loc:cmd) + +provisioningLock :: FilePath -> FilePath +provisioningLock containerloc = "chroot" mungeloc containerloc ++ ".lock" + +shimdir :: Chroot -> FilePath +shimdir (Chroot loc _ _) = "chroot" mungeloc loc ++ ".shim" + +mungeloc :: FilePath -> String +mungeloc = replace "/" "_" + +chrootDesc :: Chroot -> String -> String +chrootDesc (Chroot loc _ _) desc = "chroot " ++ loc ++ " " ++ desc diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 92cc124a..5cf60ff9 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -41,7 +41,7 @@ module Propellor.Property.Docker ( import Propellor hiding (init) import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt -import qualified Propellor.Property.Docker.Shim as Shim +import qualified Propellor.Shim as Shim import Utility.SafeCommand import Utility.Path import Utility.ThreadScheduler @@ -432,20 +432,10 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d [ if isConsole msgh then "-it" else "-i" ] (shim : params) r <- withHandle StdoutHandle createProcessSuccess p $ - processoutput Nothing + processChainOutput when (r /= FailedChange) $ setProvisionedFlag cid return r - where - processoutput lastline h = do - v <- catchMaybeIO (hGetLine h) - case v of - Nothing -> pure $ fromMaybe FailedChange $ - readish =<< lastline - Just s -> do - maybe noop putStrLn lastline - hFlush stdout - processoutput (Just s) h toChain :: ContainerId -> CmdLine toChain cid = DockerChain (containerHostName cid) (fromContainerId cid) diff --git a/src/Propellor/Property/Docker/Shim.hs b/src/Propellor/Property/Docker/Shim.hs deleted file mode 100644 index c2f35d0c..00000000 --- a/src/Propellor/Property/Docker/Shim.hs +++ /dev/null @@ -1,61 +0,0 @@ --- | 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 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 diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 16ddcc7d..56eafc6d 100644 --- a/src/Propellor/Types.hs +++ b/src/Propellor/Types.hs @@ -155,6 +155,7 @@ data CmdLine | Update HostName | DockerInit HostName | DockerChain HostName String + | ChrootChain HostName FilePath | GitPush Fd Fd deriving (Read, Show, Eq) -- cgit v1.2.3