summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/OS.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-24 00:40:53 -0400
committerJoey Hess2014-11-24 00:40:53 -0400
commitccdbf0026dcfdbc5bd9896c4c0fcc8fccf4bd15a (patch)
tree7b74c772d97319a73c23a81f2e1a631c098b6558 /src/Propellor/Property/OS.hs
parentf85026da7f31c9896bf0207e3d58a7f080be82fc (diff)
more work; builds now
Diffstat (limited to 'src/Propellor/Property/OS.hs')
-rw-r--r--src/Propellor/Property/OS.hs83
1 files changed, 52 insertions, 31 deletions
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 099596fe..ed9a31e1 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