module Propellor.Property.OS (
	cleanInstallOnce,
	Confirmation(..),
	preserveNetwork,
	preserveResolvConf,
	preserveRootSshAuthorized,
	oldOSRemoved,
) where

import Propellor.Base
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Ssh as Ssh
import qualified Propellor.Property.Network as Network
import qualified Propellor.Property.User as User
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Reboot as Reboot
import Propellor.Property.Mount
import Propellor.Property.Chroot.Util (stdPATH)

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.
--
-- This is experimental; use with caution!
--
-- This can replace one Linux distribution with different one.
-- 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 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>
--
-- 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.
--
-- You will typically want to run some more properties after the clean
-- install succeeds, to bootstrap from the cleanly installed system to
-- a fully working system. For example:
--
-- > & osDebian Unstable X86_64
-- > & cleanInstallOnce (Confirmed "foo.example.com")
-- >    `onChange` propertyList "fixing up after clean install"
-- >        [ preserveNetwork
-- >        , preserveResolvConf
-- >        , preserveRootSshAuthorized
-- >        , Apt.update
-- >        -- , Grub.boots "/dev/sda"
-- >        --   `requires` Grub.installed Grub.PC
-- >        -- , oldOsRemoved (Confirmed "foo.example.com")
-- >        ]
-- > & Hostname.sane
-- > & Hostname.mailname
-- > & Apt.installed ["linux-image-amd64"]
-- > & Apt.installed ["ssh"]
-- > & User.hasSomePassword "root"
-- > & User.accountFor "joey"
-- > & User.hasSomePassword "joey"
-- > -- rest of system properties here
cleanInstallOnce :: Confirmation -> Property DebianLike
cleanInstallOnce :: Confirmation -> Property DebianLike
cleanInstallOnce Confirmation
confirmation = IO Bool -> Property DebianLike -> Property DebianLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO Bool
doesFileExist HostName
flagfile) (Property DebianLike -> Property DebianLike)
-> Property DebianLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
	Property DebianLike
