summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Debootstrap.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-19 21:21:20 -0400
committerJoey Hess2014-11-19 21:21:20 -0400
commit3343b220a8381fb356926c458e66874bc540abcd (patch)
treef4e0c8b91bb260fe853b7d968bc3dfdf9c52b21c /src/Propellor/Property/Debootstrap.hs
parentb136609cb5adb48a994ec81df0b91d98e73c1be6 (diff)
propellor spin
Diffstat (limited to 'src/Propellor/Property/Debootstrap.hs')
-rw-r--r--src/Propellor/Property/Debootstrap.hs16
1 files changed, 14 insertions, 2 deletions
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index ed851d97..4e7bc740 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -32,7 +32,7 @@ built :: FilePath -> System -> [CommandParam] -> RevertableProperty
built target system@(System _ arch) extraparams =
RevertableProperty setup teardown
where
- setup = check (unpopulated target) setupprop
+ setup = check (unpopulated target <||> ispartial) setupprop
`requires` unrevertable installed
teardown = check (not <$> unpopulated target) teardownprop
@@ -58,6 +58,10 @@ built target system@(System _ arch) extraparams =
)
teardownprop = property ("removed debootstrapped " ++ target) $ liftIO $ do
+ removetarget
+ return MadeChange
+
+ removetarget = do
submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
. filter (dirContains target)
<$> mountPoints
@@ -65,7 +69,15 @@ built target system@(System _ arch) extraparams =
unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
errorMessage $ "failed unmounting " ++ mnt
removeDirectoryRecursive target
- return MadeChange
+
+ -- A failed debootstrap run will leave a debootstrap directory;
+ -- recover by deleting it and trying again.
+ ispartial = ifM (doesDirectoryExist (target </> "debootstrap"))
+ ( do
+ removetarget
+ return True
+ , return False
+ )
mountPoints :: IO [FilePath]
mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]