summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-04-01 23:24:31 -0400
committerJoey Hess2014-04-01 23:24:31 -0400
commitf3f2af29f2aeabed107fd569dfe36ba9fffc5233 (patch)
tree92825255195205ef07956f051974f843faf40655 /Propellor/Property
parent965c08daeb614a12161167a2bd2aebb73863ffb0 (diff)
docker gc
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Docker.hs37
1 files changed, 32 insertions, 5 deletions
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index d6c5b41b..6a676fd8 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -55,6 +55,26 @@ docked findcontainer hn cn =
where
cid = ContainerId hn cn
+-- | Causes *any* docker images that are not in use by running containers to
+-- be deleted. And deletes any containers that propellor has set up
+-- before that are not currently running. Does not delete any containers
+-- that were not set up using propellor.
+--
+-- Generally, should come after the properties for the desired containers.
+garbageCollected :: Property
+garbageCollected = propertyList "docker garbage collected"
+ [ gccontainers
+ , gcimages
+ ]
+ where
+ gccontainers = Property "docker containers garbage collected" $
+ report <$> (mapM removeContainer =<< listContainers AllContainers)
+ gcimages = Property "docker images garbage collected" $ do
+ report <$> (mapM removeImage =<< listImages)
+ report rmed
+ | or rmed = MadeChange
+ | otherwise = NoChange
+
-- | Pass to defaultMain to add docker containers.
-- You need to provide the function mapping from
-- HostName and ContainerName to the Container to use.
@@ -185,12 +205,12 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci
clearProvisionedFlag cid
void $ stopContainer cid
oldimage <- fromMaybe image <$> commitContainer cid
- removeContainer cid
+ void $ removeContainer cid
go oldimage
else do
whenM (elem cid <$> listContainers AllContainers) $ do
clearProvisionedFlag cid
- removeContainer cid
+ void $ removeContainer cid
go image
where
ident = ContainerIdent image hn cn runps
@@ -290,9 +310,13 @@ provisionContainer cid = containerDesc cid $ Property "provision" $ do
stopContainer :: ContainerId -> IO Bool
stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]
-removeContainer :: ContainerId -> IO ()
-removeContainer cid = void $ catchMaybeIO $
- readProcess dockercmd ["rm", fromContainerId cid ]
+removeContainer :: ContainerId -> IO Bool
+removeContainer cid = catchBoolIO $
+ snd <$> processTranscript dockercmd ["rm", fromContainerId cid ] Nothing
+
+removeImage :: Image -> IO Bool
+removeImage image = catchBoolIO $
+ snd <$> processTranscript dockercmd ["rmi", image ] Nothing
runContainer :: Image -> [RunParam] -> [String] -> IO Bool
runContainer image ps cmd = boolSystem dockercmd $ map Param $
@@ -317,6 +341,9 @@ listContainers status =
| otherwise = baseps
baseps = ["ps", "--no-trunc"]
+listImages :: IO [Image]
+listImages = lines <$> readProcess dockercmd ["--all", "--quiet"]
+
runProp :: String -> RunParam -> Containerized Property
runProp field val =
Containerized ["--" ++ param] (Property (param) (return NoChange))