From a4f04fcb02d76d9903c5bbc65827565bad6c2d8c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 20 Nov 2014 15:15:28 -0400 Subject: [PATCH] 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 | 7 +- src/Propellor/Types.hs | 1 + 7 files changed, 103 insertions(+), 21 deletions(-) rename src/Propellor/{Property/Docker => }/Shim.hs (89%) diff --git a/propellor.cabal b/propellor.cabal index 7f2b237..23708fd 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 061c970..466b60f 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 3fa9ffc..0cbf624 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 e504693..38e09b5 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 92cc124..5cf60ff 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/Shim.hs similarity index 89% rename from src/Propellor/Property/Docker/Shim.hs rename to src/Propellor/Shim.hs index c2f35d0..5b5aa68 100644 --- a/src/Propellor/Property/Docker/Shim.hs +++ b/src/Propellor/Shim.hs @@ -1,9 +1,10 @@ --- | Support for running propellor, as built outside a docker container, --- inside the container. +-- | 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.Property.Docker.Shim (setup, cleanEnv, file) where +module Propellor.Shim (setup, cleanEnv, file) where import Propellor import Utility.LinuxMkLibs diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs index 16ddcc7..56eafc6 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)