summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-12-04 16:50:00 -0400
committerJoey Hess2014-12-04 16:50:00 -0400
commitbf4840f341c83f28a53cf80fd7750a661e734d65 (patch)
tree3376f3825fe1ea1db9352357dc6a577b9429c0d7
parente47fbd9b39708e3488e047a5c22565ff23e79d46 (diff)
propellor spin
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Property/Debootstrap.hs8
-rw-r--r--src/Propellor/Property/Mount.hs12
-rw-r--r--src/Propellor/Property/OS.hs46
4 files changed, 46 insertions, 21 deletions
diff --git a/propellor.cabal b/propellor.cabal
index 617a1fc8..91d08bd5 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 ab5bddf4..35d9e472 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 00000000..804407e9
--- /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 20e6e47f..aa304f61 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"