module Propellor.Property.Bootstrap (
Bootstrapper(..),
Builder(..),
bootstrapWith,
RepoSource(..),
bootstrappedFrom,
clonedFrom
) where
import Propellor.Base
import Propellor.Bootstrap
import Propellor.Types.Info
import Propellor.Types.Container
import Propellor.Property.Chroot
import Propellor.PrivData.Paths
import Data.List
import qualified Data.ByteString as B
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"
data RepoSource
= GitRepoUrl String
| GitRepoOutsideChroot
bootstrappedFrom :: RepoSource -> Property Linux
bootstrappedFrom reposource = check (hasContainerCapability FilesystemContained) $
go `requires` clonedFrom reposource
where
go :: Property Linux
go = property "Propellor bootstrapped" $ do
system <- getOS
chroothost <- ask
privdata <- liftIO $ filterPrivData chroothost
<$> readPrivDataFile privDataLocal
bootstrapper <- getBootstrapper
assumeChange $ exposeTrueLocaldir $ const $ do
liftIO $ createDirectoryIfMissing True $
takeDirectory privDataLocal
liftIO $ writeFileProtected privDataLocal $
show privdata
runShellCommand $ buildShellCommand
[ "cd " ++ localdir
, checkDepsCommand bootstrapper system
, buildCommand bootstrapper
]
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
, "(cd " ++ tmpclone ++ " && tar c .) | (cd " ++ localdir ++ " && tar x)"
, "rm -rf " ++ tmpclone
]
updateclone = assumeChange $ exposeTrueLocaldir $ const $
runShellCommand $ buildShellCommand
[ "cd " ++ localdir
, "git pull"
]
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 = (hasContainerCapability FilesystemContained <&&> 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]