{-# LANGUAGE DeriveDataTypeable #-} module Propellor.Bootstrap ( Bootstrapper(..), Builder(..), defaultBootstrapper, getBootstrapper, bootstrapPropellorCommand, checkBinaryCommand, installGitCommand, buildPropellor, checkDepsCommand, buildCommand, ) where import Propellor.Base import Propellor.Types.Info import Propellor.Git.Config import System.Posix.Files import Data.List type ShellCommand = String -- | Different ways that Propellor's dependencies can be installed, -- and propellor can be built. The default is `Robustly Cabal` -- -- `Robustly Cabal` and `Robustly Stack` use the OS's native packages -- as much as possible to install Cabal, Stack, and propellor's build -- dependencies. When necessary, dependencies are built from source -- using Cabal or Stack rather than using the OS's native packages. -- -- `OSOnly` uses the OS's native packages of Cabal and all of propellor's -- build dependencies. It may not work on all systems. data Bootstrapper = Robustly Builder | OSOnly deriving (Show, Typeable) data Builder = Cabal | Stack deriving (Show, Typeable) defaultBootstrapper :: Bootstrapper defaultBootstrapper = Robustly Cabal -- | Gets the Bootstrapper for the Host propellor is running on. getBootstrapper :: Propellor Bootstrapper getBootstrapper = go <$> askInfo where go NoInfoVal = defaultBootstrapper go (InfoVal bs) = bs getBuilder :: Bootstrapper -> Builder getBuilder (Robustly b) = b getBuilder OSOnly = Cabal -- Shell command line to ensure propellor is bootstrapped and ready to run. -- Should be run inside the propellor config dir, and will install -- all necessary build dependencies and build propellor. bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> ShellCommand bootstrapPropellorCommand bs msys = checkDepsCommand bs msys ++ "&& if ! test -x ./propellor; then " ++ buildCommand bs ++ "; fi;" ++ checkBinaryCommand bs -- Use propellor --check to detect if the local propellor binary has -- stopped working (eg due to library changes), and must be rebuilt. checkBinaryCommand :: Bootstrapper -> ShellCommand checkBinaryCommand bs = "if test -x ./propellor && ! ./propellor --check; then " ++ go (getBuilder bs) ++ "; fi" where go Cabal = intercalate " && " [ "cabal clean" , buildCommand bs ] go Stack = intercalate " && " [ "stack clean" , buildCommand bs ] buildCommand :: Bootstrapper -> ShellCommand buildCommand bs = intercalate " && " (go (getBuilder bs)) where go Cabal = [ "cabal configure" , "cabal build -j1 propellor-config" , "ln -sf dist/build/propellor-config/propellor-config propellor" ] go Stack = [ "stack build :propellor-config" , "ln -sf $(stack path --dist-dir)/build/propellor-config/propellor-config propellor" ] -- Check if all dependencies are installed; if not, run the depsCommand. checkDepsCommand :: Bootstrapper -> Maybe System -> ShellCommand checkDepsCommand bs sys = go (getBuilder bs) where go Cabal = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi" go Stack = "if ! stack build --dry-run >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi" data Dep = Dep String | OldDep String -- Install build dependencies of propellor, using the specified -- Bootstrapper. -- -- When bootstrapping Robustly, first try to install the builder, -- and all haskell libraries that propellor uses from OS packages. -- Some packages may not be available in some versions of the OS, -- or propellor may need a newer version. So, as a second step, -- ny other dependencies are installed from source using the builder. -- -- Note: May succeed and leave some deps not installed. depsCommand :: Bootstrapper -> Maybe System -> ShellCommand depsCommand bs msys = "( " ++ intercalate " ; " (go bs) ++ ") || true" where go (Robustly Cabal) = osinstall Cabal ++ [ "cabal update" , "cabal install --only-dependencies" ] go (Robustly Stack) = osinstall Stack ++ [ "stack setup" , "stack build --only-dependencies :propellor-config" ] go OSOnly = osinstall Cabal osinstall builder = case msys of Just (System (FreeBSD _) _) -> map pkginstall (fbsddeps builder) Just (System (ArchLinux) _) -> map pacmaninstall (archlinuxdeps builder) Just (System (Debian _ _) _) -> useapt builder Just (System (Buntish _) _) -> useapt builder -- assume a Debian derived system when not specified Nothing -> useapt builder useapt builder = "apt-get update" : map aptinstall (debdeps builder) aptinstall (Dep p) = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p aptinstall (OldDep p) = "if LANG=C apt-cache policy " ++ p ++ "| grep -q Candidate:; then " ++ aptinstall (Dep p) ++ "; fi" pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p pacmaninstall p = "pacman -S --noconfirm --needed " ++ p debdeps Cabal = [ Dep "gnupg" -- Below are the same deps listed in debian/control. , Dep "ghc" , Dep "cabal-install" , Dep "libghc-async-dev" , Dep "libghc-split-dev" , Dep "libghc-hslogger-dev" , Dep "libghc-unix-compat-dev" , Dep "libghc-ansi-terminal-dev" , Dep "libghc-ifelse-dev" , Dep "libghc-network-dev" , Dep "libghc-mtl-dev" , Dep "libghc-transformers-dev" , Dep "libghc-exceptions-dev" , Dep "libghc-text-dev" , Dep "libghc-hashable-dev" -- Deps that are only needed on old systems. , OldDep "libghc-stm-dev" ] debdeps Stack = [ Dep "gnupg" , Dep "haskell-stack" ] fbsddeps Cabal = [ "gnupg" , "ghc" , "hs-cabal-install" , "hs-async" , "hs-split" , "hs-hslogger" , "hs-unix-compat" , "hs-ansi-terminal" , "hs-IfElse" , "hs-network" , "hs-mtl" , "hs-transformers-base" , "hs-exceptions" , "hs-stm" , "hs-text" , "hs-hashable" ] fbsddeps Stack = [ "gnupg" , "stack" ] archlinuxdeps Cabal = [ "gnupg" , "ghc" , "cabal-install" , "haskell-async" , "haskell-split" , "haskell-hslogger" , "haskell-unix-compat" , "haskell-ansi-terminal" , "haskell-hackage-security" , "haskell-ifelse" , "haskell-network" , "haskell-mtl" , "haskell-transformers-base" , "haskell-exceptions" , "haskell-stm" , "haskell-text" , "hashell-hashable" ] archlinuxdeps Stack = [ "gnupg" , "stack" ] 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" ] (Just (System (ArchLinux) _)) -> use [ "pacman -S --noconfirm --needed git"] -- assume a debian derived system when not specified Nothing -> use apt where use cmds = "if ! git --version >/dev/null 2>&1; then " ++ intercalate " && " cmds ++ "; fi" apt = [ "apt-get update" , "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git" ] -- Build propellor, and symlink the built binary to ./propellor. -- -- When the Host has a Buildsystem specified it is used. If none is -- specified, look at git config propellor.buildsystem. buildPropellor :: Maybe Host -> IO () buildPropellor mh = unlessM (actionMessage "Propellor build" build) $ errorMessage "Propellor build failed!" where msys = case fmap (fromInfo . hostInfo) mh of Just (InfoVal sys) -> Just sys _ -> Nothing build = catchBoolIO $ do case fromInfo (maybe mempty hostInfo mh) of NoInfoVal -> do bs <- getGitConfigValue "propellor.buildsystem" case bs of Just "stack" -> stackBuild msys _ -> cabalBuild msys InfoVal bs -> case getBuilder bs of Cabal -> cabalBuild msys Stack -> stackBuild msys -- For speed, only runs cabal configure when it's not been run before. -- If the build fails cabal may need to have configure re-run. -- -- If the cabal configure fails, and a System is provided, installs -- dependencies and retries. 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" -- For safety against eg power loss in the middle of the build, -- make a copy of the binary, and move it into place atomically. -- This ensures that the propellor symlink only ever points at -- a binary that is fully built. Also, avoid ever removing -- or breaking the symlink. -- -- Need cp -pfRL to make build timestamp checking work. unlessM (boolSystem "cp" [Param "-pfRL", 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 (Robustly Cabal) (Just sys))] <&&> cabal ["configure"] ) -- The -j1 is to only run one job at a time -- in some situations, -- eg in qemu, ghc does not run reliably in parallel. cabal_build = cabal ["build", "-j1", "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" -- only build config program , "--copy-bins" ] -- Atomic symlink creation/update. 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