summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Propellor/Property/OS.hs103
-rw-r--r--src/Propellor/Property/Ssh.hs13
-rw-r--r--src/Propellor/Spin.hs2
3 files changed, 74 insertions, 44 deletions
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index c96e20b3..5dddff2c 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.
---
--- 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
+preserveNetworkInterfaces :: Property
+preserveNetworkInterfaces = undefined
--- /root/.ssh/authorized_keys is copied from the old os
-fixupRootSsh :: Property
-fixupRootSsh = 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 an appropriate kernel from the distribution.
-installDistroKernel :: Property
-installDistroKernel = 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
--- 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 4ecdf23e..5d326b83 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 13678f53..3bafd165 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]