cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

propellor spin

This commit is contained in:
Joey Hess 2014-11-19 21:21:20 -04:00
parent b136609cb5
commit 3343b220a8
Failed to extract signature
1 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Propellor/Property/Debootstrap.hs
View File

@ -32,7 +32,7 @@ built :: FilePath -> System -> [CommandParam] -> RevertableProperty
built target system@(System _ arch) extraparams = built target system@(System _ arch) extraparams =
RevertableProperty setup teardown RevertableProperty setup teardown
where where
setup = check (unpopulated target) setupprop setup = check (unpopulated target <||> ispartial) setupprop
`requires` unrevertable installed `requires` unrevertable installed
teardown = check (not <$> unpopulated target) teardownprop teardown = check (not <$> unpopulated target) teardownprop
@ -58,6 +58,10 @@ built target system@(System _ arch) extraparams =
) )
teardownprop = property ("removed debootstrapped " ++ target) $ liftIO $ do teardownprop = property ("removed debootstrapped " ++ target) $ liftIO $ do
removetarget
return MadeChange
removetarget = do
submnts <- filter (\p -> simplifyPath p /= simplifyPath target) submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
. filter (dirContains target) . filter (dirContains target)
<$> mountPoints <$> mountPoints
@ -65,7 +69,15 @@ built target system@(System _ arch) extraparams =
unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
errorMessage $ "failed unmounting " ++ mnt errorMessage $ "failed unmounting " ++ mnt
removeDirectoryRecursive target 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 :: IO [FilePath]
mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"] mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]