diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs index c96e20b..5dddff2 100644 --- a/src/Propellor/Property/OS.hs +++ b/src/Propellor/Property/OS.hs @@ -1,15 +1,20 @@ module Propellor.Property.OS ( cleanInstallOnce, - Confirmation - confirm, - fixupNetworkAddresses, - fixupRootSsh, + Confirmed(..), + preserveNetworkInterfaces, + preserveRootSshAuthorized, + grubBoots, + GrubDev(..), + 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 -- | Replaces whatever OS was installed before with a clean installation -- of the OS that the Host is configured to have. @@ -18,7 +23,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 @@ -30,30 +35,29 @@ 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 --- > , fixupRootSsh --- > -- , installDistroKernel --- > -- , installGrub +-- > [ preserveNetworkInterfaces +-- > , preserverRootSshAuthorized +-- > -- , kernelInstalled +-- > -- , grubBoots "hd0" -- > ] -- > & Apt.installed ["ssh"] -- > & User.hasSomePassword "root" -- > & 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, @@ -65,42 +69,55 @@ 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. +preserveNetworkInterfaces :: Property +preserveNetworkInterfaces = undefined + +-- 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) $ + 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 + +-- Installs grub onto a device to boot the system. -- --- 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 +-- You may want to install grub to multiple devices; eg for a system +-- that uses software RAID. +grubBoots :: GrubDev -> Property +grubBoots = undefined --- /root/.ssh/authorized_keys is copied from the old os -fixupRootSsh :: Property -fixupRootSsh = undefined - --- Installs an appropriate kernel from the distribution. -installDistroKernel :: Property -installDistroKernel = undefined - --- Installs grub to boot the system. -installGrub :: Property -installGrub = 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 diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs index 4ecdf23..5d326b8 100644 --- a/src/Propellor/Property/Ssh.hs +++ b/src/Propellor/Property/Ssh.hs @@ -3,6 +3,7 @@ module Propellor.Property.Ssh ( permitRootLogin, passwordAuthentication, hasAuthorizedKeys, + authorizedKey, restarted, randomHostKeys, hostKeys, @@ -155,6 +156,8 @@ knownHost hosts hn user = property desc $ return FailedChange -- | Makes a user have authorized_keys from the PrivData +-- +-- This removes any other lines from the file. authorizedKeys :: UserName -> Context -> Property authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \get -> property (user ++ " has authorized_keys") $ get $ \v -> do @@ -167,6 +170,16 @@ authorizedKeys user context = withPrivData (SshAuthorizedKeys user) context $ \g , File.ownerGroup (takeDirectory f) user user ] +-- | Ensures that a user's authorized_keys contains a line. +-- Any other lines in the file are preserved as-is. +authorizedKey :: UserName -> String -> Property +authorizedKey user l = property (user ++ " has autorized_keys line " ++ l) $ do + f <- liftIO $ dotFile "authorized_keys" user + ensureProperty $ + f `File.containsLine` l + `requires` File.dirExists (takeDirectory f) + `onChange` File.mode f (combineModes [ownerWriteMode, ownerReadMode]) + -- | Makes the ssh server listen on a given port, in addition to any other -- ports it is configured to listen on. -- diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 13678f5..3bafd16 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -278,7 +278,7 @@ mergeSpin = do old_head <- getCurrentGitSha1 branch old_commit <- findLastNonSpinCommit rungit "reset" [Param old_commit] - rungit "commit" [Param "-a", "--allow-empty"] + rungit "commit" [Param "-a", Param "--allow-empty"] rungit "merge" =<< gpgSignParams [Param "-s", Param "ours", Param old_head] current_commit <- getCurrentGitSha1 branch rungit "update-ref" [Param branchref, Param current_commit]