summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2017-07-12 19:12:36 -0400
committerJoey Hess2017-07-12 19:12:36 -0400
commit08010583fa42af1b2b5ab070e4742263d43b26cf (patch)
tree6a65363f435863139950616cc12ca7ef74042fdf /src/Propellor
parent8e172612f5675a9dab4c302e9353af7e77773d45 (diff)
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.
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/Bootstrap.hs167
-rw-r--r--src/Propellor/Property/Bootstrap.hs45
-rw-r--r--src/Propellor/Property/Cron.hs5
-rw-r--r--src/Propellor/Spin.hs5
4 files changed, 165 insertions, 57 deletions
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))