summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog10
-rw-r--r--doc/README.mdwn2
-rw-r--r--doc/todo/use_stack_for_remote_building_propellor.mdwn13
-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
7 files changed, 189 insertions, 58 deletions
diff --git a/debian/changelog b/debian/changelog
index 24552b21..be0285f9 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,13 @@ propellor (4.3.1) UNRELEASED; urgency=medium
* Added Propellor.Property.FreeDesktop module.
* Added reservedSpacePercentage to the PartSpec EDSL.
+ * 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
-- Joey Hess <id@joeyh.name> Wed, 05 Jul 2017 22:57:42 -0400
@@ -473,7 +480,8 @@ propellor (3.0.0) unstable; urgency=medium
a clone of propellor's git repository, or a minimal config, and will
configure propellor to use a gpg key.
* Stack support. "git config propellor.buildsystem stack" will make
- propellor build its config using stack.
+ propellor build its config using stack. (This does not affect
+ how propellor is bootstrapped on a host by "propellor --spin host".)
* When propellor is installed using stack, propellor --init will
automatically set propellor.buildsystem=stack.
diff --git a/doc/README.mdwn b/doc/README.mdwn
index ea622b3a..a4a38c5f 100644
--- a/doc/README.mdwn
+++ b/doc/README.mdwn
@@ -41,6 +41,8 @@ see [configuration for the Haskell newbie](https://propellor.branchable.com/hask
1. Get propellor installed on your development machine (ie, laptop).
`cabal install propellor`
or
+ `stack install propellor`
+ or
`apt-get install propellor`
2. Run `propellor --init` ; this will set up a `~/.propellor/` git
repository for you.
diff --git a/doc/todo/use_stack_for_remote_building_propellor.mdwn b/doc/todo/use_stack_for_remote_building_propellor.mdwn
index 265596df..8c8751e7 100644
--- a/doc/todo/use_stack_for_remote_building_propellor.mdwn
+++ b/doc/todo/use_stack_for_remote_building_propellor.mdwn
@@ -1,3 +1,16 @@
Among other features [stack](https://github.com/commercialhaskell/stack/) provides a clean and deep dependency management system that even takes care of installing toolchain (ghc, alex, happy, cabal...) in a segregated environment. Building remote propellor with stack would remove the limitation that code should be compilable with stock ghc from package manager. I have done some preliminary work on this feature in my [github clone](https://github.com/abailly/propellor) for propellor, currently from 2.17.2 branch (I wanted to reuse existing properties). The code is mostly in [Bootstrap](https://github.com/abailly/propellor/blob/master/src/Propellor/Bootstrap.hs) and is currently limited to linux systems. Adapting to FreeBsd should be straightforward as this is supported by slack and there are native builds available.
If there is interest in such a feature I would be happy to move it to HEAD and provide a patch.
+
+> I've implemented a bootstrapWith property, which can be added to a Host
+> to make it use stack:
+>
+> & bootstrapWith (Robustly Stack)
+>
+> So, for a propellor install that uses stack entirely, use
+> `stack install propellor` to install it to your laptop,
+> use `propellor --init` to set up `~/.propellor/config,hs`,
+> and in the config file, add the above property to all your
+> Hosts (perhaps using `map` ..).
+>
+> I feel that's enough to call this [[done]]. --[[Joey]]
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))