diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index d6c5b41..6a676fd 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 45d3a89..3824ff8 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 cfa1ff8..7acb7b8 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...