I have now successfully used propellor to convert a Fedora system into a bootable and fully working Debian system

config-joey.hs

@@ -57,8 +57,17 @@ testvm = host "testvm.kitenet.net"
 	& os (System (Debian Unstable) "amd64")
 	& OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net")
 	 	`onChange` propertyList "fixing up after clean install"
-	 		[ OS.preserveRootSshAuthorized
+	 		[ User.shadowConfig True
+			, OS.preserveRootSshAuthorized
+			, OS.preserveResolvConf
+			, Apt.update
+			, Grub.boots "/dev/sda"
+				`requires` Grub.installed Grub.PC
 	 		]
+	& Hostname.sane
+	& Hostname.searchDomain
+	& Apt.installed ["linux-image-amd64"]
+	& Apt.installed ["ssh"]
 
 darkstar :: Host
 darkstar = host "darkstar.kitenet.net"

debian/changelog

@@ -17,6 +17,7 @@ propellor (1.1.0) UNRELEASED; urgency=medium
     to do an in-place conversion from Fedora to Debian. Use with caution!
   * Added group-related properties. Thanks, Félix Sipma.
   * Added Git.barerepo. Thanks, Félix Sipma.
+  * Added Grub.installed and Grub.boots properties.
   * hasSomePassword and hasPassword now default to using the name of the
     host as the Context for the password. To specify a different context,
     use hasSomePassword' and hasPassword' (API change)

src/Propellor/Property/Grub.hs

@@ -7,8 +7,46 @@ import qualified Propellor.Property.Apt as Apt
 -- | Eg, hd0,0 or xen/xvda1
 type GrubDevice = String
 
+-- | Eg, /dev/sda
+type OSDevice = String
+
 type TimeoutSecs = Int
 
+-- | Types of machines that grub can boot.
+data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen
+
+-- | Installs the grub package. This does not make grub be used as the
+-- bootloader.
+--
+-- This includes running update-grub, so that the grub boot menu is
+-- created. It will be automatically updated when kernel packages are
+-- installed.
+installed :: BIOS -> Property
+installed bios = 
+	Apt.installed [pkg] `describe` "grub package installed"
+		`before`
+	cmdProperty "update-grub" []
+  where
+	pkg = case bios of
+		PC -> "grub-pc"
+		EFI64 -> "grub-efi-amd64"
+		EFI32 -> "grub-efi-ia32"
+		Coreboot -> "grub-coreboot"
+		Xen -> "grub-xen"
+
+-- | Installs grub onto a device, so the system can boot from that device.
+--
+-- You may want to install grub to multiple devices; eg for a system
+-- that uses software RAID.
+--
+-- Note that this property does not check if grub is already installed
+-- on the device; it always does the work to reinstall it. It's a good idea
+-- to arrange for this property to only run once, by eg making it be run
+-- onChange after OS.cleanInstallOnce.
+boots :: OSDevice -> Property
+boots dev = cmdProperty "grub-install" [dev]
+	`describe` ("grub boots " ++ dev)
+
 -- | Use PV-grub chaining to boot
 --
 -- Useful when the VPS's pv-grub is too old to boot a modern kernel image.
@@ -31,8 +69,8 @@ chainPVGrub rootdev bootdev timeout = combineProperties desc
 		]
 	, "/boot/load.cf" `File.hasContent`
 		[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
-	, Apt.installed ["grub-xen"]
+	, installed Xen
-	, flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
+	, flagFile (scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
 			`describe` "/boot-xen-shim"
 	]
   where

src/Propellor/Property/OS.hs

@@ -2,20 +2,19 @@ module Propellor.Property.OS (
 	cleanInstallOnce,
 	Confirmation(..),
 	preserveNetworkInterfaces,
+	preserveResolvConf,
 	preserveRootSshAuthorized,
-	grubBoots,
-	GrubDev,
 	rebootForced,
-	kernelInstalled,
 	oldOSRemoved,
 ) where
 
 import Propellor
 import qualified Propellor.Property.Debootstrap as Debootstrap
 import qualified Propellor.Property.Ssh as Ssh
-import qualified Propellor.Property.User as User
+import qualified Propellor.Property.File as File
 import Propellor.Property.Mount
 import Propellor.Property.Chroot.Util (stdPATH)
+import Utility.SafeCommand
 
 import System.Posix.Files (rename, fileExist)
 import Control.Exception (throw)
@@ -36,20 +35,27 @@ import Control.Exception (throw)
 -- 
 -- The files from the old os will be left in /old-os
 --
+-- TODO: A forced reboot should be schedued to run after propellor finishes
+-- ensuring all properties of the host.
+--
 -- You will typically want to run some more properties after the clean
 -- install succeeds, to bootstrap from the cleanly installed system to
 -- a fully working system. For example:
 --
 -- > & os (System (Debian Unstable) "amd64")
--- > & cleanInstall (Confirmed "foo.example.com")
+-- > & cleanInstallOnce (Confirmed "foo.example.com")
 -- >    `onChange` propertyList "fixing up after clean install"
--- >        [ preserveNetworkInterfaces
+-- >        [ User.shadowConfig True
+-- >        , preserveNetworkInterfaces
+-- >        , preserveResolvConf
 -- >        , preserverRootSshAuthorized
--- >        -- , kernelInstalled
+-- >        , Apt.update
--- >        -- , grubBoots "hd0"
+-- >        -- , Grub.boots "/dev/sda"
+-- >        --   `requires` Grub.installed Grub.PC
 -- >        -- , oldOsRemoved (Confirmed "foo.example.com")
--- >        -- , rebootForced
 -- >        ]
+-- > & Hostname.sane
+-- > & Apt.installed ["linux-image-amd64"]
 -- > & Apt.installed ["ssh"]
 -- > & User.hasSomePassword "root"
 -- > & User.accountFor "joey"
@@ -64,12 +70,8 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 			`requires`
 		propellorbootstrapped
 			`requires`
-		User.shadowConfig True
-			`requires`
 		flipped
 			`requires`
-		umountall
-			`requires`
 		osbootstrapped
 
 	osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of
@@ -79,33 +81,42 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 	debootstrap targetos = ensureProperty $ toProp $
 		Debootstrap.built newOSDir targetos Debootstrap.DefaultConfig
 	
-	umountall = property "mount points unmounted" $ liftIO $ do
+	flipped = property (newOSDir ++ " moved into place") $ liftIO $ do
+		-- First, unmount most mount points, lazily, so
+		-- they don't interfere with moving things around.
+		devfstype <- fromMaybe "devtmpfs" <$> getFsType "/dev"
 		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
+		renamesout <- map (\d -> (d, oldOSDir ++ d, pure $ d `notElem` (oldOSDir:newOSDir:trickydirs)))
-		rootcontents <- dirContents "/"
+			<$> dirContents "/"
-		newrootcontents <- dirContents newOSDir
+		renamesin <- map (\d -> let dest = "/" ++ takeFileName d in (d, dest, not <$> fileExist dest))
+			<$> dirContents newOSDir
 		createDirectoryIfMissing True oldOSDir
-		renamesout <- forM rootcontents $ \d ->
+		massRename (renamesout ++ renamesin)
-			if d `notElem` (oldOSDir:newOSDir:trickydirs)
-				then return $ Just (d, oldOSDir ++ d)
-				else return Nothing
-		renamesin <- forM newrootcontents $ \d -> do
-			let dest = "/" ++ takeFileName d
-			ifM (not <$> fileExist dest)
-				( return $ Just (d, dest)
-				, return Nothing
-				)
-		massRename $ catMaybes (renamesout ++ renamesin)
 		removeDirectoryRecursive newOSDir
-
+		
-		-- Prepare environment for running additional properties.
+		-- Prepare environment for running additional properties,
-		liftIO $ writeFile flagfile ""
+		-- overriding old OS's environment.
 		void $ setEnv "PATH" stdPATH True
+		void $ unsetEnv "LANG"
 
+		-- Remount /dev, so that block devices etc are
+		-- available for other properties to use.
+		unlessM (mount devfstype devfstype "/dev") $ do
+			warningMessage $ "failed mounting /dev using " ++ devfstype ++ "; falling back to MAKEDEV generic"
+			void $ boolSystem "sh" [Param "-c", Param "cd /dev && /sbin/MAKEDEV generic"]
+
+		-- Mount /sys too, needed by eg, grub-mkconfig.
+		unlessM (mount "sysfs" "sysfs" "/sys") $
+			warningMessage "failed mounting /sys"
+
+		-- And /dev/pts, used by apt.
+		unlessM (mount "devpts" "devpts" "/dev/pts") $
+			warningMessage "failed mounting /dev/pts"
+
+		liftIO $ writeFile flagfile ""
 		return MadeChange
 
 	propellorbootstrapped = property "propellor re-debootstrapped in new os" $
@@ -133,15 +144,17 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
 -- 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 :: [(FilePath, FilePath, IO Bool)] -> IO ()
 massRename = go []
   where
 	go _ [] = return ()
-	go undo ((from, to):rest) =
+	go undo ((from, to, test):rest) = ifM test
-		tryNonAsync (rename from to)
+		( tryNonAsync (rename from to)
 			>>= either
 				(rollback undo)
 				(const $ go ((to, from):undo) rest)
+		, go undo rest
+		)
 	rollback undo e = do
 		mapM_ (uncurry rename) undo
 		throw e
@@ -162,11 +175,21 @@ confirmed desc (Confirmed c) = property desc $ do
 preserveNetworkInterfaces :: Property
 preserveNetworkInterfaces = undefined
 
+-- | /etc/resolv.conf is copied the from the old OS
+preserveResolvConf :: Property
+preserveResolvConf = check (fileExist oldloc) $
+	property (newloc ++ " copied from old OS") $ do
+		ls <- liftIO $ lines <$> readFile oldloc
+		ensureProperty $ newloc `File.hasContent` ls
+  where
+	newloc = "/etc/resolv.conf"
+	oldloc = oldOSDir ++ newloc
+
 -- | Root's .ssh/authorized_keys has added to it any ssh keys that
 -- were authorized in the old OS. Any other contents of the file are
 -- retained.
 preserveRootSshAuthorized :: Property
-preserveRootSshAuthorized = check (doesDirectoryExist oldloc) $
+preserveRootSshAuthorized = check (fileExist oldloc) $
 	property (newloc ++ " copied from old OS") $ do
 		ks <- liftIO $ lines <$> readFile oldloc
 		ensureProperties (map (Ssh.authorizedKey "root") ks)
@@ -174,19 +197,6 @@ preserveRootSshAuthorized = check (doesDirectoryExist oldloc) $
 	newloc = "/root/.ssh/authorized_keys"
 	oldloc = oldOSDir ++ newloc
 
--- | Installs an appropriate kernel from the OS distribution.
-kernelInstalled :: Property
-kernelInstalled = undefined
-
--- | Installs grub onto a device to boot the system.
---
--- You may want to install grub to multiple devices; eg for a system
--- that uses software RAID.
-grubBoots :: GrubDev -> Property
-grubBoots = undefined
-
-type GrubDev = String
-
 -- | Forces an immediate reboot, without contacting the init system.
 --
 -- Can be used after cleanInstallOnce.