summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-04-01 23:24:31 -0400
committerJoey Hess2014-04-01 23:24:31 -0400
commitf3f2af29f2aeabed107fd569dfe36ba9fffc5233 (patch)
tree92825255195205ef07956f051974f843faf40655
parent965c08daeb614a12161167a2bd2aebb73863ffb0 (diff)
docker gc
-rw-r--r--Propellor/Property/Docker.hs37
-rw-r--r--config.hs1
-rw-r--r--config.hs.simple1
3 files changed, 34 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))
diff --git a/config.hs b/config.hs
index 45d3a898..3824ff80 100644
--- a/config.hs
+++ b/config.hs
@@ -42,6 +42,7 @@ host hostname@"clam.kitenet.net" = Just
, Docker.configured
, File.dirExists "/var/www"
, Docker.docked container hostname "webserver"
+ , Docker.garbageCollected
, Apt.installed ["git-annex", "mtr"]
-- Should come last as it reboots.
, Apt.installed ["systemd-sysv"] `onChange` Reboot.now
diff --git a/config.hs.simple b/config.hs.simple
index cfa1ff88..7acb7b88 100644
--- a/config.hs.simple
+++ b/config.hs.simple
@@ -33,6 +33,7 @@ host hostname@"mybox.example.com" = Just
, Network.ipv6to4
, Docker.docked container hostname "webserver"
`requires` File.dirExists "/var/www"
+ , Docker.garbageCollected
, Cron.runPropellor "30 * * * *"
]
-- add more hosts here...