summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-11-19 00:30:06 -0400
committerJoey Hess2014-11-19 00:30:06 -0400
commit325fe4037bf5b027191ab88dd90f05d81f61fd0a (patch)
tree0591f4233b1dbabd38582e7a04717c22ab44fba9 /src/Propellor
parent111e08e156df5a41d61c370ebd077174e35f5d9b (diff)
propellor spin
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/CmdLine.hs3
-rw-r--r--src/Propellor/Property/Docker.hs42
-rw-r--r--src/Propellor/Types.hs2
3 files changed, 21 insertions, 26 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 9006d903..e41ab39d 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -86,8 +86,7 @@ defaultMain hostlist = do
go _ (Edit field context) = editPrivData field context
go _ ListFields = listPrivDataFields hostlist
go _ (AddKey keyid) = addKey keyid
- go _ (Chain hn isconsole) = withhost hn $ \h -> do
- when isconsole forceConsole
+ go _ (Chain hn) = withhost hn $ \h -> do
r <- runPropellor h $ ensureProperties $ hostProperties h
putStrLn $ "\n" ++ show r
go _ (Docker hn) = Docker.chain hn
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 491955dd..2b4faf7b 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -416,7 +416,7 @@ chain s = case toContainerId s of
-- to avoid ever provisioning twice at the same time.
whenM (checkProvisionedFlag cid) $ do
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
- unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain (containerHostName cid) False]) $
+ unlessM (boolSystem shim [Param "--continue", Param $ show $ Chain (containerHostName cid)]) $
warningMessage "Boot provision failed!"
void $ async $ job reapzombies
void $ async $ job $ simpleSh $ namedPipe cid
@@ -432,36 +432,28 @@ chain s = case toContainerId s of
-- | 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 = containerDesc cid $ property "provisioned" $ liftIO $ do
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
+ let params = ["--continue", show $ Chain (containerHostName cid)]
msgh <- mkMessageHandle
- let params = ["--continue", show $ Chain (containerHostName cid) (isConsole msgh)]
- r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing)
+ r <- inContainer cid
+ [ if isConsole msgh then "-it" else "-i" ]
+ (shim : params)
+ (processoutput Nothing)
when (r /= FailedChange) $
setProvisionedFlag cid
return r
where
- go lastline (v:rest) = case v of
- StdoutLine s -> do
- maybe noop putStrLn lastline
- hFlush stdout
- go (Just s) rest
- StderrLine s -> do
- maybe noop putStrLn lastline
- hFlush stdout
- hPutStrLn stderr s
- hFlush stderr
- go Nothing rest
- Done -> ret lastline
- go lastline [] = ret lastline
-
- ret lastline = pure $ fromMaybe FailedChange $ readish =<< lastline
+ 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
stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
@@ -496,6 +488,10 @@ runContainer :: Image -> [RunParam] -> [String] -> IO Bool
runContainer image ps cmd = boolSystem dockercmd $ map Param $
"run" : (ps ++ image : cmd)
+inContainer :: ContainerId -> [String] -> [String] -> (Handle -> IO a) -> IO a
+inContainer cid ps cmd = withHandle StdinHandle createProcessSuccess
+ (proc dockercmd ("exec" : ps ++ [fromContainerId cid] ++ cmd))
+
commitContainer :: ContainerId -> IO (Maybe Image)
commitContainer cid = catchMaybeIO $
takeWhile (/= '\n')
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index a1d25b4f..00da7495 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -145,7 +145,7 @@ data CmdLine
| ListFields
| AddKey String
| Continue CmdLine
- | Chain HostName Bool
+ | Chain HostName
| Update HostName
| Docker HostName
| GitPush Fd Fd