summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-12-05 16:22:11 -0400
committerJoey Hess2014-12-05 16:22:11 -0400
commitbf9284d05cf29e4058ca6007486fbe261b0e0769 (patch)
tree55ef76ec519098813d8c1bc86222f5b22b65fa79 /src
parent97e9433f1b719cc13fc524ee0399d0b51af5a5c1 (diff)
I have now successfully used propellor to convert a Fedora system into a bootable and fully working Debian system
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/Grub.hs42
-rw-r--r--src/Propellor/Property/OS.hs108
2 files changed, 99 insertions, 51 deletions
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.