From 08010583fa42af1b2b5ab070e4742263d43b26cf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 12 Jul 2017 19:12:36 -0400 Subject: add bootstrapWith property to support stack and more * Hosts can be configured to build propellor using stack, by adding a property: & bootstrapWith (Robustly Stack) * Hosts can be configured to build propellor using cabal, but using only packages installed from the operating system. This will work on eg Debian: & bootstrapWith OSOnly propellor build its config using stack. (This does not affect how propellor is bootstrapped on a host by "propellor --spin host".) This has not yet been tested at all! But should probably work fine. This is based on earlier work by Arnaud Bailly, who made Propellor.Bootstrap use stack without parameterization. In Arnaud's patch, stack was installed using wget, but that only worked on linux-x86_64 and was insecure. I instead chose to use the distribution packages of stack, like is done for cabal. Debian stack has haskell-stack now, and it's getting into many distributions. This commit was sponsored by Francois Marier on Patreon. --- src/Propellor/Bootstrap.hs | 167 ++++++++++++++++++++++++++---------- src/Propellor/Property/Bootstrap.hs | 45 ++++++++-- src/Propellor/Property/Cron.hs | 5 +- src/Propellor/Spin.hs | 5 +- 4 files changed, 165 insertions(+), 57 deletions(-) (limited to 'src') diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 4b3f2da2..baf36e49 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -1,4 +1,8 @@ module Propellor.Bootstrap ( + Bootstrapper(..), + Builder(..), + defaultBootstrapper, + getBootstrapper, bootstrapPropellorCommand, checkBinaryCommand, installGitCommand, @@ -16,71 +20,120 @@ 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) + +data Builder = Cabal | Stack + deriving (Show) + +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 :: Maybe System -> ShellCommand -bootstrapPropellorCommand msys = checkDepsCommand msys ++ +bootstrapPropellorCommand :: Bootstrapper -> Maybe System -> ShellCommand +bootstrapPropellorCommand bs msys = checkDepsCommand bs msys ++ "&& if ! test -x ./propellor; then " - ++ buildCommand ++ - "; fi;" ++ checkBinaryCommand + ++ 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 :: ShellCommand -checkBinaryCommand = "if test -x ./propellor && ! ./propellor --check; then " ++ go ++ "; fi" +checkBinaryCommand :: Bootstrapper -> ShellCommand +checkBinaryCommand bs = "if test -x ./propellor && ! ./propellor --check; then " ++ go (getBuilder bs) ++ "; fi" where - go = intercalate " && " + go Cabal = intercalate " && " [ "cabal clean" - , buildCommand + , buildCommand bs + ] + go Stack = intercalate " && " + [ "stack clean" + , buildCommand bs ] -buildCommand :: ShellCommand -buildCommand = intercalate " && " - [ "cabal configure" - , "cabal build propellor-config" - , "ln -sf dist/build/propellor-config/propellor-config propellor" - ] +buildCommand :: Bootstrapper -> ShellCommand +buildCommand bs = intercalate " && " (go (getBuilder bs)) + where + go Cabal = + [ "cabal configure" + , "cabal build 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" + ] -- Run cabal configure to check if all dependencies are installed; -- if not, run the depsCommand. -checkDepsCommand :: Maybe System -> ShellCommand -checkDepsCommand sys = "if ! cabal configure >/dev/null 2>&1; then " ++ depsCommand sys ++ "; fi" +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 --version >/dev/null 2>&1; then " ++ depsCommand bs sys ++ "; fi" --- Install build dependencies of propellor. --- --- First, try to install ghc, cabal, gnupg, and all haskell libraries that --- propellor uses from OS packages. +-- 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 Debian -- (eg, Debian wheezy lacks async), or propellor may need a newer version. --- So, as a second step, cabal is used to install all dependencies. +-- So, as a second step, any other dependencies are installed from source +-- using the builder. -- -- Note: May succeed and leave some deps not installed. -depsCommand :: Maybe System -> ShellCommand -depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) ++ " ) || true" +depsCommand :: Bootstrapper -> Maybe System -> ShellCommand +depsCommand bs msys = "( " ++ intercalate " ; " (go bs) ++ ") || true" where - osinstall = case msys of - Just (System (FreeBSD _) _) -> map pkginstall fbsddeps - Just (System (ArchLinux) _) -> map pacmaninstall archlinuxdeps - Just (System (Debian _ _) _) -> useapt - Just (System (Buntish _) _) -> useapt - -- assume a debian derived system when not specified - Nothing -> useapt - - useapt = "apt-get update" : map aptinstall debdeps - - cabalinstall = + 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 p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p pacmaninstall p = "pacman -S --noconfirm --needed " ++ p -- This is the same deps listed in debian/control. - debdeps = + debdeps Cabal = [ "gnupg" , "ghc" , "cabal-install" @@ -98,7 +151,12 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) , "libghc-text-dev" , "libghc-hashable-dev" ] - fbsddeps = + debdeps Stack = + [ "gnupg" + , "haskell-stack" + ] + + fbsddeps Cabal = [ "gnupg" , "ghc" , "hs-cabal-install" @@ -116,7 +174,12 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) , "hs-text" , "hs-hashable" ] - archlinuxdeps = + fbsddeps Stack = + [ "gnupg" + , "stack" + ] + + archlinuxdeps Cabal = [ "gnupg" , "ghc" , "cabal-install" @@ -135,6 +198,10 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) , "haskell-text" , "hashell-hashable" ] + archlinuxdeps Stack = + [ "gnupg" + , "stack" + ] installGitCommand :: Maybe System -> ShellCommand installGitCommand msys = case msys of @@ -155,22 +222,28 @@ installGitCommand msys = case msys of , "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 msys)) $ +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 propellor using cabal or stack, and symlink propellor to the --- built binary. -build :: Maybe System -> IO Bool -build msys = catchBoolIO $ do - bs <- getGitConfigValue "propellor.buildsystem" - case bs of - Just "stack" -> stackBuild msys - _ -> cabalBuild msys + 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. @@ -203,7 +276,7 @@ cabalBuild msys = do , case msys of Nothing -> return False Just sys -> - boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))] + boolSystem "sh" [Param "-c", Param (depsCommand (Robustly Cabal) (Just sys))] <&&> cabal ["configure"] ) cabal_build = cabal ["build", "propellor-config"] diff --git a/src/Propellor/Property/Bootstrap.hs b/src/Propellor/Property/Bootstrap.hs index 767d6ef7..93529c14 100644 --- a/src/Propellor/Property/Bootstrap.hs +++ b/src/Propellor/Property/Bootstrap.hs @@ -1,12 +1,39 @@ -module Propellor.Property.Bootstrap (RepoSource(..), bootstrappedFrom, clonedFrom) where +-- | This module contains properties that configure how Propellor +-- bootstraps to run itself on a Host. + +module Propellor.Property.Bootstrap ( + Bootstrapper(..), + 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 = "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 @@ -17,14 +44,17 @@ data RepoSource -- | Bootstraps a propellor installation into -- /usr/local/propellor/ -- --- This property only does anything when used inside a chroot. --- This is particularly useful inside a chroot used to build a +-- 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 falling back to using cabal or stack. bootstrappedFrom :: RepoSource -> Property Linux bootstrappedFrom reposource = check inChroot $ go `requires` clonedFrom reposource @@ -32,14 +62,15 @@ bootstrappedFrom reposource = check inChroot $ go :: Property Linux go = property "Propellor bootstrapped" $ do system <- getOS + bootstrapper <- getBootstrapper assumeChange $ exposeTrueLocaldir $ const $ runShellCommand $ buildShellCommand [ "cd " ++ localdir - , checkDepsCommand system - , buildCommand + , checkDepsCommand bootstrapper system + , buildCommand bootstrapper ] --- | Clones the propellor repeository into /usr/local/propellor/ +-- | Clones the propellor repository into /usr/local/propellor/ -- -- If the propellor repo has already been cloned, pulls to get it -- up-to-date. diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs index 0966a7e5..ab700a9d 100644 --- a/src/Propellor/Property/Cron.hs +++ b/src/Propellor/Property/Cron.hs @@ -80,7 +80,8 @@ niceJob desc times user cddir command = job desc times user cddir -- | Installs a cron job to run propellor. runPropellor :: Times -> Property UnixLike -runPropellor times = withOS "propellor cron job" $ \w o -> +runPropellor times = withOS "propellor cron job" $ \w o -> do + bootstrapper <- getBootstrapper ensureProperty w $ niceJob "propellor" times (User "root") localdir - (bootstrapPropellorCommand o ++ "; ./propellor") + (bootstrapPropellorCommand bootstrapper o ++ "; ./propellor") diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index cd964e16..7146ad4c 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -93,6 +93,9 @@ spin' mprivdata relay target hst = do sys = case fromInfo (hostInfo hst) of InfoVal o -> Just o NoInfoVal -> Nothing + bootstrapper = case fromInfo (hostInfo hst) of + NoInfoVal -> defaultBootstrapper + InfoVal bs -> bs relaying = relay == Just target viarelay = isJust relay && not relaying @@ -109,7 +112,7 @@ spin' mprivdata relay target hst = do updatecmd = intercalate " && " [ "cd " ++ localdir - , bootstrapPropellorCommand sys + , bootstrapPropellorCommand bootstrapper sys , if viarelay then "./propellor --continue " ++ shellEscape (show (Relay target)) -- cgit v1.2.3