go Property DebianLike
-> Property UnixLike
-> CombinedType (Property DebianLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` HostName -> Confirmation -> Property UnixLike
confirmed HostName
"clean install confirmed" Confirmation
confirmation
  where
	go :: CombinedType
  (CombinedType
     (CombinedType
        (CombinedType (Property DebianLike) (Property Linux))
        (Property UnixLike))
     (Property Linux))
  (Property Linux)
go =
		Property UnixLike
finalized
			Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		-- easy to forget and system may not boot without shadow pw!
		Bool -> Property DebianLike
User.shadowConfig Bool
True
			Property DebianLike
-> Property Linux
-> CombinedType (Property DebianLike) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		-- reboot at end if the rest of the propellor run succeeds
		Bool -> (Result -> Bool) -> Property Linux
Reboot.atEnd Bool
True (Result -> Result -> Bool
forall a. Eq a => a -> a -> Bool
/= Result
FailedChange)
			CombinedType (Property DebianLike) (Property Linux)
-> Property UnixLike
-> CombinedType
     (CombinedType (Property DebianLike) (Property Linux))
     (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		Property UnixLike
propellorbootstrapped
			CombinedType
  (CombinedType (Property DebianLike) (Property Linux))
  (Property UnixLike)
-> Property Linux
-> CombinedType
     (CombinedType
        (CombinedType (Property DebianLike) (Property Linux))
        (Property UnixLike))
     (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		Property Linux
flipped
			CombinedType
  (CombinedType
     (CombinedType (Property DebianLike) (Property Linux))
     (Property UnixLike))
  (Property Linux)
-> Property Linux
-> CombinedType
     (CombinedType
        (CombinedType
           (CombinedType (Property DebianLike) (Property Linux))
           (Property UnixLike))
        (Property Linux))
     (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
		Property Linux
osbootstrapped

	osbootstrapped :: Property Linux
	osbootstrapped :: Property Linux
osbootstrapped = HostName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Maybe System -> Propellor Result)
-> Property Linux
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes
    -> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS (HostName
newOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" bootstrapped") ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
       'Targeting 'OSArchLinux]
  -> Maybe System -> Propellor Result)
 -> Property Linux)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Maybe System -> Propellor Result)
-> Property Linux
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
w Maybe System
o -> case Maybe System
o of
		(Just d :: System
d@(System (Debian DebianKernel
_ DebianSuite
_) Architecture
_)) -> OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
-> Property Linux -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
w (Property Linux -> Propellor Result)
-> Property Linux -> Propellor Result
forall a b. (a -> b) -> a -> b
$
			System -> Property Linux
debootstrap System
d
		(Just u :: System
u@(System (Buntish HostName
_) Architecture
_)) -> OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
-> Property Linux -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
w (Property Linux -> Propellor Result)
-> Property Linux -> Propellor Result
forall a b. (a -> b) -> a -> b
$
			System -> Property Linux
debootstrap System
u
		Maybe System
_ -> Propellor Result
HasCallStack => Propellor Result
unsupportedOS'

	debootstrap :: System -> Property Linux
	debootstrap :: System -> Property Linux
debootstrap System
targetos =
		-- Install debootstrap from source, since we don't know
		-- what OS we're currently running in.
		Property Linux
-> HostName -> System -> DebootstrapConfig -> Property Linux
Debootstrap.built' Property Linux
Debootstrap.sourceInstall
			HostName
newOSDir System
targetos DebootstrapConfig
Debootstrap.DefaultConfig
		-- 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.
	flipped :: Property Linux
	flipped :: Property Linux
flipped = HostName -> Propellor Result -> Property Linux
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property (HostName
newOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" moved into place") (Propellor Result -> Property Linux)
-> Propellor Result -> Property Linux
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ do
		-- First, unmount most mount points, lazily, so
		-- they don't interfere with moving things around.
		devfstype <- HostName -> Maybe HostName -> HostName
forall a. a -> Maybe a -> a
fromMaybe HostName
"devtmpfs" (Maybe HostName -> HostName) -> IO (Maybe HostName) -> IO HostName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO (Maybe HostName)
getFsType HostName
"/dev"
		mnts <- filter (`notElem` ("/": trickydirs)) <$> mountPoints
		-- reverse so that deeper mount points come first
		forM_ (reverse mnts) umountLazy

		renamesout <- map (\HostName
d -> (HostName
d, HostName
oldOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
d, Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ HostName
d HostName -> [HostName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (HostName
oldOSDirHostName -> [HostName] -> [HostName]
forall a. a -> [a] -> [a]
:HostName
newOSDirHostName -> [HostName] -> [HostName]
forall a. a -> [a] -> [a]
:[HostName]
trickydirs)))
			<$> dirContents "/"
		renamesin <- map (\HostName
d -> let dest :: HostName
dest = HostName
"/" HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName -> HostName
takeFileName HostName
d in (HostName
d, HostName
dest, Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO Bool
fileExist HostName
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" mempty) $ 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" mempty) $
			warningMessage "failed mounting /sys"

		-- And /dev/pts, used by apt.
		unlessM (mount "devpts" "devpts" "/dev/pts" mempty) $
			warningMessage "failed mounting /dev/pts"

		return MadeChange

	propellorbootstrapped :: Property UnixLike
	propellorbootstrapped :: Property UnixLike
propellorbootstrapped = HostName -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
"propellor re-debootstrapped in new os" (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
		Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
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)
		-- TODO

	finalized :: Property UnixLike
	finalized :: Property UnixLike
finalized = HostName -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
"clean OS installed" (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
		IO () -> Propellor ()
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ HostName -> HostName -> IO ()
writeFile HostName
flagfile HostName
""
		Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange

	flagfile :: HostName
flagfile = HostName
"/etc/propellor-cleaninstall"

	trickydirs :: [HostName]
trickydirs =
		-- /tmp can contain X's sockets, which prevent moving it
		-- so it's left as-is.
		[ HostName
"/tmp"
		-- /proc is left mounted
		, HostName
"/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 :: [(HostName, HostName, IO Bool)] -> IO ()
massRename = [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go []
  where
	go :: [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go [(HostName, HostName)]
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
	go [(HostName, HostName)]
undo ((HostName
from, HostName
to, IO Bool
test):[(HostName, HostName, IO Bool)]
rest) = IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
test
		( IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryNonAsync (HostName -> HostName -> IO ()
rename HostName
from HostName
to)
			IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
				([(HostName, HostName)] -> SomeException -> IO ()
forall {t :: * -> *} {e} {b}.
(Foldable t, Exception e) =>
t (HostName, HostName) -> e -> IO b
rollback [(HostName, HostName)]
undo)
				(IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go ((HostName
to, HostName
from)(HostName, HostName)
-> [(HostName, HostName)] -> [(HostName, HostName)]
forall a. a -> [a] -> [a]
:[(HostName, HostName)]
undo) [(HostName, HostName, IO Bool)]
rest)
		, [(HostName, HostName)] -> [(HostName, HostName, IO Bool)] -> IO ()
go [(HostName, HostName)]
undo [(HostName, HostName, IO Bool)]
rest
		)
	rollback :: t (HostName, HostName) -> e -> IO b
rollback t (HostName, HostName)
undo e
e = do
		((HostName, HostName) -> IO ()) -> t (HostName, HostName) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((HostName -> HostName -> IO ()) -> (HostName, HostName) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HostName -> HostName -> IO ()
rename) t (HostName, HostName)
undo
		e -> IO b
forall a e. (HasCallStack, Exception e) => e -> a
throw e
e

data Confirmation = Confirmed HostName

confirmed :: Desc -> Confirmation -> Property UnixLike
confirmed :: HostName -> Confirmation -> Property UnixLike
confirmed HostName
desc (Confirmed HostName
c) = HostName -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
desc (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
	hostname <- (Host -> HostName) -> Propellor HostName
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> HostName
hostName
	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 the network
-- interface that currently has a default route configured, using
-- the same (static) IP address.
preserveNetwork :: Property DebianLike
preserveNetwork :: Property DebianLike
preserveNetwork = Property DebianLike
go Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
Network.cleanInterfacesFile
  where
	go :: Property DebianLike
	go :: Property DebianLike
go = HostName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' HostName
"preserve network configuration" ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
  -> Propellor Result)
 -> Property DebianLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Propellor Result)
-> Property DebianLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
		ls <- IO [HostName] -> Propellor [HostName]
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HostName] -> Propellor [HostName])
-> IO [HostName] -> Propellor [HostName]
forall a b. (a -> b) -> a -> b
$ HostName -> [HostName]
lines (HostName -> [HostName]) -> IO HostName -> IO [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> [HostName] -> IO HostName
readProcess HostName
"ip"
			[HostName
"route", HostName
"list", HostName
"scope", HostName
"global"]
		case words <$> headMaybe ls of
			Just (HostName
"default":HostName
"via":HostName
_:HostName
"dev":HostName
iface:[HostName]
_) ->
				OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Property DebianLike -> Propellor Result
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w (Property DebianLike -> Propellor Result)
-> Property DebianLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ HostName -> Property DebianLike
Network.preserveStatic HostName
iface
			Maybe [HostName]
_ -> do
				HostName -> Propellor ()
forall (m :: * -> *). MonadIO m => HostName -> m ()
warningMessage HostName
"did not find any default ipv4 route"
				Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange

-- | </etc/resolv.conf> is copied from the old OS
preserveResolvConf :: Property Linux
preserveResolvConf :: Property Linux
preserveResolvConf = IO Bool -> Property Linux -> Property Linux
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (HostName -> IO Bool
fileExist HostName
oldloc) (Property Linux -> Property Linux)
-> Property Linux -> Property Linux
forall a b. (a -> b) -> a -> b
$
	HostName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Propellor Result)
-> Property Linux
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (HostName
newloc HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" copied from old OS") ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
       'Targeting 'OSArchLinux]
  -> Propellor Result)
 -> Property Linux)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Propellor Result)
-> Property Linux
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux]
w -> do
		ls <- IO [HostName] -> Propellor [HostName]
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HostName] -> Propellor [HostName])
-> IO [HostName] -> Propellor [HostName]
forall a b. (a -> b) -> a -> b
$ HostName -> [HostName]
lines (HostName -> [HostName]) -> IO HostName -> IO [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO HostName
readFile HostName
oldloc
		ensureProperty w $ newloc `File.hasContent` ls
  where
	newloc :: HostName
newloc = HostName
"/etc/resolv.conf"
	oldloc :: HostName
oldloc = HostName
oldOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
newloc

-- | </root/.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 UnixLike
preserveRootSshAuthorized :: Property UnixLike
preserveRootSshAuthorized = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (HostName -> IO Bool
fileExist HostName
oldloc) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
	HostName
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
HostName
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' HostName
desc ((OuterMetaTypesWitness
    '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
       'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
  -> Propellor Result)
 -> Property UnixLike)
-> (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
    -> Propellor Result)
-> Property UnixLike
forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
w -> do
		ks <- IO [HostName] -> Propellor [HostName]
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HostName] -> Propellor [HostName])
-> IO [HostName] -> Propellor [HostName]
forall a b. (a -> b) -> a -> b
$ HostName -> [HostName]
lines (HostName -> [HostName]) -> IO HostName -> IO [HostName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostName -> IO HostName
readFile HostName
oldloc
		ensureProperty w $ combineProperties desc $
			toProps $ map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks
  where
	desc :: HostName
desc = HostName
newloc HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
" copied from old OS"
	newloc :: HostName
newloc = HostName
"/root/.ssh/authorized_keys"
	oldloc :: HostName
oldloc = HostName
oldOSDir HostName -> HostName -> HostName
forall a. [a] -> [a] -> [a]
++ HostName
newloc

-- Removes the old OS's backup from </old-os>
oldOSRemoved :: Confirmation -> Property UnixLike
oldOSRemoved :: Confirmation -> Property UnixLike
oldOSRemoved Confirmation
confirmation = IO Bool -> Property UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (HostName -> IO Bool
doesDirectoryExist HostName
oldOSDir) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
	Property UnixLike
go Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` HostName -> Confirmation -> Property UnixLike
confirmed HostName
"old OS backup removal confirmed" Confirmation
confirmation
  where
	go :: Property UnixLike
	go :: Property UnixLike
go = HostName -> Propellor Result -> Property UnixLike
forall {k} (metatypes :: k).
SingI metatypes =>
HostName -> Propellor Result -> Property (MetaTypes metatypes)
property HostName
"old OS backup removed" (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
		IO () -> Propellor ()
forall a. IO a -> Propellor a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ HostName -> IO ()
removeDirectoryRecursive HostName
oldOSDir
		Result -> Propellor Result
forall a. a -> Propellor a
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange

oldOSDir :: FilePath
oldOSDir :: HostName
oldOSDir = HostName
"/old-os"

newOSDir :: FilePath
newOSDir :: HostName
newOSDir = HostName
"/new-os"