module Propellor.Bootstrap (
bootstrapPropellorCommand,
checkBinaryCommand,
installGitCommand,
buildPropellor,
) where
import Propellor.Base
import Propellor.Types.Info
import Propellor.Git.Config
import System.Posix.Files
import Data.List
type ShellCommand = String
bootstrapPropellorCommand :: Maybe System -> ShellCommand
bootstrapPropellorCommand msys = checkDepsCommand msys ++
"&& if ! test -x ./propellor; then "
++ buildCommand ++
"; fi;" ++ checkBinaryCommand
checkBinaryCommand :: ShellCommand
checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check; then " ++ go ++ "; fi"
where
go = intercalate " && "
[ "cabal clean"
, buildCommand
]
buildCommand :: ShellCommand
buildCommand = intercalate " && "
[ "cabal configure"
, "cabal build propellor-config"
, "ln -sf dist/build/propellor-config/propellor-config propellor"
]
checkDepsCommand :: Maybe System -> ShellCommand
checkDepsCommand sys = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand sys ++ "; fi"
depsCommand :: Maybe System -> ShellCommand
depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true"
where
osinstall = case msys of
Just (System (FreeBSD _) _) -> map pkginstall fbsddeps
Just (System (Debian _ _) _) -> useapt
Just (System (Buntish _) _) -> useapt
Nothing -> useapt
useapt = "apt-get update" : map aptinstall debdeps
cabalinstall =
[ "cabal update"
, "cabal install --only-dependencies"
]
aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p
pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p
debdeps =
[ "gnupg"
, "ghc"
, "cabal-install"
, "libghc-async-dev"
, "libghc-missingh-dev"
, "libghc-hslogger-dev"
, "libghc-unix-compat-dev"
, "libghc-ansi-terminal-dev"
, "libghc-ifelse-dev"
, "libghc-network-dev"
, "libghc-mtl-dev"
, "libghc-transformers-dev"
, "libghc-exceptions-dev"
, "libghc-stm-dev"
, "libghc-text-dev"
, "make"
]
fbsddeps =
[ "gnupg"
, "ghc"
, "hs-cabal-install"
, "hs-async"
, "hs-MissingH"
, "hs-hslogger"
, "hs-unix-compat"
, "hs-ansi-terminal"
, "hs-IfElse"
, "hs-network"
, "hs-mtl"
, "hs-transformers-base"
, "hs-exceptions"
, "hs-stm"
, "hs-text"
, "gmake"
]
installGitCommand :: Maybe System -> ShellCommand
installGitCommand msys = case msys of
(Just (System (Debian _ _) _)) -> use apt
(Just (System (Buntish _) _)) -> use apt
(Just (System (FreeBSD _) _)) -> use
[ "ASSUME_ALWAYS_YES=yes pkg update"
, "ASSUME_ALWAYS_YES=yes pkg install git"
]
Nothing -> use apt
where
use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi"
apt =
[ "apt-get update"
, "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git"
]
buildPropellor :: Maybe Host -> IO ()
buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $
errorMessage "Propellor build failed!"
where
msys = case fmap (fromInfo . hostInfo) mh of
Just (InfoVal sys) -> Just sys
_ -> Nothing
build :: Maybe System -> IO Bool
build msys = catchBoolIO $ do
bs <- getGitConfigValue "propellor.buildsystem"
case bs of
Just "stack" -> stackBuild msys
_ -> cabalBuild msys
cabalBuild :: Maybe System -> IO Bool
cabalBuild msys = do
make "dist/setup-config" ["propellor.cabal"] cabal_configure
unlessM cabal_build $
unlessM (cabal_configure <&&> cabal_build) $
error "cabal build failed"
unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $
error "cp of binary failed"
rename (tmpfor safetycopy) safetycopy
symlinkPropellorBin safetycopy
return True
where
cabalbuiltbin = "dist/build/propellor-config/propellor-config"
safetycopy = cabalbuiltbin ++ ".built"
cabal_configure = ifM (cabal ["configure"])
( return True
, case msys of
Nothing -> return False
Just sys ->
boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))]
<&&> cabal ["configure"]
)
cabal_build = cabal ["build", "propellor-config"]
stackBuild :: Maybe System -> IO Bool
stackBuild _msys = do
createDirectoryIfMissing True builddest
ifM (stack buildparams)
( do
symlinkPropellorBin (builddest </> "propellor-config")
return True
, return False
)
where
builddest = ".built"
buildparams =
[ "--local-bin-path", builddest
, "build"
, ":propellor-config"
, "--copy-bins"
]
symlinkPropellorBin :: FilePath -> IO ()
symlinkPropellorBin bin = do
createSymbolicLink bin (tmpfor dest)
rename (tmpfor dest) dest
where
dest = "propellor"
tmpfor :: FilePath -> FilePath
tmpfor f = f ++ ".propellortmp"
make :: FilePath -> [FilePath] -> IO Bool -> IO ()
make dest srcs builder = do
dt <- getmtime dest
st <- mapM getmtime srcs
when (dt == Nothing || any (> dt) st) $
unlessM builder $
error $ "failed to make " ++ dest
where
getmtime = catchMaybeIO . getModificationTime
cabal :: [String] -> IO Bool
cabal = boolSystem "cabal" . map Param
stack :: [String] -> IO Bool
stack = boolSystem "stack" . map Param