Merge branch 'joeyconfig'

This commit is contained in:
Joey Hess 2014-11-24 00:52:46 -04:00
commit 24bce96210
3 changed files with 75 additions and 45 deletions

View File

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

View File

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

View File

@ -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]