diff --git a/propellor.cabal b/propellor.cabal index 617a1fc..91d08bd 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -85,6 +85,7 @@ Library Propellor.Property.Gpg Propellor.Property.Group Propellor.Property.Grub + Propellor.Property.Mount Propellor.Property.Network Propellor.Property.Nginx Propellor.Property.Obnam diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index ab5bddf..35d9e47 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -9,6 +9,7 @@ module Propellor.Property.Debootstrap ( import Propellor import qualified Propellor.Property.Apt as Apt import Propellor.Property.Chroot.Util +import Propellor.Property.Mount import Utility.Path import Utility.SafeCommand import Utility.FileMode @@ -95,9 +96,7 @@ built target system@(System _ arch) config = submnts <- filter (\p -> simplifyPath p /= simplifyPath target) . filter (dirContains target) <$> mountPoints - forM_ submnts $ \mnt -> - unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do - errorMessage $ "failed unmounting " ++ mnt + forM_ submnts umountLazy removeDirectoryRecursive target -- A failed debootstrap run will leave a debootstrap directory; @@ -109,9 +108,6 @@ built target system@(System _ arch) config = , return False ) -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 diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs new file mode 100644 index 0000000..804407e --- /dev/null +++ b/src/Propellor/Property/Mount.hs @@ -0,0 +1,12 @@ +module Propellor.Property.Mount where + +import Propellor +import Utility.SafeCommand + +mountPoints :: IO [FilePath] +mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"] + +umountLazy :: FilePath -> IO () +umountLazy mnt = + unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ + errorMessage $ "failed unmounting " ++ mnt diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 20e6e47..aa304f6 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -14,6 +14,7 @@ import Propellor import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.User as User +import Propellor.Property.Mount -- | Replaces whatever OS was installed before with a clean installation -- of the OS that the Host is configured to have. @@ -63,30 +64,42 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ `requires` flipped `requires` + umountall + `requires` osbootstrapped - osbootstrapped = withOS "/new-os bootstrapped" $ \o -> case o of + osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of (Just d@(System (Debian _) _)) -> debootstrap d (Just u@(System (Ubuntu _) _)) -> debootstrap u _ -> error "os is not declared to be Debian or Ubuntu" debootstrap targetos = ensureProperty $ toProp $ - Debootstrap.built "/new-os" targetos Debootstrap.DefaultConfig + Debootstrap.built newOSDir targetos Debootstrap.DefaultConfig - flipped = property "/new-os moved into place" $ - return FailedChange - -- unmount all mounts - -- move all directories to /old-os, - -- move /new-os to / - -- touch flagfile + umountall = property "all mount points unmounted" $ liftIO $ do + mnts <- filter (/= "/") <$> mountPoints + forM_ mnts umountLazy + 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 /= oldOSDir && d /= newOSDir) $ + renameDirectory d (oldOSDir ++ d) + newrootcontents <- dirContents newOSDir + forM_ newrootcontents $ \d -> + renameDirectory d ("/" ++ takeFileName d) + removeDirectory newOSDir + return MadeChange propellorbootstrapped = property "propellor re-debootstrapped in new os" $ - return FailedChange + return NoChange -- re-bootstrap propellor in /usr/local/propellor, -- (using git repo bundle, privdata file, and possibly -- git repo url, which all need to be arranged to -- be present in /old-os's /usr/local/propellor) - finalized = property "clean install finalized" $ do + finalized = property "clean OS installed" $ do liftIO $ writeFile flagfile "" return MadeChange @@ -118,7 +131,7 @@ preserveRootSshAuthorized = check (doesDirectoryExist oldloc) $ ensureProperties (map (Ssh.authorizedKey "root") ks) where newloc = "/root/.ssh/authorized_keys" - oldloc = oldOsDir ++ newloc + oldloc = oldOSDir ++ newloc -- Installs an appropriate kernel from the OS distribution. kernelInstalled :: Property @@ -142,12 +155,15 @@ type GrubDev = String -- Removes the old OS's backup from /old-os oldOSRemoved :: Confirmation -> Property -oldOSRemoved confirmation = check (doesDirectoryExist oldOsDir) $ +oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $ go `requires` confirmed "old OS backup removal confirmed" confirmation where go = property "old OS backup removed" $ do - liftIO $ removeDirectoryRecursive oldOsDir + liftIO $ removeDirectoryRecursive oldOSDir return MadeChange -oldOsDir :: FilePath -oldOsDir = "/old-os" +oldOSDir :: FilePath +oldOSDir = "/old-os" + +newOSDir :: FilePath +newOSDir = "/new-os"