From 79cbdf35b1188d83e64a713efa82bc7a0a72a181 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 1 Apr 2014 13:51:58 -0400 Subject: better method of starting propellor simplesh inside docker --- Propellor/CmdLine.hs | 19 +-------- Propellor/PrivData.hs | 9 ---- Propellor/Property/Cron.hs | 1 - Propellor/Property/Docker.hs | 99 +++++++++++++++++++++++++++----------------- Propellor/SimpleSh.hs | 20 ++++++++- Propellor/Types.hs | 20 +++++++++ 6 files changed, 103 insertions(+), 65 deletions(-) (limited to 'Propellor') diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index 8edfe19e..73254165 100644 --- a/Propellor/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -9,21 +9,10 @@ import System.Log.Handler (setFormatter, LogHandler) import System.Log.Handler.Simple import Propellor -import Propellor.SimpleSh +import qualified Propellor.Property.Docker as Docker import Utility.FileMode import Utility.SafeCommand -data CmdLine - = Run HostName - | Spin HostName - | Boot HostName - | Set HostName PrivDataField - | AddKey String - | Continue CmdLine - | SimpleSh FilePath - | Chain HostName - deriving (Read, Show, Eq) - usage :: IO a usage = do putStrLn $ unlines @@ -49,7 +38,6 @@ processCmdLine = go =<< getArgs go ("--continue":s:[]) = case readish s of Just cmdline -> return $ Continue cmdline Nothing -> errorMessage "--continue serialization failure" - go ("--simplesh":f:[]) = return $ SimpleSh f go ("--chain":h:[]) = return $ Chain h go (h:[]) | "--" `isPrefixOf` h = usage @@ -71,8 +59,8 @@ defaultMain getprops = do go _ (Continue cmdline) = go False cmdline go _ (Set host field) = setPrivData host field go _ (AddKey keyid) = addKey keyid - go _ (SimpleSh f) = simpleSh f go _ (Chain host) = withprops host $ print <=< ensureProperties' + go _ (ChainDocker host) = Docker.chain host go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline go True cmdline = updateFirst cmdline $ go False cmdline go False (Spin host) = withprops host $ const $ spin host @@ -296,9 +284,6 @@ keyring = privDataDir "keyring.gpg" gpgopts :: [String] gpgopts = ["--options", "/dev/null", "--no-default-keyring", "--keyring", keyring] -localdir :: FilePath -localdir = "/usr/local/propellor" - getUrl :: IO String getUrl = maybe nourl return =<< getM get urls where diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs index 98a1da62..d97a7725 100644 --- a/Propellor/PrivData.hs +++ b/Propellor/PrivData.hs @@ -18,15 +18,6 @@ import Utility.Tmp import Utility.SafeCommand import Utility.Misc --- | Note that removing or changing field names will break the --- serialized privdata files, so don't do that! --- It's fine to add new fields. -data PrivDataField - = DockerAuthentication - | SshPrivKey UserName - | Password UserName - deriving (Read, Show, Ord, Eq) - withPrivData :: PrivDataField -> (String -> IO Result) -> IO Result withPrivData field a = maybe missing a =<< getPrivData field where diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs index 212e94e9..10e28ed7 100644 --- a/Propellor/Property/Cron.hs +++ b/Propellor/Property/Cron.hs @@ -3,7 +3,6 @@ module Propellor.Property.Cron where import Propellor import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt -import Propellor.CmdLine type CronTimes = String diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index 56ec0bde..d849497d 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -3,11 +3,13 @@ module Propellor.Property.Docker where import Propellor -import Propellor.CmdLine import Propellor.SimpleSh import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Utility.SafeCommand +import Utility.Path + +import Control.Concurrent.Async dockercmd :: String dockercmd = "docker.io" @@ -76,6 +78,9 @@ containerProperties findcontainer = \h -> case toContainerId h of Just (Container _ cprops) -> Just $ fromContainerized cprops +containerDesc :: ContainerId -> Desc -> Desc +containerDesc cid d = "docker container " ++ fromContainerId cid ++ " " ++ d + -- | Ensures that a docker container is set up and running. The container -- has its own Properties which are handled by running propellor -- inside the container. @@ -84,22 +89,20 @@ hasContainer -> ContainerName -> (HostName -> ContainerName -> Maybe (Container)) -> Property -hasContainer hn cn findcontainer = +hasContainer hn cn findcontainer = case findcontainer hn cn of - Nothing -> Property desc $ do + Nothing -> Property (containerDesc cid "") $ do warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid return FailedChange Just (Container image containerprops) -> - Property desc (provisionContainer cid) - `requires` - Property desc (ensureContainer cid image containerprops) + provisionContainer cid + `requires` + runningContainer cid image containerprops where cid = ContainerId hn cn - desc = "docker container " ++ fromContainerId cid - -ensureContainer :: ContainerId -> Image -> [Containerized Property] -> IO Result -ensureContainer cid@(ContainerId hn cn) image containerprops = do +runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property +runningContainer cid@(ContainerId hn cn) image containerprops = Property (containerDesc cid "running") $ do l <- listContainers RunningContainers if cid `elem` l then do @@ -123,11 +126,9 @@ ensureContainer cid@(ContainerId hn cn) image containerprops = do -- is also started, so the user can attach and use it if desired. startsimplesh = ["sh", "-c", "./propellor --simplesh " ++ namedPipe cid ++ " & bash -l"] - getrunningident = simpleShClient (namedPipe cid) "cat" [propellorIdent] $ - pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout - setrunningident = simpleShClient (namedPipe cid) "sh" - ["-c", "echo '" ++ show ident ++ "' > " ++ propellorIdent] - (const noop) + getrunningident = catchDefaultIO Nothing $ + simpleShClient (namedPipe cid) "cat" [propellorIdent] $ + pure . headMaybe . catMaybes . map readish . catMaybes . map getStdout runps = getRunParams $ containerprops ++ -- expose propellor directory inside the container @@ -140,15 +141,55 @@ ensureContainer cid@(ContainerId hn cn) image containerprops = do ] go img = ifM (runContainer img (runps ++ ["-i", "-d", "-t"]) startsimplesh) - ( do - setrunningident - return MadeChange + ( return MadeChange , return FailedChange ) -provisionContainer :: ContainerId -> IO Result -provisionContainer cid = do - simpleShClient (namedPipe cid) "./propellor" [show params] (go Nothing) +-- | Two containers with the same ContainerIdent were started from +-- the same base image (possibly a different version though), and +-- with the same RunParams. +data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam] + deriving (Read, Show, Eq) + +-- | The ContainerIdent of a container is written to +-- /.propellor-ident inside it. This can be checked to see if +-- the container has the same ident later. +propellorIdent :: FilePath +propellorIdent = "/.propellor-ident" + +-- | Named pipe used for communication with the container. +namedPipe :: ContainerId -> FilePath +namedPipe cid = "docker/" ++ fromContainerId cid + +-- | Called when propellor is running inside a docker container. +-- The string should be the container's ContainerIdent. +-- +-- Fork a thread to run the SimpleSh server in the background. +-- In the foreground, run an interactive bash (or sh) shell, +-- so that the user can interact with it when attached to the container. +chain :: String -> IO () +chain s = case readish s of + Nothing -> error $ "Invalid ContainerId: " ++ s + Just ident@(ContainerIdent _image hn cn _rp) -> do + let cid = ContainerId hn cn + writeFile propellorIdent (show ident) + t <- async $ simpleSh $ namedPipe cid + void $ ifM (inPath "bash") + ( boolSystem "bash" [Param "-l"] + , boolSystem "/bin/sh" [] + ) + wait t + +-- | Once a container is running, propellor can be run inside +-- it to provision it. +-- +-- Note that there is a race here, between the simplesh +-- server starting up in the container, and this property +-- being run. So, retry connections to the client for up to +-- 1 minute. +provisionContainer :: ContainerId -> Property +provisionContainer cid = Property (containerDesc cid "provision") $ + simpleShClientRetry 60 (namedPipe cid) "./propellor" [show params] (go Nothing) where params = Chain $ fromContainerId cid @@ -169,22 +210,6 @@ provisionContainer cid = do ret lastline = return $ fromMaybe FailedChange $ readish =<< lastline --- | Two containers with the same ContainerIdent were started from --- the same base image (possibly a different version though), and --- with the same RunParams. -data ContainerIdent = ContainerIdent Image HostName ContainerName [RunParam] - deriving (Read, Show, Eq) - --- | The ContainerIdent of a container is written to --- /.propellor-ident inside it. This can be checked to see if --- the container has the same ident later. -propellorIdent :: FilePath -propellorIdent = "/.propellor-ident" - --- | Named pipe used for communication with the container. -namedPipe :: ContainerId -> FilePath -namedPipe cid = "docker/" ++ fromContainerId cid - stopContainer :: ContainerId -> IO Bool stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ] diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs index 25a154a9..741c1bc8 100644 --- a/Propellor/SimpleSh.hs +++ b/Propellor/SimpleSh.hs @@ -12,6 +12,8 @@ import System.Process (std_in, std_out, std_err) import System.Exit import Propellor +import Utility.FileMode +import Utility.ThreadScheduler data Cmd = Cmd String [String] deriving (Read, Show) @@ -22,7 +24,9 @@ data Resp = StdoutLine String | StderrLine String | Done ExitCode simpleSh :: FilePath -> IO () simpleSh namedpipe = do nukeFile namedpipe - createDirectoryIfMissing True (takeDirectory namedpipe) + let dir = takeDirectory namedpipe + createDirectoryIfMissing True dir + modifyFileMode dir (removeModes otherGroupModes) s <- socket AF_UNIX Stream defaultProtocol bind s (SockAddrUnix namedpipe) listen s 2 @@ -73,6 +77,20 @@ simpleShClient namedpipe cmd params handler = do resps <- catMaybes . map readish . lines <$> hGetContents h hClose h `after` handler resps +simpleShClientRetry :: Int -> FilePath -> String -> [String] -> ([Resp] -> IO a) -> IO a +simpleShClientRetry retries namedpipe cmd params handler = go retries + where + run = simpleShClient namedpipe cmd params handler + go n + | n < 1 = run + | otherwise = do + v <- tryIO run + case v of + Right r -> return r + Left _ -> do + threadDelaySeconds (Seconds 1) + go (n - 1) + getStdout :: Resp -> Maybe String getStdout (StdoutLine s) = Just s getStdout _ = Nothing diff --git a/Propellor/Types.hs b/Propellor/Types.hs index aef62de4..df139dd6 100644 --- a/Propellor/Types.hs +++ b/Propellor/Types.hs @@ -37,3 +37,23 @@ instance ActionResult Result where getActionResult NoChange = ("unchanged", Dull, Green) getActionResult MadeChange = ("done", Vivid, Green) getActionResult FailedChange = ("failed", Vivid, Red) + +data CmdLine + = Run HostName + | Spin HostName + | Boot HostName + | Set HostName PrivDataField + | AddKey String + | Continue CmdLine + | Chain HostName + | ChainDocker HostName + deriving (Read, Show, Eq) + +-- | Note that removing or changing field names will break the +-- serialized privdata files, so don't do that! +-- It's fine to add new fields. +data PrivDataField + = DockerAuthentication + | SshPrivKey UserName + | Password UserName + deriving (Read, Show, Ord, Eq) -- cgit v1.2.3