summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Debootstrap.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-19 20:35:33 -0400
committerJoey Hess2014-11-19 20:35:33 -0400
commitcaeed5492fa3c66668d750a79ea5886248c6bd07 (patch)
tree9283d3cb19fc491ce27f207f5334418f58c03c63 /src/Propellor/Property/Debootstrap.hs
parent4a9bbd1391b708d72a455cc00f698a80f1fd5fa5 (diff)
allow debootstrapped to be reverted
Diffstat (limited to 'src/Propellor/Property/Debootstrap.hs')
-rw-r--r--src/Propellor/Property/Debootstrap.hs33
1 files changed, 28 insertions, 5 deletions
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 8f93fe5b..876c12cb 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -22,14 +22,24 @@ type Url = String
--
-- The System can be any OS and architecture that debootstrap
-- and the kernel support.
-debootstrapped :: FilePath -> System -> [CommandParam] -> Property
-debootstrapped target system@(System _ arch) extraparams =
- check (unpopulated target) prop
- `requires` unrevertable installed
+--
+-- Reverting this property deletes the chroot and all its contents.
+-- Anything mounted under the filesystem is first unmounted.
+--
+-- Note that reverting this property does not stop any processes
+-- currently running in the chroot.
+debootstrapped :: FilePath -> System -> [CommandParam] -> RevertableProperty
+debootstrapped target system@(System _ arch) extraparams =
+ RevertableProperty setup teardown
where
+ setup = check (unpopulated target) setupprop
+ `requires` unrevertable installed
+
+ teardown = check (not <$> unpopulated target) teardownprop
+
unpopulated d = null <$> catchDefaultIO [] (dirContents d)
- prop = property ("debootstrapped " ++ target) $ liftIO $ do
+ setupprop = property ("debootstrapped " ++ target) $ liftIO $ do
createDirectoryIfMissing True target
let suite = case extractSuite system of
Nothing -> error $ "don't know how to debootstrap " ++ show system
@@ -47,6 +57,19 @@ debootstrapped target system@(System _ arch) extraparams =
, return FailedChange
)
+ teardownprop = property ("removed debootstrapped " ++ target) $ liftIO $ do
+ submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
+ . filter (dirContains target)
+ <$> mountPoints
+ forM_ submnts $ \mnt ->
+ unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
+ error $ "failed unmounting " ++ mnt
+ removeDirectoryRecursive target
+ return MadeChange
+
+mountPoints :: IO [FilePath]
+mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]
+
extractSuite :: System -> Maybe String
extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
extractSuite (System (Ubuntu r) _) = Just r