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)
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
<$> FilePath -> IO Bool
doesFileExist FilePath
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` FilePath -> Confirmation -> Property UnixLike
confirmed FilePath
"clean install confirmed" Confirmation
confirmation
where
go :: CombinedType (Property DebianLike) (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`
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`
Bool -> (Result -> Bool) -> Property Linux
Reboot.atEnd Bool
True (Result -> Result -> Bool
forall a. Eq a => a -> a -> Bool
/= Result
FailedChange)
Property DebianLike
-> Property UnixLike
-> CombinedType (Property DebianLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Property UnixLike
propellorbootstrapped
Property DebianLike
-> Property Linux
-> CombinedType (Property DebianLike) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Property Linux
flipped
Property DebianLike
-> Property Linux
-> CombinedType (Property DebianLike) (Property Linux)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
Property Linux
osbootstrapped
osbootstrapped :: Property Linux
osbootstrapped :: Property Linux
osbootstrapped = FilePath
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Maybe System -> Propellor Result)
-> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes
-> Maybe System -> Propellor Result)
-> Property (MetaTypes metatypes)
withOS (FilePath
newOSDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" 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 FilePath
_) 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 =
Property Linux
-> FilePath -> System -> DebootstrapConfig -> Property Linux
Debootstrap.built' Property Linux
Debootstrap.sourceInstall
FilePath
newOSDir System
targetos DebootstrapConfig
Debootstrap.DefaultConfig
flipped :: Property Linux
flipped :: Property Linux
flipped = FilePath -> Propellor Result -> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property (FilePath
newOSDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" moved into place") (Propellor Result -> Property Linux)
-> Propellor Result -> Property Linux
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
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
FilePath
devfstype <- FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"devtmpfs" (Maybe FilePath -> FilePath) -> IO (Maybe FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
getFsType FilePath
"/dev"
[FilePath]
mnts <- (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (FilePath
"/"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
trickydirs)) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
mountPoints
[FilePath] -> (FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
mnts) FilePath -> IO ()
umountLazy
[(FilePath, FilePath, IO Bool)]
renamesout <- (FilePath -> (FilePath, FilePath, IO Bool))
-> [FilePath] -> [(FilePath, FilePath, IO Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
d -> (FilePath
d, FilePath
oldOSDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
d, Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (FilePath
oldOSDirFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:FilePath
newOSDirFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
trickydirs)))
([FilePath] -> [(FilePath, FilePath, IO Bool)])
-> IO [FilePath] -> IO [(FilePath, FilePath, IO Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
dirContents FilePath
"/"
[(FilePath, FilePath, IO Bool)]
renamesin <- (FilePath -> (FilePath, FilePath, IO Bool))
-> [FilePath] -> [(FilePath, FilePath, IO Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
d -> let dest :: FilePath
dest = FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
takeFileName FilePath
d in (FilePath
d, FilePath
dest, Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
fileExist FilePath
dest))
([FilePath] -> [(FilePath, FilePath, IO Bool)])
-> IO [FilePath] -> IO [(FilePath, FilePath, IO Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
dirContents FilePath
newOSDir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
oldOSDir
[(FilePath, FilePath, IO Bool)] -> IO ()
massRename ([(FilePath, FilePath, IO Bool)]
renamesout [(FilePath, FilePath, IO Bool)]
-> [(FilePath, FilePath, IO Bool)]
-> [(FilePath, FilePath, IO Bool)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath, IO Bool)]
renamesin)
FilePath -> IO ()
removeDirectoryRecursive FilePath
newOSDir
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool -> IO ()
setEnv FilePath
"PATH" FilePath
stdPATH Bool
True
IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
unsetEnv FilePath
"LANG"
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> FilePath -> FilePath -> MountOpts -> IO Bool
mount FilePath
devfstype FilePath
devfstype FilePath
"/dev" MountOpts
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
warningMessage (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"failed mounting /dev using " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
devfstype FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"; falling back to MAKEDEV generic"
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [CommandParam] -> IO Bool
boolSystem FilePath
"sh" [FilePath -> CommandParam
Param FilePath
"-c", FilePath -> CommandParam
Param FilePath
"cd /dev && /sbin/MAKEDEV generic"]
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> FilePath -> FilePath -> MountOpts -> IO Bool
mount FilePath
"sysfs" FilePath
"sysfs" FilePath
"/sys" MountOpts
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
warningMessage FilePath
"failed mounting /sys"
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> FilePath -> FilePath -> MountOpts -> IO Bool
mount FilePath
"devpts" FilePath
"devpts" FilePath
"/dev/pts" MountOpts
forall a. Monoid a => a
mempty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
warningMessage FilePath
"failed mounting /dev/pts"
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
propellorbootstrapped :: Property UnixLike
propellorbootstrapped :: Property UnixLike
propellorbootstrapped = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
"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 (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
finalized :: Property UnixLike
finalized :: Property UnixLike
finalized = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
"clean OS installed" (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
flagfile FilePath
""
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
flagfile :: FilePath
flagfile = FilePath
"/etc/propellor-cleaninstall"
trickydirs :: [FilePath]
trickydirs =
[ FilePath
"/tmp"
, FilePath
"/proc"
]
massRename :: [(FilePath, FilePath, IO Bool)] -> IO ()
massRename :: [(FilePath, FilePath, IO Bool)] -> IO ()
massRename = [(FilePath, FilePath)] -> [(FilePath, FilePath, IO Bool)] -> IO ()
go []
where
go :: [(FilePath, FilePath)] -> [(FilePath, FilePath, IO Bool)] -> IO ()
go [(FilePath, FilePath)]
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go [(FilePath, FilePath)]
undo ((FilePath
from, FilePath
to, IO Bool
test):[(FilePath, FilePath, 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 (FilePath -> FilePath -> IO ()
rename FilePath
from FilePath
to)
IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
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
([(FilePath, FilePath)] -> SomeException -> IO ()
forall (t :: * -> *) e b.
(Foldable t, Exception e) =>
t (FilePath, FilePath) -> e -> IO b
rollback [(FilePath, FilePath)]
undo)
(IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> [(FilePath, FilePath, IO Bool)] -> IO ()
go ((FilePath
to, FilePath
from)(FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:[(FilePath, FilePath)]
undo) [(FilePath, FilePath, IO Bool)]
rest)
, [(FilePath, FilePath)] -> [(FilePath, FilePath, IO Bool)] -> IO ()
go [(FilePath, FilePath)]
undo [(FilePath, FilePath, IO Bool)]
rest
)
rollback :: t (FilePath, FilePath) -> e -> IO b
rollback t (FilePath, FilePath)
undo e
e = do
((FilePath, FilePath) -> IO ()) -> t (FilePath, FilePath) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FilePath -> FilePath -> IO ()) -> (FilePath, FilePath) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry FilePath -> FilePath -> IO ()
rename) t (FilePath, FilePath)
undo
e -> IO b
forall a e. Exception e => e -> a
throw e
e
data Confirmation = Confirmed HostName
confirmed :: Desc -> Confirmation -> Property UnixLike
confirmed :: FilePath -> Confirmation -> Property UnixLike
confirmed FilePath
desc (Confirmed FilePath
c) = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
desc (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
FilePath
hostname <- (Host -> FilePath) -> Propellor FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Host -> FilePath
hostName
if FilePath
hostname FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
c
then do
FilePath -> Propellor ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
warningMessage FilePath
"Run with a bad confirmation, not matching hostname."
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
else Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
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 = FilePath
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
-> Propellor Result)
-> Property DebianLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
"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
[FilePath]
ls <- IO [FilePath] -> Propellor [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Propellor [FilePath])
-> IO [FilePath] -> Propellor [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"ip"
[FilePath
"route", FilePath
"list", FilePath
"scope", FilePath
"global"]
case FilePath -> [FilePath]
words (FilePath -> [FilePath]) -> Maybe FilePath -> Maybe [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMaybe [FilePath]
ls of
Just (FilePath
"default":FilePath
"via":FilePath
_:FilePath
"dev":FilePath
iface:[FilePath]
_) ->
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
$ FilePath -> Property DebianLike
Network.preserveStatic FilePath
iface
Maybe [FilePath]
_ -> do
FilePath -> Propellor ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
warningMessage FilePath
"did not find any default ipv4 route"
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
FailedChange
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 (FilePath -> IO Bool
fileExist FilePath
oldloc) (Property Linux -> Property Linux)
-> Property Linux -> Property Linux
forall a b. (a -> b) -> a -> b
$
FilePath
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Propellor Result)
-> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' (FilePath
newloc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" 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
[FilePath]
ls <- IO [FilePath] -> Propellor [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Propellor [FilePath])
-> IO [FilePath] -> Propellor [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
oldloc
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
-> Property UnixLike -> 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 UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FilePath
newloc FilePath -> [FilePath] -> Property UnixLike
`File.hasContent` [FilePath]
ls
where
newloc :: FilePath
newloc = FilePath
"/etc/resolv.conf"
oldloc :: FilePath
oldloc = FilePath
oldOSDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
newloc
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 (FilePath -> IO Bool
fileExist FilePath
oldloc) (Property UnixLike -> Property UnixLike)
-> Property UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
FilePath
-> (OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Propellor Result)
-> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
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
[FilePath]
ks <- IO [FilePath] -> Propellor [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Propellor [FilePath])
-> IO [FilePath] -> Propellor [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile FilePath
oldloc
OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
-> Property UnixLike -> 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, 'Targeting 'OSFreeBSD]
w (Property UnixLike -> Propellor Result)
-> Property UnixLike -> Propellor Result
forall a b. (a -> b) -> a -> b
$ FilePath -> Props UnixLike -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties FilePath
desc (Props UnixLike -> Property UnixLike)
-> Props UnixLike -> Property UnixLike
forall a b. (a -> b) -> a -> b
$
[Property UnixLike] -> Props UnixLike
forall k (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps ([Property UnixLike] -> Props UnixLike)
-> [Property UnixLike] -> Props UnixLike
forall a b. (a -> b) -> a -> b
$ (FilePath -> Property UnixLike)
-> [FilePath] -> [Property UnixLike]
forall a b. (a -> b) -> [a] -> [b]
map (RevertableProperty UnixLike UnixLike -> Property UnixLike
forall setupmetatypes undometatypes.
RevertableProperty setupmetatypes undometatypes
-> Property setupmetatypes
setupRevertableProperty (RevertableProperty UnixLike UnixLike -> Property UnixLike)
-> (FilePath -> RevertableProperty UnixLike UnixLike)
-> FilePath
-> Property UnixLike
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> FilePath -> RevertableProperty UnixLike UnixLike
Ssh.authorizedKey (FilePath -> User
User FilePath
"root")) [FilePath]
ks
where
desc :: FilePath
desc = FilePath
newloc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" copied from old OS"
newloc :: FilePath
newloc = FilePath
"/root/.ssh/authorized_keys"
oldloc :: FilePath
oldloc = FilePath
oldOSDir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
newloc
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 (FilePath -> IO Bool
doesDirectoryExist FilePath
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` FilePath -> Confirmation -> Property UnixLike
confirmed FilePath
"old OS backup removal confirmed" Confirmation
confirmation
where
go :: Property UnixLike
go :: Property UnixLike
go = FilePath -> Propellor Result -> Property UnixLike
forall k (metatypes :: k).
SingI metatypes =>
FilePath -> Propellor Result -> Property (MetaTypes metatypes)
property FilePath
"old OS backup removed" (Propellor Result -> Property UnixLike)
-> Propellor Result -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ do
IO () -> Propellor ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
removeDirectoryRecursive FilePath
oldOSDir
Result -> Propellor Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
MadeChange
oldOSDir :: FilePath
oldOSDir :: FilePath
oldOSDir = FilePath
"/old-os"
newOSDir :: FilePath
newOSDir :: FilePath
newOSDir = FilePath
"/new-os"