2014-11-23 19:42:22 +00:00
|
|
|
module Propellor.Property.OS (
|
|
|
|
cleanInstallOnce,
|
2014-12-04 21:11:15 +00:00
|
|
|
Confirmation(..),
|
2014-12-06 19:28:30 +00:00
|
|
|
preserveNetwork,
|
2014-12-05 20:22:11 +00:00
|
|
|
preserveResolvConf,
|
2014-11-24 04:52:46 +00:00
|
|
|
preserveRootSshAuthorized,
|
2014-11-23 19:42:22 +00:00
|
|
|
oldOSRemoved,
|
|
|
|
) where
|
|
|
|
|
|
|
|
import Propellor
|
|
|
|
import qualified Propellor.Property.Debootstrap as Debootstrap
|
2014-11-24 04:51:36 +00:00
|
|
|
import qualified Propellor.Property.Ssh as Ssh
|
2014-12-06 19:39:02 +00:00
|
|
|
import qualified Propellor.Property.User as User
|
2014-12-05 20:22:11 +00:00
|
|
|
import qualified Propellor.Property.File as File
|
2014-12-06 17:21:19 +00:00
|
|
|
import qualified Propellor.Property.Reboot as Reboot
|
2014-12-04 21:11:15 +00:00
|
|
|
import Propellor.Property.Mount
|
2014-12-04 21:30:40 +00:00
|
|
|
import Propellor.Property.Chroot.Util (stdPATH)
|
2014-12-05 20:22:11 +00:00
|
|
|
import Utility.SafeCommand
|
2014-12-04 21:11:15 +00:00
|
|
|
|
|
|
|
import System.Posix.Files (rename, fileExist)
|
2014-12-05 16:50:01 +00:00
|
|
|
import Control.Exception (throw)
|
2014-11-24 04:40:53 +00:00
|
|
|
|
2014-11-23 19:42:22 +00:00
|
|
|
-- | Replaces whatever OS was installed before with a clean installation
|
|
|
|
-- of the OS that the Host is configured to have.
|
2014-12-07 19:13:28 +00:00
|
|
|
--
|
|
|
|
-- This is experimental; use with caution!
|
2014-11-23 19:42:22 +00:00
|
|
|
--
|
|
|
|
-- This can replace one Linux distribution with different one.
|
|
|
|
-- But, it can also fail and leave the system in an unbootable state.
|
|
|
|
--
|
2014-11-23 20:39:49 +00:00
|
|
|
-- To avoid this property being accidentially used, you have to provide
|
2014-12-04 21:30:40 +00:00
|
|
|
-- a Confirmation containing the name of the host that you intend to apply
|
|
|
|
-- the property to.
|
2014-11-23 20:39:49 +00:00
|
|
|
--
|
2014-11-23 19:42:22 +00:00
|
|
|
-- This property only runs once. The cleanly installed system will have
|
2014-12-09 18:22:37 +00:00
|
|
|
-- a file </etc/propellor-cleaninstall>, which indicates it was cleanly
|
2014-11-23 19:42:22 +00:00
|
|
|
-- installed.
|
2014-12-04 21:30:40 +00:00
|
|
|
--
|
2014-12-09 18:22:37 +00:00
|
|
|
-- The files from the old os will be left in </old-os>
|
2014-11-23 19:42:22 +00:00
|
|
|
--
|
2014-12-06 10:41:21 +00:00
|
|
|
-- After the OS is installed, and if all properties of the host have
|
|
|
|
-- been successfully satisfied, the host will be rebooted to properly load
|
|
|
|
-- the new OS.
|
2014-12-05 20:22:11 +00:00
|
|
|
--
|
2014-11-23 19:42:22 +00:00
|
|
|
-- You will typically want to run some more properties after the clean
|
2014-12-04 21:30:40 +00:00
|
|
|
-- install succeeds, to bootstrap from the cleanly installed system to
|
|
|
|
-- a fully working system. For example:
|
2014-11-23 19:42:22 +00:00
|
|
|
--
|
|
|
|
-- > & os (System (Debian Unstable) "amd64")
|
2014-12-05 20:22:11 +00:00
|
|
|
-- > & cleanInstallOnce (Confirmed "foo.example.com")
|
2014-11-23 19:42:22 +00:00
|
|
|
-- > `onChange` propertyList "fixing up after clean install"
|
2014-12-06 19:28:30 +00:00
|
|
|
-- > [ preserveNetwork
|
2014-12-05 20:22:11 +00:00
|
|
|
-- > , preserveResolvConf
|
2014-11-24 04:52:46 +00:00
|
|
|
-- > , preserverRootSshAuthorized
|
2014-12-05 20:22:11 +00:00
|
|
|
-- > , Apt.update
|
|
|
|
-- > -- , Grub.boots "/dev/sda"
|
|
|
|
-- > -- `requires` Grub.installed Grub.PC
|
2014-12-04 21:30:40 +00:00
|
|
|
-- > -- , oldOsRemoved (Confirmed "foo.example.com")
|
2014-11-23 19:42:22 +00:00
|
|
|
-- > ]
|
2014-12-05 20:22:11 +00:00
|
|
|
-- > & Hostname.sane
|
|
|
|
-- > & Apt.installed ["linux-image-amd64"]
|
2014-11-23 19:42:22 +00:00
|
|
|
-- > & Apt.installed ["ssh"]
|
2014-11-23 20:39:49 +00:00
|
|
|
-- > & User.hasSomePassword "root"
|
|
|
|
-- > & User.accountFor "joey"
|
|
|
|
-- > & User.hasSomePassword "joey"
|
2014-11-23 19:42:22 +00:00
|
|
|
-- > -- rest of system properties here
|
2014-12-04 21:11:15 +00:00
|
|
|
cleanInstallOnce :: Confirmation -> Property
|
|
|
|
cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
|
|
|
|
go `requires` confirmed "clean install confirmed" confirmation
|
|
|
|
where
|
|
|
|
go =
|
|
|
|
finalized
|
|
|
|
`requires`
|
2014-12-06 19:39:02 +00:00
|
|
|
-- easy to forget and system may not boot without shadow pw!
|
|
|
|
User.shadowConfig True
|
|
|
|
`requires`
|
|
|
|
-- reboot at end if the rest of the propellor run succeeds
|
2014-12-06 17:21:19 +00:00
|
|
|
Reboot.atEnd True (/= FailedChange)
|
|
|
|
`requires`
|
2014-12-04 21:11:15 +00:00
|
|
|
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"
|
2014-12-05 21:44:09 +00:00
|
|
|
|
2014-12-04 21:11:15 +00:00
|
|
|
debootstrap targetos = ensureProperty $ toProp $
|
2014-12-05 20:47:18 +00:00
|
|
|
-- Ignore the os setting, and install debootstrap from
|
|
|
|
-- source, since we don't know what OS we're running in yet.
|
|
|
|
Debootstrap.built' Debootstrap.sourceInstall
|
|
|
|
newOSDir targetos Debootstrap.DefaultConfig
|
2014-12-05 21:44:09 +00:00
|
|
|
-- debootstrap, I wish it was faster..
|
|
|
|
-- TODO eatmydata to speed it up
|
|
|
|
-- Problem: Installing eatmydata on some random OS like
|
|
|
|
-- Fedora may be difficult. Maybe configure dpkg to not
|
|
|
|
-- sync instead?
|
|
|
|
|
|
|
|
-- This is the fun bit.
|
2014-12-05 20:22:11 +00:00
|
|
|
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"
|
2014-12-04 21:11:15 +00:00
|
|
|
mnts <- filter (`notElem` ("/": trickydirs)) <$> mountPoints
|
|
|
|
-- reverse so that deeper mount points come first
|
|
|
|
forM_ (reverse mnts) umountLazy
|
|
|
|
|
2014-12-05 20:22:11 +00:00
|
|
|
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
|
2014-12-05 16:50:01 +00:00
|
|
|
createDirectoryIfMissing True oldOSDir
|
2014-12-05 20:22:11 +00:00
|
|
|
massRename (renamesout ++ renamesin)
|
2014-12-04 21:11:15 +00:00
|
|
|
removeDirectoryRecursive newOSDir
|
2014-12-05 20:22:11 +00:00
|
|
|
|
|
|
|
-- Prepare environment for running additional properties,
|
|
|
|
-- overriding old OS's environment.
|
2014-12-04 21:30:40 +00:00
|
|
|
void $ setEnv "PATH" stdPATH True
|
2014-12-05 20:22:11 +00:00
|
|
|
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"
|
2014-12-04 21:30:40 +00:00
|
|
|
|
2014-12-04 21:11:15 +00:00
|
|
|
return MadeChange
|
|
|
|
|
|
|
|
propellorbootstrapped = property "propellor re-debootstrapped in new os" $
|
|
|
|
return NoChange
|
2014-11-23 19:42:22 +00:00
|
|
|
-- 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)
|
2014-12-04 21:30:40 +00:00
|
|
|
-- TODO
|
2014-12-04 21:11:15 +00:00
|
|
|
|
2014-12-06 10:41:21 +00:00
|
|
|
finalized = property "clean OS installed" $ do
|
|
|
|
liftIO $ writeFile flagfile ""
|
|
|
|
return MadeChange
|
2014-12-04 21:11:15 +00:00
|
|
|
|
2014-11-23 19:42:22 +00:00
|
|
|
flagfile = "/etc/propellor-cleaninstall"
|
2014-12-04 21:30:40 +00:00
|
|
|
|
|
|
|
trickydirs =
|
|
|
|
-- /tmp can contain X's sockets, which prevent moving it
|
|
|
|
-- so it's left as-is.
|
|
|
|
[ "/tmp"
|
|
|
|
-- /proc is left mounted
|
|
|
|
, "/proc"
|
|
|
|
]
|
2014-11-23 19:42:22 +00:00
|
|
|
|
2014-12-05 16:50:01 +00:00
|
|
|
-- 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.
|
2014-12-05 20:22:11 +00:00
|
|
|
massRename :: [(FilePath, FilePath, IO Bool)] -> IO ()
|
2014-12-05 16:50:01 +00:00
|
|
|
massRename = go []
|
|
|
|
where
|
|
|
|
go _ [] = return ()
|
2014-12-05 20:22:11 +00:00
|
|
|
go undo ((from, to, test):rest) = ifM test
|
|
|
|
( tryNonAsync (rename from to)
|
2014-12-05 16:50:01 +00:00
|
|
|
>>= either
|
|
|
|
(rollback undo)
|
|
|
|
(const $ go ((to, from):undo) rest)
|
2014-12-05 20:22:11 +00:00
|
|
|
, go undo rest
|
|
|
|
)
|
2014-12-05 16:50:01 +00:00
|
|
|
rollback undo e = do
|
|
|
|
mapM_ (uncurry rename) undo
|
|
|
|
throw e
|
|
|
|
|
2014-12-04 21:11:15 +00:00
|
|
|
data Confirmation = Confirmed HostName
|
2014-11-24 04:40:53 +00:00
|
|
|
|
2014-12-04 21:11:15 +00:00
|
|
|
confirmed :: Desc -> Confirmation -> Property
|
|
|
|
confirmed desc (Confirmed c) = property desc $ do
|
2014-11-24 04:40:53 +00:00
|
|
|
hostname <- asks hostName
|
2014-12-04 21:11:15 +00:00
|
|
|
if hostname /= c
|
|
|
|
then do
|
|
|
|
warningMessage "Run with a bad confirmation, not matching hostname."
|
|
|
|
return FailedChange
|
|
|
|
else return NoChange
|
2014-11-23 19:42:22 +00:00
|
|
|
|
2014-12-09 18:22:37 +00:00
|
|
|
-- | </etc/network/interfaces> is configured to bring up the network
|
2014-12-06 19:28:30 +00:00
|
|
|
-- interface that currently has a default route configured, using
|
|
|
|
-- the same (static) IP address.
|
|
|
|
preserveNetwork :: Property
|
|
|
|
preserveNetwork = undefined -- TODO
|
2014-11-23 19:42:22 +00:00
|
|
|
|
2014-12-09 18:22:37 +00:00
|
|
|
-- | </etc/resolv.conf> is copied from the old OS
|
2014-12-05 20:22:11 +00:00
|
|
|
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
|
|
|
|
|
2014-12-09 18:22:37 +00:00
|
|
|
-- | </root/.ssh/authorized_keys> has added to it any ssh keys that
|
2014-11-24 04:40:53 +00:00
|
|
|
-- were authorized in the old OS. Any other contents of the file are
|
|
|
|
-- retained.
|
2014-11-24 04:52:46 +00:00
|
|
|
preserveRootSshAuthorized :: Property
|
2014-12-05 20:22:11 +00:00
|
|
|
preserveRootSshAuthorized = check (fileExist oldloc) $
|
2014-11-24 04:40:53 +00:00
|
|
|
property (newloc ++ " copied from old OS") $ do
|
|
|
|
ks <- liftIO $ lines <$> readFile oldloc
|
2014-11-24 04:51:36 +00:00
|
|
|
ensureProperties (map (Ssh.authorizedKey "root") ks)
|
2014-11-24 04:40:53 +00:00
|
|
|
where
|
|
|
|
newloc = "/root/.ssh/authorized_keys"
|
2014-12-04 21:11:15 +00:00
|
|
|
oldloc = oldOSDir ++ newloc
|
2014-11-23 19:42:22 +00:00
|
|
|
|
2014-12-09 18:22:37 +00:00
|
|
|
-- Removes the old OS's backup from </old-os>
|
2014-12-04 21:11:15 +00:00
|
|
|
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
|
2014-11-23 19:42:22 +00:00
|
|
|
return MadeChange
|
|
|
|
|
2014-12-04 21:11:15 +00:00
|
|
|
oldOSDir :: FilePath
|
|
|
|
oldOSDir = "/old-os"
|
|
|
|
|
|
|
|
newOSDir :: FilePath
|
|
|
|
newOSDir = "/new-os"
|