-- | This module contains properties that configure how Propellor -- bootstraps to run itself on a Host. module Propellor.Property.Bootstrap ( Bootstrapper(..), Builder(..), bootstrapWith, RepoSource(..), bootstrappedFrom, clonedFrom ) where import Propellor.Base import Propellor.Bootstrap import Propellor.Types.Info import Propellor.Property.Chroot import Data.List import qualified Data.ByteString as B -- | This property can be used to configure the `Bootstrapper` that is used -- to bootstrap propellor on a Host. For example, if you want to use -- stack: -- -- > host "example.com" $ props -- > & bootstrapWith (Robustly Stack) -- -- When `bootstrappedFrom` is used in a `Chroot` or other `Container`, -- this property can also be added to the chroot to configure it. bootstrapWith :: Bootstrapper -> Property (HasInfo + UnixLike) bootstrapWith b = pureInfoProperty desc (InfoVal b) where desc = "propellor bootstrapped with " ++ case b of Robustly Stack -> "stack" Robustly Cabal -> "cabal" OSOnly -> "OS packages only" -- | Where a propellor repository should be bootstrapped from. data RepoSource = GitRepoUrl String | GitRepoOutsideChroot -- ^ When used in a chroot, this copies the git repository from -- outside the chroot, including its configuration. -- | Bootstraps a propellor installation into -- /usr/local/propellor/ -- -- Normally, propellor is bootstrapped by eg, using propellor --spin, -- and so this property is not generally needed. -- -- This property only does anything when used inside a Chroot or other -- Container. This is particularly useful inside a chroot used to build a -- disk image, to make the disk image have propellor installed. -- -- The git repository is cloned (or pulled to update if it already exists). -- -- All build dependencies are installed, using distribution packages -- or falling back to using cabal or stack. bootstrappedFrom :: RepoSource -> Property Linux bootstrappedFrom reposource = check inChroot $ go `requires` clonedFrom reposource where go :: Property Linux go = property "Propellor bootstrapped" $ do system <- getOS bootstrapper <- getBootstrapper assumeChange $ exposeTrueLocaldir $ const $ runShellCommand $ buildShellCommand [ "cd " ++ localdir , checkDepsCommand bootstrapper system , buildCommand bootstrapper ] -- | Clones the propellor repository into /usr/local/propellor/ -- -- If the propellor repo has already been cloned, pulls to get it -- up-to-date. clonedFrom :: RepoSource -> Property Linux clonedFrom reposource = case reposource of GitRepoOutsideChroot -> go `onChange` copygitconfig _ -> go where go :: Property Linux go = property ("Propellor repo cloned from " ++ sourcedesc) $ ifM needclone (makeclone, updateclone) makeclone = do let tmpclone = localdir ++ ".tmpclone" system <- getOS assumeChange $ exposeTrueLocaldir $ \sysdir -> do let originloc = case reposource of GitRepoUrl s -> s GitRepoOutsideChroot -> sysdir runShellCommand $ buildShellCommand [ installGitCommand system , "rm -rf " ++ tmpclone , "git clone " ++ shellEscape originloc ++ " " ++ tmpclone , "mkdir -p " ++ localdir -- This is done rather than deleting -- the old localdir, because if it is bound -- mounted from outside the chroot, deleting -- it after unmounting in unshare will remove -- the bind mount outside the unshare. , "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)" , "rm -rf " ++ tmpclone ] updateclone = assumeChange $ exposeTrueLocaldir $ const $ runShellCommand $ buildShellCommand [ "cd " ++ localdir , "git pull" ] -- Copy the git config of the repo outside the chroot into the -- chroot. This way it has the same remote urls, and other git -- configuration. copygitconfig :: Property Linux copygitconfig = property ("Propellor repo git config copied from outside the chroot") $ do let gitconfig = localdir ".git" "config" cfg <- liftIO $ B.readFile gitconfig exposeTrueLocaldir $ const $ liftIO $ B.writeFile gitconfig cfg return MadeChange needclone = (inChroot <&&> truelocaldirisempty) <||> (liftIO (not <$> doesDirectoryExist localdir)) truelocaldirisempty = exposeTrueLocaldir $ const $ runShellCommand ("test ! -d " ++ localdir ++ "/.git") sourcedesc = case reposource of GitRepoUrl s -> s GitRepoOutsideChroot -> localdir ++ " outside the chroot" assumeChange :: Propellor Bool -> Propellor Result assumeChange a = do ok <- a return (cmdResult ok <> MadeChange) buildShellCommand :: [String] -> String buildShellCommand = intercalate "&&" . map (\c -> "(" ++ c ++ ")") runShellCommand :: String -> Propellor Bool runShellCommand s = liftIO $ boolSystem "sh" [ Param "-c", Param s]