summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/OS.hs
diff options
context:
space:
mode:
authorJoey Hess2014-12-05 12:50:01 -0400
committerJoey Hess2014-12-05 12:50:01 -0400
commit97e9433f1b719cc13fc524ee0399d0b51af5a5c1 (patch)
tree448496b90cf5dbd5c458eb675c24747f9753bccc /src/Propellor/Property/OS.hs
parent573b8b7df866d4801c1ea06edf1195fbeeef9499 (diff)
rollback if renameing fails
This avoids leaving the system in a broken state where some directories have been renamed away any others not. Future work: If the rename list contains (foo, bar) and (newfoo,foo), reorder the list to gather those two actions together to minimize the amount of time that foo is missing. In case of power loss or something.
Diffstat (limited to 'src/Propellor/Property/OS.hs')
-rw-r--r--src/Propellor/Property/OS.hs35
1 files changed, 28 insertions, 7 deletions
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index b81b7c4e..3ed23fb4 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -18,6 +18,7 @@ import Propellor.Property.Mount
import Propellor.Property.Chroot.Util (stdPATH)
import System.Posix.Files (rename, fileExist)
+import Control.Exception (throw)
-- | Replaces whatever OS was installed before with a clean installation
-- of the OS that the Host is configured to have.
@@ -85,16 +86,20 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
return $ if null mnts then NoChange else MadeChange
flipped = property (newOSDir ++ " moved into place") $ liftIO $ do
- createDirectoryIfMissing True oldOSDir
rootcontents <- dirContents "/"
- forM_ rootcontents $ \d ->
- when (d `notElem` (oldOSDir:newOSDir:trickydirs)) $
- rename d (oldOSDir ++ d)
newrootcontents <- dirContents newOSDir
- forM_ newrootcontents $ \d -> do
+ createDirectoryIfMissing True oldOSDir
+ renamesout <- forM rootcontents $ \d ->
+ if d `notElem` (oldOSDir:newOSDir:trickydirs)
+ then return $ Just (d, oldOSDir ++ d)
+ else return Nothing
+ renamesin <- forM newrootcontents $ \d -> do
let dest = "/" ++ takeFileName d
- whenM (not <$> fileExist dest) $
- rename d dest
+ ifM (not <$> fileExist dest)
+ ( return $ Just (d, dest)
+ , return Nothing
+ )
+ massRename $ catMaybes (renamesout ++ renamesin)
removeDirectoryRecursive newOSDir
-- Prepare environment for running additional properties.
@@ -125,6 +130,22 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
, "/proc"
]
+-- Performs all the renames. If any rename fails, rolls back all
+-- previous renames. Thus, this either successfully performs all
+-- the renames, or does not change the system state at all.
+massRename :: [(FilePath, FilePath)] -> IO ()
+massRename = go []
+ where
+ go _ [] = return ()
+ go undo ((from, to):rest) =
+ tryNonAsync (rename from to)
+ >>= either
+ (rollback undo)
+ (const $ go ((to, from):undo) rest)
+ rollback undo e = do
+ mapM_ (uncurry rename) undo
+ throw e
+
data Confirmation = Confirmed HostName
confirmed :: Desc -> Confirmation -> Property