more work on OS takeover

1 files changed, 98 insertions, 40 deletions

diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 5dddff2c..cbdb4d99 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -1,20 +1,22 @@
 module Propellor.Property.OS (
 	cleanInstallOnce,
-	Confirmed(..),
+	Confirmation(..),
 	preserveNetworkInterfaces,
 	preserveRootSshAuthorized,
 	grubBoots,
 	GrubDev(..),
+	oldOSKernelPreserved,
 	kernelInstalled,
 	oldOSRemoved,
 ) where
 
 import Propellor
-import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Debootstrap as Debootstrap
-import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Ssh as Ssh
-import Utility.FileMode
+import qualified Propellor.Property.User as User
+import Propellor.Property.Mount
+
+import System.Posix.Files (rename, fileExist)
 
 -- | Replaces whatever OS was installed before with a clean installation
 -- of the OS that the Host is configured to have.
@@ -22,8 +24,10 @@ import Utility.FileMode
 -- This can replace one Linux distribution with different one.
 -- But, it can also fail and leave the system in an unbootable state.
 --
+-- The files from the old os will be left in /old-os
+--
 -- To avoid this property being accidentially used, you have to provide
--- a Confirmed containing the name of the host that you intend to apply the
+-- a Confirmation containing the name of the host that you intend to apply the
 -- property to.
 --
 -- This property only runs once. The cleanly installed system will have
@@ -35,52 +39,95 @@ import Utility.FileMode
 -- working system. For example:
 --
 -- > & os (System (Debian Unstable) "amd64")
--- > & cleanInstall (Confirmed "foo.example.com") [BackupOldOS, UseOldKernel]
+-- > & cleanInstall (Confirmed "foo.example.com")
 -- >    `onChange` propertyList "fixing up after clean install"
 -- >        [ preserveNetworkInterfaces
 -- >        , preserverRootSshAuthorized
+-- >        , oldOSKernelPreserved
 -- >        -- , kernelInstalled
 -- >        -- , grubBoots "hd0"
+-- >        -- , oldOsRemoved
 -- >        ]
 -- > & Apt.installed ["ssh"]
 -- > & User.hasSomePassword "root"
 -- > & User.accountFor "joey"
 -- > & User.hasSomePassword "joey"
 -- > -- rest of system properties here
-cleanInstallOnce :: Confirmed -> [Tweak] -> Property
-cleanInstallOnce confirmed tweaks = check (not <$> doesFileExist flagfile) $
-	property "OS cleanly installed" $ do
-		checkConfirmed confirmed
-		error "TODO"
-		-- debootstrap /new-os chroot, but don't run propellor
-		--   inside the chroot.
-		-- unmount all mounts
-		-- move all directories to /old-os,
-		--   except for /boot and /lib/modules when UseOldKernel
-		--   (or, delete when not BackupOldOS)
-		-- move /new-os to /
-		-- touch flagfile
+cleanInstallOnce :: Confirmation -> Property
+cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
+	go `requires` confirmed "clean install confirmed" confirmation
+  where
+	go = 
+		finalized
+			`requires`
+		propellorbootstrapped
+			`requires`
+		User.shadowConfig True
+			`requires`
+		flipped
+			`requires`
+		umountall
+			`requires`
+		osbootstrapped
+
+	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 newOSDir targetos Debootstrap.DefaultConfig
+	
+	umountall = property "mount points unmounted" $ liftIO $ do
+		mnts <- filter (`notElem` ("/": trickydirs)) <$> mountPoints
+		-- reverse so that deeper mount points come first
+		forM_ (reverse 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 `notElem` (oldOSDir:newOSDir:trickydirs)) $
+				rename d (oldOSDir ++ d)
+		newrootcontents <- dirContents newOSDir
+		forM_ newrootcontents $ \d -> do
+			let dest = "/" ++ takeFileName d
+			whenM (not <$> fileExist dest) $
+				rename d dest
+		removeDirectoryRecursive newOSDir
+		return MadeChange
+	
+	trickydirs = 
+		-- /tmp can contain X's sockets, which prevent moving it
+		-- so it's left as-is.
+		[ "/tmp"
+		-- /proc is left mounted
+		, "/proc"
+		]
+
+	propellorbootstrapped = property "propellor re-debootstrapped in new os" $
+		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)
-		-- enable shadow passwords (to avoid foot-shooting)
-		-- return MadeChange
-  where
+	
+	finalized = property "clean OS installed" $ do
+		liftIO $ writeFile flagfile ""
+		return MadeChange
+
 	flagfile = "/etc/propellor-cleaninstall"
 
-data Confirmed = Confirmed HostName
+data Confirmation = Confirmed HostName
 
-checkConfirmed :: Confirmed -> Propellor ()
-checkConfirmed (Confirmed c) = do
+confirmed :: Desc -> Confirmation -> Property
+confirmed desc (Confirmed c) = property desc $ do
 	hostname <- asks hostName
-	when (hostname /= c) $
-		errorMessage "Run with a bad confirmation, not matching hostname."
-
--- | Sometimes you want an almost clean install, but with some tweaks.
-data Tweak
-	= UseOldKernel -- ^ Leave /boot and /lib/modules from old OS, so the system can boot using them as before
-	| BackupOldOS -- ^ Back up old OS to /old-os, to avoid losing any important files
+	if hostname /= c
+		then do
+			warningMessage "Run with a bad confirmation, not matching hostname."
+			return FailedChange
+		else return NoChange
 
 -- /etc/network/interfaces is configured to bring up all interfaces that
 -- are currently up, using the same IP addresses.
@@ -97,12 +144,19 @@ 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
 kernelInstalled = undefined
 
+-- Copies kernel images, initrds, and modules from /old-os
+-- into the new system.
+--
+-- TODO: grub config?
+oldOSKernelPreserved :: Property
+oldOSKernelPreserved = undefined
+
 -- Installs grub onto a device to boot the system.
 --
 -- You may want to install grub to multiple devices; eg for a system
@@ -113,12 +167,16 @@ grubBoots = undefined
 type GrubDev = String
 
 -- Removes the old OS's backup from /old-os
-oldOSRemoved :: Confirmed -> Property
-oldOSRemoved confirmed = check (doesDirectoryExist oldOsDir) $
-	property "old OS backup removed" $ do
-		checkConfirmed confirmed
-		liftIO $ removeDirectoryRecursive oldOsDir
+oldOSRemoved :: Confirmation -> Property
+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
 		return MadeChange
 
-oldOsDir :: FilePath
-oldOsDir = "/old-os"
+oldOSDir :: FilePath
+oldOSDir = "/old-os"
+
+newOSDir :: FilePath
+newOSDir = "/new-os"