module Propellor.Property.OS (
cleanInstallOnce,
Confirmation(..),
preserveNetwork,
preserveResolvConf,
preserveRootSshAuthorized,
oldOSRemoved,
) where
import Propellor
import qualified Propellor.Property.Debootstrap as Debootstrap
import qualified Propellor.Property.Ssh as Ssh
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 Utility.SafeCommand
import System.Posix.Files (rename, fileExist)
import Control.Exception (throw)
cleanInstallOnce :: Confirmation -> Property
cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
go `requires` confirmed "clean install confirmed" confirmation
where
go =
finalized
`requires`
User.shadowConfig True
`requires`
Reboot.atEnd True (/= FailedChange)
`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' Debootstrap.sourceInstall
newOSDir targetos Debootstrap.DefaultConfig
flipped = property (newOSDir ++ " moved into place") $ liftIO $ do
devfstype <- fromMaybe "devtmpfs" <$> getFsType "/dev"
mnts <- filter (`notElem` ("/": trickydirs)) <$> mountPoints
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
void $ setEnv "PATH" stdPATH True
void $ unsetEnv "LANG"
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"]
unlessM (mount "sysfs" "sysfs" "/sys") $
warningMessage "failed mounting /sys"
unlessM (mount "devpts" "devpts" "/dev/pts") $
warningMessage "failed mounting /dev/pts"
return MadeChange
propellorbootstrapped = property "propellor re-debootstrapped in new os" $
return NoChange
finalized = property "clean OS installed" $ do
liftIO $ writeFile flagfile ""
return MadeChange
flagfile = "/etc/propellor-cleaninstall"
trickydirs =
[ "/tmp"
, "/proc"
]
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 Confirmation = Confirmed HostName
confirmed :: Desc -> Confirmation -> Property
confirmed desc (Confirmed c) = property desc $ do
hostname <- asks hostName
if hostname /= c
then do
warningMessage "Run with a bad confirmation, not matching hostname."
return FailedChange
else return NoChange
preserveNetwork :: Property
preserveNetwork = undefined
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
preserveRootSshAuthorized :: Property
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
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"
newOSDir :: FilePath
newOSDir = "/new-os"