summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/OS.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/OS.hs')
-rw-r--r--src/Propellor/Property/OS.hs221
1 files changed, 158 insertions, 63 deletions
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 5dddff2c..30f8c4bb 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -1,20 +1,23 @@
module Propellor.Property.OS (
cleanInstallOnce,
- Confirmed(..),
+ Confirmation(..),
preserveNetworkInterfaces,
+ preserveResolvConf,
preserveRootSshAuthorized,
- grubBoots,
- GrubDev(..),
- kernelInstalled,
+ rebootForced,
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.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)
-- | Replaces whatever OS was installed before with a clean installation
-- of the OS that the Host is configured to have.
@@ -23,102 +26,194 @@ import Utility.FileMode
-- But, it can also fail and leave the system in an unbootable state.
--
-- 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
--- 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
+--
+-- 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, 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") [BackupOldOS, UseOldKernel]
+-- > & 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")
-- > ]
+-- > & Hostname.sane
+-- > & Apt.installed ["linux-image-amd64"]
-- > & 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`
+ flipped
+ `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
+
+ 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
+
+ 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
+ massRename (renamesout ++ renamesin)
+ removeDirectoryRecursive newOSDir
+
+ -- 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" $
+ 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
+ -- TODO
+
+ -- 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"
+ ]
+
+-- 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 Bool)] -> IO ()
+massRename = go []
+ where
+ go _ [] = return ()
+ 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
-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
+-- | /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
+-- | /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)
where
newloc = "/root/.ssh/authorized_keys"
- oldloc = oldOsDir ++ newloc
-
--- Installs an appropriate kernel from the OS distribution.
-kernelInstalled :: Property
-kernelInstalled = undefined
+ oldloc = oldOSDir ++ newloc
--- Installs grub onto a device to boot the system.
+-- | Forces an immediate reboot, without contacting the init 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
+-- Can be used after cleanInstallOnce.
+rebootForced :: Property
+rebootForced = cmdProperty "reboot" [ "--force" ]
-- 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"