From f78c2f16d1c93ee6fe2620916b7584d91d116723 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 3 Dec 2014 19:05:18 -0400 Subject: update name of libgnutls dev package --- src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 0208dea6..bf87b210 100644 --- a/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -76,7 +76,7 @@ buildDepsNoHaskellLibs = Apt.installed "debhelper", "ghc", "curl", "openssh-client", "git-remote-gcrypt", "liblockfile-simple-perl", "cabal-install", "vim", "less", -- needed by haskell libs - "libxml2-dev", "libidn11-dev", "libgsasl7-dev", "libgnutls-dev", + "libxml2-dev", "libidn11-dev", "libgsasl7-dev", "libgnutls28-dev", "alex", "happy", "c2hs" ] -- cgit v1.2.3 From f1fd75c9ecee5f398a25488c73a541d4135887da Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 4 Dec 2014 17:11:15 -0400 Subject: more work on OS takeover --- config-joey.hs | 10 +-- propellor.cabal | 1 + src/Propellor/Property/Chroot/Util.hs | 7 +- src/Propellor/Property/Debootstrap.hs | 8 +- src/Propellor/Property/OS.hs | 138 ++++++++++++++++++++++++---------- src/Propellor/Property/User.hs | 12 +++ 6 files changed, 122 insertions(+), 54 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index b617ccfa..a1ea21d1 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -54,11 +54,11 @@ hosts = -- (o) ` testvm :: Host testvm = host "testvm.kitenet.net" - & Chroot.provisioned (Chroot.debootstrapped (System (Debian Unstable) "amd64") Debootstrap.DefaultConfig "/new-os") - -- & OS.cleanInstall (OS.Confirmed "foo.example.com") [] - -- `onChange` propertyList "fixing up after clean install" - -- [ - -- ] + & os (System (Debian Unstable) "amd64") + & OS.cleanInstallOnce (OS.Confirmed "testvm.kitenet.net") + `onChange` propertyList "fixing up after clean install" + [ OS.preserveRootSshAuthorized + ] darkstar :: Host darkstar = host "darkstar.kitenet.net" 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/Chroot/Util.hs b/src/Propellor/Property/Chroot/Util.hs index feb71d01..382fbab7 100644 --- a/src/Propellor/Property/Chroot/Util.hs +++ b/src/Propellor/Property/Chroot/Util.hs @@ -9,7 +9,8 @@ import Control.Applicative standardPathEnv :: IO [(String, String)] standardPathEnv = do path <- getEnvDefault "PATH" "/bin" - addEntry "PATH" (path ++ std) + addEntry "PATH" (path ++ stdPATH) <$> getEnvironment - where - std = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin" + +stdPATH :: String +stdPATH = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin" 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/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" diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs index 434a92a3..ccb69b24 100644 --- a/src/Propellor/Property/User.hs +++ b/src/Propellor/Property/User.hs @@ -84,3 +84,15 @@ hasGroup user group' = check test $ cmdProperty "adduser" `describe` unwords ["user", user, "in group", group'] where test = not . elem group' . words <$> readProcess "groups" [user] + +-- | Controls whether shadow passwords are enabled or not. +shadowConfig :: Bool -> Property +shadowConfig True = check (not <$> shadowExists) $ + cmdProperty "shadowconfig" ["on"] + `describe` "shadow passwords enabled" +shadowConfig False = check shadowExists $ + cmdProperty "shadowconfig" ["off"] + `describe` "shadow passwords disabled" + +shadowExists :: IO Bool +shadowExists = doesFileExist "/etc/shadow" -- cgit v1.2.3 From 4be893f0bf26990b65828841f00062d2acfff5f2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 4 Dec 2014 17:30:40 -0400 Subject: more improvements to takeover --- src/Propellor/Property/OS.hs | 70 ++++++++++++++++++++++++-------------------- 1 file changed, 38 insertions(+), 32 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index cbdb4d99..b81b7c4e 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -4,8 +4,8 @@ module Propellor.Property.OS ( preserveNetworkInterfaces, preserveRootSshAuthorized, grubBoots, - GrubDev(..), - oldOSKernelPreserved, + GrubDev, + rebootForced, kernelInstalled, oldOSRemoved, ) where @@ -15,6 +15,7 @@ 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 +import Propellor.Property.Chroot.Util (stdPATH) import System.Posix.Files (rename, fileExist) @@ -24,29 +25,29 @@ import System.Posix.Files (rename, fileExist) -- 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 Confirmation containing the name of the host that you intend to apply the --- property to. +-- 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 -- a file /etc/propellor-cleaninstall, which indicates it was cleanly -- installed. +-- +-- The files from the old os will be left in /old-os -- -- You will typically want to run some more properties after the clean --- install, to bootstrap from the cleanly installed system to a fully --- working system. For example: +-- 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") -- > `onChange` propertyList "fixing up after clean install" -- > [ preserveNetworkInterfaces -- > , preserverRootSshAuthorized --- > , oldOSKernelPreserved -- > -- , kernelInstalled -- > -- , grubBoots "hd0" --- > -- , oldOsRemoved +-- > -- , oldOsRemoved (Confirmed "foo.example.com") +-- > -- , rebootForced -- > ] -- > & Apt.installed ["ssh"] -- > & User.hasSomePassword "root" @@ -95,15 +96,12 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ whenM (not <$> fileExist dest) $ rename d dest removeDirectoryRecursive newOSDir + + -- Prepare environment for running additional properties. + liftIO $ writeFile flagfile "" + void $ setEnv "PATH" stdPATH True + 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 @@ -111,12 +109,21 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ -- (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) + -- TODO - finalized = property "clean OS installed" $ do - liftIO $ writeFile flagfile "" - return MadeChange + -- Ensure that MadeChange is returned by the overall property, + -- so that anything hooking in onChange will run afterwards. + finalized = property "clean OS installed" $ return MadeChange flagfile = "/etc/propellor-cleaninstall" + + trickydirs = + -- /tmp can contain X's sockets, which prevent moving it + -- so it's left as-is. + [ "/tmp" + -- /proc is left mounted + , "/proc" + ] data Confirmation = Confirmed HostName @@ -129,12 +136,12 @@ confirmed desc (Confirmed c) = property desc $ do return FailedChange else return NoChange --- /etc/network/interfaces is configured to bring up all interfaces that +-- | /etc/network/interfaces is configured to bring up all interfaces that -- are currently up, using the same IP addresses. preserveNetworkInterfaces :: Property preserveNetworkInterfaces = undefined --- Root's .ssh/authorized_keys has added to it any ssh keys that +-- | 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 @@ -146,18 +153,11 @@ preserveRootSshAuthorized = check (doesDirectoryExist oldloc) $ newloc = "/root/.ssh/authorized_keys" oldloc = oldOSDir ++ newloc --- Installs an appropriate kernel from the OS distribution. +-- | 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. +-- | 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. @@ -166,6 +166,12 @@ grubBoots = undefined type GrubDev = String +-- | Forces an immediate reboot, without contacting the init system. +-- +-- Can be used after cleanInstallOnce. +rebootForced :: Property +rebootForced = cmdProperty "reboot" [ "--force" ] + -- Removes the old OS's backup from /old-os oldOSRemoved :: Confirmation -> Property oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $ -- cgit v1.2.3 From 97e9433f1b719cc13fc524ee0399d0b51af5a5c1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 5 Dec 2014 12:50:01 -0400 Subject: rollback if renameing fails This avoids leaving the system in a broken state where some directories have been renamed away any others not. Future work: If the rename list contains (foo, bar) and (newfoo,foo), reorder the list to gather those two actions together to minimize the amount of time that foo is missing. In case of power loss or something. --- src/Propellor/Property/OS.hs | 35 ++++++++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index b81b7c4e..3ed23fb4 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -18,6 +18,7 @@ import Propellor.Property.Mount import Propellor.Property.Chroot.Util (stdPATH) import System.Posix.Files (rename, fileExist) +import Control.Exception (throw) -- | Replaces whatever OS was installed before with a clean installation -- of the OS that the Host is configured to have. @@ -85,16 +86,20 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ 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 + 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 - whenM (not <$> fileExist dest) $ - rename d dest + ifM (not <$> fileExist dest) + ( return $ Just (d, dest) + , return Nothing + ) + massRename $ catMaybes (renamesout ++ renamesin) removeDirectoryRecursive newOSDir -- Prepare environment for running additional properties. @@ -125,6 +130,22 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $ , "/proc" ] +-- 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 = go [] + where + go _ [] = return () + go undo ((from, to):rest) = + tryNonAsync (rename from to) + >>= either + (rollback undo) + (const $ go ((to, from):undo) rest) + rollback undo e = do + mapM_ (uncurry rename) undo + throw e + data Confirmation = Confirmed HostName confirmed :: Desc -> Confirmation -> Property -- cgit v1.2.3 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 --- config-joey.hs | 11 ++++- debian/changelog | 1 + src/Propellor/Property/Grub.hs | 42 +++++++++++++++- src/Propellor/Property/OS.hs | 108 ++++++++++++++++++++++------------------- 4 files changed, 110 insertions(+), 52 deletions(-) (limited to 'src') diff --git a/config-joey.hs b/config-joey.hs index a1ea21d1..b41af4a2 100644 --- a/config-joey.hs +++ b/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" diff --git a/debian/changelog b/debian/changelog index 079a737c..7ee1198b 100644 --- a/debian/changelog +++ b/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) 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