cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

improve display of docker container properties

This commit is contained in:
Joey Hess 2014-04-01 14:20:59 -04:00
parent 5422a5b376
commit 50f68604e1
Failed to extract signature
1 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Propellor/Property/Docker.hs
View File

@ -72,14 +72,17 @@ containerProperties
-> (HostName -> Maybe [Property]) -> (HostName -> Maybe [Property])
containerProperties findcontainer = \h -> case toContainerId h of containerProperties findcontainer = \h -> case toContainerId h of
Nothing -> Nothing Nothing -> Nothing
Just (ContainerId hn cn) -> Just cid@(ContainerId hn cn) ->
case findcontainer hn cn of case findcontainer hn cn of
Nothing -> Nothing Nothing -> Nothing
Just (Container _ cprops) -> Just (Container _ cprops) ->
Just $ fromContainerized cprops Just $ map (containerDesc cid) $
fromContainerized cprops
containerDesc :: ContainerId -> Desc -> Desc containerDesc :: ContainerId -> Property -> Property
containerDesc cid d = "docker container " ++ fromContainerId cid ++ " " ++ d containerDesc cid p = p `describe` desc
where
desc = "docker container " ++ fromContainerId cid ++ " " ++ propertyDesc p
-- | Ensures that a docker container is set up and running. The container -- | Ensures that a docker container is set up and running. The container
-- has its own Properties which are handled by running propellor -- has its own Properties which are handled by running propellor
@ -91,7 +94,7 @@ hasContainer
-> Property -> Property
hasContainer hn cn findcontainer = hasContainer hn cn findcontainer =
case findcontainer hn cn of case findcontainer hn cn of
Nothing -> Property (containerDesc cid "") $ do Nothing -> containerDesc cid $ Property "" $ do
warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid
return FailedChange return FailedChange
Just (Container image containerprops) -> Just (Container image containerprops) ->
@ -102,7 +105,7 @@ hasContainer hn cn findcontainer =
cid = ContainerId hn cn cid = ContainerId hn cn
runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property
runningContainer cid@(ContainerId hn cn) image containerprops = Property (containerDesc cid "running") $ do runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc cid $ Property "running" $ do
l <- listContainers RunningContainers l <- listContainers RunningContainers
if cid `elem` l if cid `elem` l
then do then do
@ -185,7 +188,7 @@ chain s = case readish s of
-- being run. So, retry connections to the client for up to -- being run. So, retry connections to the client for up to
-- 1 minute. -- 1 minute.
provisionContainer :: ContainerId -> Property provisionContainer :: ContainerId -> Property
provisionContainer cid = Property (containerDesc cid "provision") $ provisionContainer cid = containerDesc cid $ Property "provision" $
simpleShClientRetry 60 (namedPipe cid) "./propellor" ["--continue", show params] (go Nothing) simpleShClientRetry 60 (namedPipe cid) "./propellor" ["--continue", show params] (go Nothing)
where where
params = Chain $ fromContainerId cid params = Chain $ fromContainerId cid
@ -239,7 +242,7 @@ listContainers status =
runProp :: String -> RunParam -> Containerized Property runProp :: String -> RunParam -> Containerized Property
runProp field val = runProp field val =
Containerized ["--" ++ param] (Property param (return NoChange)) Containerized ["--" ++ param] (Property (param) (return NoChange))
where where
param = field++"="++val param = field++"="++val