summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Docker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Docker.hs')
-rw-r--r--src/Propellor/Property/Docker.hs37
1 files changed, 24 insertions, 13 deletions
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index f441197e..8c2f3701 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -314,30 +314,38 @@ 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 do
- -- Check if the ident has changed; if so the
- -- parameters of the container differ and it must
- -- be restarted.
- runningident <- liftIO $ getrunningident
- if runningident == Just ident
- then noChange
- else do
- void $ liftIO $ stopContainer cid
- restartcontainer
+ then checkident =<< liftIO (getrunningident simpleShClient)
else ifM (liftIO $ elem cid <$> listContainers AllContainers)
- ( restartcontainer
+ ( do
+ -- The container exists, but is not
+ -- running. Its parameters may have
+ -- changed, but we cannot tell without
+ -- starting it up first.
+ void $ liftIO $ startContainer cid
+ -- 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
ident = ContainerIdent image hn cn runps
+ -- Check if the ident has changed; if so the
+ -- parameters of the container differ and it must
+ -- be restarted.
+ 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
@@ -433,6 +441,9 @@ provisionContainer cid = containerDesc cid $ property "provisioned" $ liftIO $ d
stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
+startContainer :: ContainerId -> IO Bool
+startContainer cid = boolSystem dockercmd [Param "start", Param $ fromContainerId cid ]
+
stoppedContainer :: ContainerId -> Property
stoppedContainer cid = containerDesc cid $ property desc $
ifM (liftIO $ elem cid <$> listContainers RunningContainers)