From bf9284d05cf29e4058ca6007486fbe261b0e0769 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 5 Dec 2014 16:22:11 -0400 Subject: I have now successfully used propellor to convert a Fedora system into a bootable and fully working Debian system --- src/Propellor/Property/Grub.hs | 42 +++++++++++++++- src/Propellor/Property/OS.hs | 108 ++++++++++++++++++++++------------------- 2 files changed, 99 insertions(+), 51 deletions(-) (limited to 'src/Propellor') diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs index 841861f4..00592d0b 100644 --- a/src/Propellor/Property/Grub.hs +++ b/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"] - , 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" + , installed Xen + , 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 diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 3ed23fb4..30f8c4bb 100644 --- a/src/Propellor/Property/OS.hs +++ b/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 --- > -- , grubBoots "hd0" +-- > , Apt.update +-- > -- , 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 - rootcontents <- dirContents "/" - newrootcontents <- dirContents newOSDir + renamesout <- map (\d -> (d, oldOSDir ++ d, pure $ d `notElem` (oldOSDir:newOSDir:trickydirs))) + <$> dirContents "/" + renamesin <- map (\d -> let dest = "/" ++ takeFileName d in (d, dest, not <$> fileExist dest)) + <$> dirContents newOSDir 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 - ifM (not <$> fileExist dest) - ( return $ Just (d, dest) - , return Nothing - ) - massRename $ catMaybes (renamesout ++ renamesin) + massRename (renamesout ++ renamesin) removeDirectoryRecursive newOSDir - - -- Prepare environment for running additional properties. - liftIO $ writeFile flagfile "" + + -- Prepare environment for running additional properties, + -- 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) = - tryNonAsync (rename from to) + go undo ((from, to, test):rest) = ifM test + ( 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. -- cgit v1.2.3