summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-12-05 16:23:07 -0400
committerJoey Hess2014-12-05 16:23:07 -0400
commitdbc76b1e5225a28b84efa14659ff1c0c1d5fc463 (patch)
tree1a3f95f33ded5798987ab02cd851d8ec7ea24cfa /src
parenta380ea8390984afa28c2956fc9a6e011a1b93763 (diff)
parent2559b2348207ed9e914999e92fe9d26da0e1f5ad (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/Chroot/Util.hs7
-rw-r--r--src/Propellor/Property/Debootstrap.hs8
-rw-r--r--src/Propellor/Property/Grub.hs42
-rw-r--r--src/Propellor/Property/OS.hs221
-rw-r--r--src/Propellor/Property/User.hs12
5 files changed, 216 insertions, 74 deletions
diff --git a/src/Propellor/Property/Chroot/Util.hs b/src/Propellor/Property/Chroot/Util.hs
index feb71d01..382fbab7 100644
--- a/src/Propellor/Property/Chroot/Util.hs
+++ b/src/Propellor/Property/Chroot/Util.hs
@@ -9,7 +9,8 @@ import Control.Applicative
standardPathEnv :: IO [(String, String)]
standardPathEnv = do
path <- getEnvDefault "PATH" "/bin"
- addEntry "PATH" (path ++ std)
+ addEntry "PATH" (path ++ stdPATH)
<$> getEnvironment
- where
- std = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"
+
+stdPATH :: String
+stdPATH = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin"
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index ab5bddf4..35d9e472 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -9,6 +9,7 @@ module Propellor.Property.Debootstrap (
import Propellor
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Chroot.Util
+import Propellor.Property.Mount
import Utility.Path
import Utility.SafeCommand
import Utility.FileMode
@@ -95,9 +96,7 @@ built target system@(System _ arch) config =
submnts <- filter (\p -> simplifyPath p /= simplifyPath target)
. filter (dirContains target)
<$> mountPoints
- forM_ submnts $ \mnt ->
- unlessM (boolSystem "umount" [ Param "-l", Param mnt ]) $ do
- errorMessage $ "failed unmounting " ++ mnt
+ forM_ submnts umountLazy
removeDirectoryRecursive target
-- A failed debootstrap run will leave a debootstrap directory;
@@ -109,9 +108,6 @@ built target system@(System _ arch) config =
, return False
)
-mountPoints :: IO [FilePath]
-mountPoints = lines <$> readProcess "findmnt" ["-rn", "--output", "target"]
-
extractSuite :: System -> Maybe String
extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
extractSuite (System (Ubuntu r) _) = Just r
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index 841861f4..00592d0b 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -7,8 +7,46 @@ import qualified Propellor.Property.Apt as Apt
-- | Eg, hd0,0 or xen/xvda1
type GrubDevice = String
+-- | Eg, /dev/sda
+type OSDevice = String
+
type TimeoutSecs = Int
+-- | Types of machines that grub can boot.
+data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen
+
+-- | Installs the grub package. This does not make grub be used as the
+-- bootloader.
+--
+-- This includes running update-grub, so that the grub boot menu is
+-- created. It will be automatically updated when kernel packages are
+-- installed.
+installed :: BIOS -> Property
+installed bios =
+ Apt.installed [pkg] `describe` "grub package installed"
+ `before`
+ cmdProperty "update-grub" []
+ where
+ pkg = case bios of
+ PC -> "grub-pc"
+ EFI64 -> "grub-efi-amd64"
+ EFI32 -> "grub-efi-ia32"
+ Coreboot -> "grub-coreboot"
+ Xen -> "grub-xen"
+
+-- | Installs grub onto a device, so the system can boot from that device.
+--
+-- You may want to install grub to multiple devices; eg for a system
+-- that uses software RAID.
+--
+-- Note that this property does not check if grub is already installed
+-- on the device; it always does the work to reinstall it. It's a good idea
+-- to arrange for this property to only run once, by eg making it be run
+-- onChange after OS.cleanInstallOnce.
+boots :: OSDevice -> Property
+boots dev = cmdProperty "grub-install" [dev]
+ `describe` ("grub boots " ++ dev)
+
-- | Use PV-grub chaining to boot
--
-- Useful when the VPS's pv-grub is too old to boot a modern kernel image.
@@ -31,8 +69,8 @@ chainPVGrub rootdev bootdev timeout = combineProperties desc
]
, "/boot/load.cf" `File.hasContent`
[ "configfile (" ++ bootdev ++ ")/boot/grub/grub.cfg" ]
- , Apt.installed ["grub-xen"]
- , flagFile (scriptProperty ["update-grub; grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
+ , installed Xen
+ , flagFile (scriptProperty ["grub-mkimage --prefix '(" ++ bootdev ++ ")/boot/grub' -c /boot/load.cf -O x86_64-xen /usr/lib/grub/x86_64-xen/*.mod > /boot/xen-shim"]) "/boot/xen-shim"
`describe` "/boot-xen-shim"
]
where
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 5dddff2c..30f8c4bb 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -1,20 +1,23 @@
module Propellor.Property.OS (
cleanInstallOnce,
- Confirmed(..),
+ Confirmation(..),
preserveNetworkInterfaces,
+ preserveResolvConf,
preserveRootSshAuthorized,
- grubBoots,
- GrubDev(..),
- kernelInstalled,
+ rebootForced,
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
+import qualified Propellor.Property.File as File
+import Propellor.Property.Mount
+import Propellor.Property.Chroot.Util (stdPATH)
+import Utility.SafeCommand
+
+import System.Posix.Files (rename, fileExist)
+import Control.Exception (throw)
-- | Replaces whatever OS was installed before with a clean installation
-- of the OS that the Host is configured to have.
@@ -23,102 +26,194 @@ import Utility.FileMode
-- 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 Confirmed containing the name of the host that you intend to apply the
--- property to.
+-- a Confirmation 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
-- a file /etc/propellor-cleaninstall, which indicates it was cleanly
-- installed.
+--
+-- The files from the old os will be left in /old-os
+--
+-- TODO: A forced reboot should be schedued to run after propellor finishes
+-- ensuring all properties of the host.
--
-- You will typically want to run some more properties after the clean
--- install, to bootstrap from the cleanly installed system to a fully
--- working system. For example:
+-- install succeeds, to bootstrap from the cleanly installed system to
+-- a fully working system. For example:
--
-- > & os (System (Debian Unstable) "amd64")
--- > & cleanInstall (Confirmed "foo.example.com") [BackupOldOS, UseOldKernel]
+-- > & cleanInstallOnce (Confirmed "foo.example.com")
-- > `onChange` propertyList "fixing up after clean install"
--- > [ preserveNetworkInterfaces
+-- > [ User.shadowConfig True
+-- > , preserveNetworkInterfaces
+-- > , preserveResolvConf
-- > , preserverRootSshAuthorized
--- > -- , kernelInstalled
--- > -- , grubBoots "hd0"
+-- > , Apt.update
+-- > -- , Grub.boots "/dev/sda"
+-- > -- `requires` Grub.installed Grub.PC
+-- > -- , oldOsRemoved (Confirmed "foo.example.com")
-- > ]
+-- > & Hostname.sane
+-- > & Apt.installed ["linux-image-amd64"]
-- > & Apt.installed ["ssh"]
-- > & User.hasSomePassword "root"
-- > & User.accountFor "joey"
-- > & User.hasSomePassword "joey"
-- > -- rest of system properties here
-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 when UseOldKernel
- -- (or, delete when not BackupOldOS)
- -- move /new-os to /
- -- touch flagfile
+cleanInstallOnce :: Confirmation -> Property
+cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
+ go `requires` confirmed "clean install confirmed" confirmation
+ where
+ go =
+ finalized
+ `requires`
+ propellorbootstrapped
+ `requires`
+ flipped
+ `requires`
+ osbootstrapped
+
+ osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of
+ (Just d@(System (Debian _) _)) -> debootstrap d
+ (Just u@(System (Ubuntu _) _)) -> debootstrap u
+ _ -> error "os is not declared to be Debian or Ubuntu"
+ debootstrap targetos = ensureProperty $ toProp $
+ Debootstrap.built newOSDir targetos Debootstrap.DefaultConfig
+
+ flipped = property (newOSDir ++ " moved into place") $ liftIO $ do
+ -- First, unmount most mount points, lazily, so
+ -- they don't interfere with moving things around.
+ devfstype <- fromMaybe "devtmpfs" <$> getFsType "/dev"
+ mnts <- filter (`notElem` ("/": trickydirs)) <$> mountPoints
+ -- reverse so that deeper mount points come first
+ forM_ (reverse mnts) umountLazy
+
+ renamesout <- map (\d -> (d, oldOSDir ++ d, pure $ d `notElem` (oldOSDir:newOSDir:trickydirs)))
+ <$> dirContents "/"
+ renamesin <- map (\d -> let dest = "/" ++ takeFileName d in (d, dest, not <$> fileExist dest))
+ <$> dirContents newOSDir
+ createDirectoryIfMissing True oldOSDir
+ massRename (renamesout ++ renamesin)
+ removeDirectoryRecursive newOSDir
+
+ -- Prepare environment for running additional properties,
+ -- overriding old OS's environment.
+ void $ setEnv "PATH" stdPATH True
+ void $ unsetEnv "LANG"
+
+ -- Remount /dev, so that block devices etc are
+ -- available for other properties to use.
+ unlessM (mount devfstype devfstype "/dev") $ do
+ warningMessage $ "failed mounting /dev using " ++ devfstype ++ "; falling back to MAKEDEV generic"
+ void $ boolSystem "sh" [Param "-c", Param "cd /dev && /sbin/MAKEDEV generic"]
+
+ -- Mount /sys too, needed by eg, grub-mkconfig.
+ unlessM (mount "sysfs" "sysfs" "/sys") $
+ warningMessage "failed mounting /sys"
+
+ -- And /dev/pts, used by apt.
+ unlessM (mount "devpts" "devpts" "/dev/pts") $
+ warningMessage "failed mounting /dev/pts"
+
+ liftIO $ writeFile flagfile ""
+ return MadeChange
+
+ propellorbootstrapped = property "propellor re-debootstrapped in new os" $
+ return NoChange
-- re-bootstrap propellor in /usr/local/propellor,
-- (using git repo bundle, privdata file, and possibly
-- git repo url, which all need to be arranged to
-- be present in /old-os's /usr/local/propellor)
- -- enable shadow passwords (to avoid foot-shooting)
- -- return MadeChange
- where
+ -- TODO
+
+ -- Ensure that MadeChange is returned by the overall property,
+ -- so that anything hooking in onChange will run afterwards.
+ finalized = property "clean OS installed" $ return MadeChange
+
flagfile = "/etc/propellor-cleaninstall"
+
+ trickydirs =
+ -- /tmp can contain X's sockets, which prevent moving it
+ -- so it's left as-is.
+ [ "/tmp"
+ -- /proc is left mounted
+ , "/proc"
+ ]
+
+-- Performs all the renames. If any rename fails, rolls back all
+-- previous renames. Thus, this either successfully performs all
+-- the renames, or does not change the system state at all.
+massRename :: [(FilePath, FilePath, IO Bool)] -> IO ()
+massRename = go []
+ where
+ go _ [] = return ()
+ go undo ((from, to, test):rest) = ifM test
+ ( tryNonAsync (rename from to)
+ >>= either
+ (rollback undo)
+ (const $ go ((to, from):undo) rest)
+ , go undo rest
+ )
+ rollback undo e = do
+ mapM_ (uncurry rename) undo
+ throw e
-data Confirmed = Confirmed HostName
+data Confirmation = Confirmed HostName
-checkConfirmed :: Confirmed -> Propellor ()
-checkConfirmed (Confirmed c) = do
+confirmed :: Desc -> Confirmation -> Property
+confirmed desc (Confirmed c) = property desc $ 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
+ if hostname /= c
+ then do
+ warningMessage "Run with a bad confirmation, not matching hostname."
+ return FailedChange
+ else return NoChange
--- /etc/network/interfaces is configured to bring up all interfaces that
+-- | /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
+-- | /etc/resolv.conf is copied the from the old OS
+preserveResolvConf :: Property
+preserveResolvConf = check (fileExist oldloc) $
+ property (newloc ++ " copied from old OS") $ do
+ ls <- liftIO $ lines <$> readFile oldloc
+ ensureProperty $ newloc `File.hasContent` ls
+ where
+ newloc = "/etc/resolv.conf"
+ oldloc = oldOSDir ++ newloc
+
+-- | 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) $
+preserveRootSshAuthorized = check (fileExist 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
+ oldloc = oldOSDir ++ newloc
--- Installs grub onto a device to boot the system.
+-- | Forces an immediate reboot, without contacting the init 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
+-- Can be used after cleanInstallOnce.
+rebootForced :: Property
+rebootForced = cmdProperty "reboot" [ "--force" ]
-- Removes the old OS's backup from /old-os
-oldOSRemoved :: Confirmed -> Property
-oldOSRemoved confirmed = check (doesDirectoryExist oldOsDir) $
- property "old OS backup removed" $ do
- checkConfirmed confirmed
- liftIO $ removeDirectoryRecursive oldOsDir
+oldOSRemoved :: Confirmation -> Property
+oldOSRemoved confirmation = check (doesDirectoryExist oldOSDir) $
+ go `requires` confirmed "old OS backup removal confirmed" confirmation
+ where
+ go = property "old OS backup removed" $ do
+ liftIO $ removeDirectoryRecursive oldOSDir
return MadeChange
-oldOsDir :: FilePath
-oldOsDir = "/old-os"
+oldOSDir :: FilePath
+oldOSDir = "/old-os"
+
+newOSDir :: FilePath
+newOSDir = "/new-os"
diff --git a/src/Propellor/Property/User.hs b/src/Propellor/Property/User.hs
index 434a92a3..ccb69b24 100644
--- a/src/Propellor/Property/User.hs
+++ b/src/Propellor/Property/User.hs
@@ -84,3 +84,15 @@ hasGroup user group' = check test $ cmdProperty "adduser"
`describe` unwords ["user", user, "in group", group']
where
test = not . elem group' . words <$> readProcess "groups" [user]
+
+-- | Controls whether shadow passwords are enabled or not.
+shadowConfig :: Bool -> Property
+shadowConfig True = check (not <$> shadowExists) $
+ cmdProperty "shadowconfig" ["on"]
+ `describe` "shadow passwords enabled"
+shadowConfig False = check shadowExists $
+ cmdProperty "shadowconfig" ["off"]
+ `describe` "shadow passwords disabled"
+
+shadowExists :: IO Bool
+shadowExists = doesFileExist "/etc/shadow"