Merge branch 'joeyconfig'

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

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.
 --

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]