summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Docker.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2015-01-04 17:16:55 -0400
committerJoey Hess <joeyh@joeyh.name>2015-01-04 17:16:55 -0400
commitacdcff5ca48aeb08cb0b06621cf9889e1c628a86 (patch)
treec57102d12541ec2be0c25bbaddeb8644a0cdeaf8 /src/Propellor/Property/Docker.hs
parenta9163ba3ab5e59b93dc901959b43c05e3fe6498a (diff)
parentdf8d8eb5328b19dcde123d46d6cd9db0e2df88e9 (diff)
Merge branch 'joeyconfig'
Conflicts: privdata.joey/privdata.gpg
Diffstat (limited to 'src/Propellor/Property/Docker.hs')
-rw-r--r--src/Propellor/Property/Docker.hs31
1 files changed, 23 insertions, 8 deletions
diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs
index 02bda2e9..eb0d8ec5 100644
--- a/src/Propellor/Property/Docker.hs
+++ b/src/Propellor/Property/Docker.hs
@@ -351,29 +351,44 @@ 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 runningident
+ checkident (Right runningident)
| runningident == Just ident = noChange
| otherwise = do
void $ liftIO $ stopContainer cid
restartcontainer
+ checkident (Left errmsg) = do
+ warningMessage errmsg
+ return FailedChange
restartcontainer = do
oldimage <- liftIO $ fromMaybe image <$> commitContainer cid
void $ liftIO $ removeContainer cid
go oldimage
- getrunningident = readish
- <$> readProcess' (inContainerProcess cid [] ["cat", propellorIdent])
+ getrunningident = withTmpFile "dockerrunsane" $ \t h -> do
+ -- detect #774376 which caused docker exec to not enter
+ -- the container namespace, and be able to access files
+ -- outside
+ hClose h
+ void . checkSuccessProcess . processHandle =<<
+ createProcess (inContainerProcess cid []
+ ["rm", "-f", t])
+ ifM (doesFileExist t)
+ ( Right . readish <$>
+ readProcess' (inContainerProcess cid []
+ ["cat", propellorIdent])
+ , return $ Left "docker exec failed to enter chroot properly (maybe an old kernel version?)"
+ )
- retry :: Int -> IO (Maybe a) -> IO (Maybe a)
- retry 0 _ = return Nothing
+ retry :: Int -> IO (Either e (Maybe a)) -> IO (Either e (Maybe a))
+ retry 0 _ = return (Right Nothing)
retry n a = do
v <- a
case v of
- Just _ -> return v
- Nothing -> do
- threadDelaySeconds (Seconds 1)
+ Right Nothing -> do
+ threadDelaySeconds (Seconds 1)
retry (n-1) a
+ _ -> return v
go img = do
liftIO $ do