diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index 099596f..ed9a31e 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -1,10 +1,10 @@ module Propellor.Property.OS ( cleanInstallOnce, - Confirmation - confirm, - fixupNetworkAddresses, + Confirmed(..), + fixupNetworkInterfaces, rootSshAuthorized, grubBoots, + GrubDev(..), kernelInstalled, oldOSRemoved, ) where @@ -12,6 +12,10 @@ module Propellor.Property.OS ( import Propellor import qualified Propellor.Property.Chroot as Chroot import qualified Propellor.Property.Debootstrap as Debootstrap +import qualified Propellor.Property.File as File +import Utility.FileMode + +import Utility.PosixFiles -- | Replaces whatever OS was installed before with a clean installation -- of the OS that the Host is configured to have. @@ -20,7 +24,7 @@ import qualified Propellor.Property.Debootstrap as Debootstrap -- 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 Context containing the name of the host that you intend to apply the +-- a Confirmed 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 @@ -32,7 +36,7 @@ import qualified Propellor.Property.Debootstrap as Debootstrap -- working system. For example: -- -- > & os (System (Debian Unstable) "amd64") --- > & cleanInstall (Context "foo.example.com") (BackupOldOS <> UseOldKernel) +-- > & cleanInstall (Confirmed "foo.example.com") [BackupOldOS, UseOldKernel] -- > `onChange` propertyList "fixing up after clean install" -- > [ fixupNetworkInterfaces -- > , rootSshAuthorized @@ -44,18 +48,17 @@ import qualified Propellor.Property.Debootstrap as Debootstrap -- > & User.accountFor "joey" -- > & User.hasSomePassword "joey" -- > -- rest of system properties here -cleanInstallOnce :: Context -> Exceptions -> Property -cleanInstallOnce (Context c) = check (not <$> doesFileExist flagfile) $ - Property "OS cleanly installed" $ do - hostname <- asks hostName - when (hostname /= c) $ - error "Run with bad context, not matching hostname. Not running cleanInstalOnce!" +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 + -- except for /boot and /lib/modules when UseOldKernel + -- (or, delete when not BackupOldOS) -- move /new-os to / -- touch flagfile -- re-bootstrap propellor in /usr/local/propellor, @@ -67,42 +70,60 @@ cleanInstallOnce (Context c) = check (not <$> doesFileExist flagfile) $ where flagfile = "/etc/propellor-cleaninstall" --- | Sometimes you want an almost clean install, but with some exceptions. -data Exceptions +data Confirmed = Confirmed HostName + +checkConfirmed :: Confirmed -> Propellor () +checkConfirmed (Confirmed c) = 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 - | NoExceptions - | CombinedExceptions Exceptions Exceptions - -instance Monoid Exceptions where - mempty = NoExceptions - mappend = CombinedExceptions -- /etc/network/interfaces is configured to bring up all interfaces that -- are currently up, using the same IP addresses. --- --- This property only does anything if it comes after cleanInstall, --- in the same propellor run where cleanInstall has made a change. fixupNetworkInterfaces :: Property fixupNetworkInterfaces = undefined --- /root/.ssh/authorized_keys is copied from the old os +-- 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. rootSshAuthorized :: Property -rootSshAuthorized = undefined +rootSshAuthorized = check (doesDirectoryExist oldloc) $ + property (newloc ++ " copied from old OS") $ do + ks <- liftIO $ lines <$> readFile oldloc + ensureProperty $ + newloc `File.containsLines` ks + `requires` File.dirExists (takeDirectory newloc) + `onChange` File.mode newloc mode + where + newloc = "/root/.ssh/authorized_keys" + oldloc = oldOsDir ++ newloc + -- ssh requires the file mode be locked down + mode = combineModes [ownerWriteMode, ownerReadMode] --- Installs an appropriate kernel from the distribution. +-- Installs an appropriate kernel from the OS distribution. kernelInstalled :: Property kernelInstalled = undefined --- Installs grub 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. grubBoots :: GrubDev -> Property grubBoots = undefined +type GrubDev = String + -- Removes the old OS's backup from /old-os -oldOSRemoved :: Property -oldOSRemoved = check (doesDirectoryExist oldOsDir) $ - Property "old OS backup removed" $ liftIO $ do - removeDirectoryRecursive oldOsDir +oldOSRemoved :: Confirmed -> Property +oldOSRemoved confirmed = check (doesDirectoryExist oldOsDir) $ + property "old OS backup removed" $ do + checkConfirmed confirmed + liftIO $ removeDirectoryRecursive oldOsDir return MadeChange oldOsDir :: FilePath