propellor spin

This commit is contained in:
Joey Hess 2014-11-19 00:30:06 -04:00
parent 111e08e156
commit 325fe4037b
Failed to extract signature
4 changed files with 25 additions and 26 deletions

View File

@ -53,6 +53,7 @@ darkstar = host "darkstar.kitenet.net"
& Apt.buildDep ["git-annex"] `period` Daily & Apt.buildDep ["git-annex"] `period` Daily
& Docker.configured & Docker.configured
! Docker.docked hosts "android-git-annex" ! Docker.docked hosts "android-git-annex"
& Docker.docked hosts "simple-debian"
clam :: Host clam :: Host
clam = standardSystem "clam.kitenet.net" Unstable "amd64" clam = standardSystem "clam.kitenet.net" Unstable "amd64"
@ -309,6 +310,9 @@ containers =
& Docker.publish "4200:4200" & Docker.publish "4200:4200"
& JoeySites.oldUseNetShellBox & JoeySites.oldUseNetShellBox
, Docker.container "simple-debian" "debian"
& "/hello" `File.containsLine` "hello"
-- git-annex autobuilder containers -- git-annex autobuilder containers
, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h" , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "amd64" 15 "2h"
, GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h" , GitAnnexBuilder.standardAutoBuilderContainer dockerImage "i386" 45 "2h"

View File

@ -86,8 +86,7 @@ defaultMain hostlist = do
go _ (Edit field context) = editPrivData field context go _ (Edit field context) = editPrivData field context
go _ ListFields = listPrivDataFields hostlist go _ ListFields = listPrivDataFields hostlist
go _ (AddKey keyid) = addKey keyid go _ (AddKey keyid) = addKey keyid
go _ (Chain hn isconsole) = withhost hn $ \h -> do go _ (Chain hn) = withhost hn $ \h -> do
when isconsole forceConsole
r <- runPropellor h $ ensureProperties $ hostProperties h r <- runPropellor h $ ensureProperties $ hostProperties h
putStrLn $ "\n" ++ show r putStrLn $ "\n" ++ show r
go _ (Docker hn) = Docker.chain hn go _ (Docker hn) = Docker.chain hn

View File

@ -416,7 +416,7 @@ chain s = case toContainerId s of
-- to avoid ever provisioning twice at the same time. -- to avoid ever provisioning twice at the same time.
whenM (checkProvisionedFlag cid) $ do whenM (checkProvisionedFlag cid) $ do
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid) 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!" warningMessage "Boot provision failed!"
void $ async $ job reapzombies void $ async $ job reapzombies
void $ async $ job $ simpleSh $ namedPipe cid 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 -- | Once a container is running, propellor can be run inside
-- it to provision it. -- 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 :: ContainerId -> Property
provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ do
let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid) let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid)
let params = ["--continue", show $ Chain (containerHostName cid)]
msgh <- mkMessageHandle msgh <- mkMessageHandle
let params = ["--continue", show $ Chain (containerHostName cid) (isConsole msgh)] r <- inContainer cid
r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing) [ if isConsole msgh then "-it" else "-i" ]
(shim : params)
(processoutput Nothing)
when (r /= FailedChange) $ when (r /= FailedChange) $
setProvisionedFlag cid setProvisionedFlag cid
return r return r
where where
go lastline (v:rest) = case v of processoutput lastline h = do
StdoutLine s -> do v <- catchMaybeIO (hGetLine h)
case v of
Nothing -> pure $ fromMaybe FailedChange $
readish =<< lastline
Just s -> do
maybe noop putStrLn lastline maybe noop putStrLn lastline
hFlush stdout hFlush stdout
go (Just s) rest processoutput (Just s) h
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
stopContainer :: ContainerId -> IO Bool stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ] 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 $ runContainer image ps cmd = boolSystem dockercmd $ map Param $
"run" : (ps ++ image : cmd) "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 :: ContainerId -> IO (Maybe Image)
commitContainer cid = catchMaybeIO $ commitContainer cid = catchMaybeIO $
takeWhile (/= '\n') takeWhile (/= '\n')

View File

@ -145,7 +145,7 @@ data CmdLine
| ListFields | ListFields
| AddKey String | AddKey String
| Continue CmdLine | Continue CmdLine
| Chain HostName Bool | Chain HostName
| Update HostName | Update HostName
| Docker HostName | Docker HostName
| GitPush Fd Fd | GitPush Fd Fd