From 2be1255b894b309c623532bad08338cff0064e64 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 10 Oct 2014 13:51:52 -0400
Subject: [PATCH] propellor spin

---
 src/Propellor/Property/Docker.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 65a4a25..8c2f370 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