summaryrefslogtreecommitdiff
path: root/src/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-10-10 13:51:52 -0400
committerJoey Hess2014-10-10 13:51:52 -0400
commit2be1255b894b309c623532bad08338cff0064e64 (patch)
tree06a7d31977d2ffa450acc6fc8414f1c9d3d28160 /src/Propellor/Property
parentd1dd4f44c4cdb02fccb4ac034bac3eaf9f2dc63f (diff)
propellor spin
Diffstat (limited to 'src/Propellor/Property')
-rw-r--r--src/Propellor/Property/Docker.hs22
1 files changed, 11 insertions, 11 deletions
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 65a4a258..8c2f3701 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -314,7 +314,7 @@ runningContainer :: ContainerId -> Image -> [RunParam] -> Property
runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do
l <- liftIO $ listContainers RunningContainers
if cid `elem` l
- then checkident
+ then checkident =<< liftIO (getrunningident simpleShClient)
else ifM (liftIO $ elem cid <$> listContainers AllContainers)
( do
-- The container exists, but is not
@@ -322,7 +322,10 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
-- changed, but we cannot tell without
-- starting it up first.
void $ liftIO $ startContainer cid
- checkident
+ -- It can take a while for the container to
+ -- start up enough to get its ident, so
+ -- retry for up to 60 seconds.
+ checkident =<< liftIO (getrunningident (simpleShClientRetry 60))
, go image
)
where
@@ -331,21 +334,18 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope
-- Check if the ident has changed; if so the
-- parameters of the container differ and it must
-- be restarted.
- checkident = do
- runningident <- liftIO $ getrunningident
- if runningident == Just ident
- then noChange
- else do
- void $ liftIO $ stopContainer cid
- restartcontainer
+ checkident runningident
+ | runningident == Just ident = noChange
+ | otherwise = do
+ void $ liftIO $ stopContainer cid
+ restartcontainer
restartcontainer = do
oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
void $ liftIO $ removeContainer cid
go oldimage
- getrunningident :: IO (Maybe ContainerIdent)
- getrunningident = simpleShClient (namedPipe cid) "cat" [propellorIdent] $ \rs -> do
+ getrunningident shclient = shclient (namedPipe cid) "cat" [propellorIdent] $ \rs -> do
let !v = extractident rs
return v