From b437fa963d7e44945d24c1c5a6453cebcaf7a682 Mon Sep 17 00:00:00 2001 From: Nicolas Schodet Date: Thu, 19 Oct 2017 21:35:29 +0200 Subject: Use isUnpopulated when creating a chroot or restoring a backup --- src/Propellor/Property/Attic.hs | 2 +- src/Propellor/Property/Borg.hs | 2 +- src/Propellor/Property/Chroot.hs | 4 ++-- src/Propellor/Property/Chroot/Util.hs | 4 ---- src/Propellor/Property/Debootstrap.hs | 2 +- src/Propellor/Property/Obnam.hs | 2 +- src/Propellor/Property/Restic.hs | 2 +- src/Propellor/Property/Sbuild.hs | 4 ++-- 8 files changed, 9 insertions(+), 13 deletions(-) diff --git a/src/Propellor/Property/Attic.hs b/src/Propellor/Property/Attic.hs index 8ab5546b..f8113e2a 100644 --- a/src/Propellor/Property/Attic.hs +++ b/src/Propellor/Property/Attic.hs @@ -59,7 +59,7 @@ restored dir backupdir = go `requires` installed , noChange ) - needsRestore = null <$> catchDefaultIO [] (dirContents dir) + needsRestore = isUnpopulated dir restore = withTmpDirIn (takeDirectory dir) "attic-restore" $ \tmpdir -> do ok <- boolSystem "attic" $ diff --git a/src/Propellor/Property/Borg.hs b/src/Propellor/Property/Borg.hs index 989fb4b9..49259206 100644 --- a/src/Propellor/Property/Borg.hs +++ b/src/Propellor/Property/Borg.hs @@ -95,7 +95,7 @@ restored dir repo = go `requires` installed , noChange ) - needsRestore = null <$> catchDefaultIO [] (dirContents dir) + needsRestore = isUnpopulated dir restore = withTmpDirIn (takeDirectory dir) "borg-restore" $ \tmpdir -> do ok <- runBorg repo $ diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index 9e8bcd2f..ea8b1407 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -77,7 +77,7 @@ instance ChrootBootstrapper ChrootTarball where tightenTargets $ extractTarball loc tb extractTarball :: FilePath -> FilePath -> Property UnixLike -extractTarball target src = check (unpopulated target) $ +extractTarball target src = check (isUnpopulated target) $ cmdProperty "tar" params `assume` MadeChange `requires` File.dirExists target @@ -151,7 +151,7 @@ provisioned' c@(Chroot loc bootstrapper infopropigator _) systemdonly = cantbuild e = property (chrootDesc c "built") (error e) teardown :: Property Linux - teardown = check (not <$> unpopulated loc) $ + teardown = check (not <$> isUnpopulated loc) $ property ("removed " ++ loc) $ makeChange (removeChroot loc) diff --git a/src/Propellor/Property/Chroot/Util.hs b/src/Propellor/Property/Chroot/Util.hs index ac703136..fd91e984 100644 --- a/src/Propellor/Property/Chroot/Util.hs +++ b/src/Propellor/Property/Chroot/Util.hs @@ -27,7 +27,3 @@ removeChroot :: FilePath -> IO () removeChroot c = do unmountBelow c removeDirectoryRecursive c - --- | Returns true if a chroot directory is empty. -unpopulated :: FilePath -> IO Bool -unpopulated d = null <$> catchDefaultIO [] (dirContents d) diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index e21bcdff..a9412b95 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -54,7 +54,7 @@ built' :: Property Linux -> FilePath -> System -> DebootstrapConfig -> Property built' installprop target system@(System _ arch) config = go `before` oldpermfix where - go = check (unpopulated target <||> ispartial) setupprop + go = check (isUnpopulated target <||> ispartial) setupprop `requires` installprop setupprop :: Property Linux diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs index 7943b46e..264d6748 100644 --- a/src/Propellor/Property/Obnam.hs +++ b/src/Propellor/Property/Obnam.hs @@ -113,7 +113,7 @@ restored dir params = go `requires` installed , noChange ) - needsRestore = null <$> catchDefaultIO [] (dirContents dir) + needsRestore = isUnpopulated dir restore = withTmpDirIn (takeDirectory dir) "obnam-restore" $ \tmpdir -> do ok <- boolSystem "obnam" $ diff --git a/src/Propellor/Property/Restic.hs b/src/Propellor/Property/Restic.hs index d9d4d4be..9415f4bf 100644 --- a/src/Propellor/Property/Restic.hs +++ b/src/Propellor/Property/Restic.hs @@ -97,7 +97,7 @@ restored dir repo = go , noChange ) - needsRestore = null <$> catchDefaultIO [] (dirContents dir) + needsRestore = isUnpopulated dir restore = withTmpDirIn (takeDirectory dir) "restic-restore" $ \tmpdir -> do ok <- boolSystem "restic" diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs index 23f3b311..210fb20b 100644 --- a/src/Propellor/Property/Sbuild.hs +++ b/src/Propellor/Property/Sbuild.hs @@ -147,7 +147,7 @@ built s@(SbuildSchroot suite arch) mirror cc = deleted where go :: Property DebianLike - go = check (unpopulated (schrootRoot s) <||> ispartial) $ + go = check (isUnpopulated (schrootRoot s) <||> ispartial) $ property' ("built sbuild schroot for " ++ val s) make make w = do de <- liftIO standardPathEnv @@ -166,7 +166,7 @@ built s@(SbuildSchroot suite arch) mirror cc = ) -- TODO we should kill any sessions still using the chroot -- before destroying it (as suggested by sbuild-destroychroot) - deleted = check (not <$> unpopulated (schrootRoot s)) $ + deleted = check (not <$> isUnpopulated (schrootRoot s)) $ property ("no sbuild schroot for " ++ val s) $ do liftIO $ removeChroot $ schrootRoot s liftIO $ nukeFile -- cgit v1.2.3