propellor 4.3.2 → 4.3.3
raw patch · 17 files changed
+297/−124 lines, 17 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Propellor.Property.Bootstrap: Cabal :: Builder
+ Propellor.Property.Bootstrap: OSOnly :: Bootstrapper
+ Propellor.Property.Bootstrap: Robustly :: Builder -> Bootstrapper
+ Propellor.Property.Bootstrap: Stack :: Builder
+ Propellor.Property.Bootstrap: bootstrapWith :: Bootstrapper -> Property (HasInfo + UnixLike)
+ Propellor.Property.Bootstrap: data Bootstrapper
+ Propellor.Property.Bootstrap: data Builder
+ Propellor.Property.Restic: backup' :: [FilePath] -> ResticRepo -> Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)
+ Propellor.Property.User: systemGroup :: Group -> Property UnixLike
Files
- CHANGELOG +22/−1
- README.md +2/−0
- debian/changelog +22/−1
- doc/README.mdwn +2/−0
- joeyconfig.hs +1/−1
- propellor.cabal +2/−2
- src/Propellor/Bootstrap.hs +121/−49
- src/Propellor/DotDir.hs +1/−1
- src/Propellor/Property/Bootstrap.hs +39/−7
- src/Propellor/Property/Cron.hs +3/−2
- src/Propellor/Property/Restic.hs +7/−7
- src/Propellor/Property/User.hs +18/−7
- src/Propellor/Protocol.hs +3/−7
- src/Propellor/Spin.hs +24/−9
- src/config.hs +0/−29
- src/propellor-config.hs +29/−0
- stack.yaml +1/−1
CHANGELOG view
@@ -1,3 +1,23 @@+propellor (4.3.3) unstable; urgency=medium++ * 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+ * Iproved fix for bug that sometimes made --spin fail with+ "fatal: Couldn't find remote ref HEAD". The previous fix didn't work+ reliably.+ * User: add systemGroup and use it for systemAccountFor'+ Thanks, Félix Sipma. + * Export a Restic.backup' property.+ Thanks, Félix Sipma. + * Updated stack config to lts-8.22.++ -- Joey Hess <id@joeyh.name> Thu, 13 Jul 2017 12:34:09 -0400+ propellor (4.3.2) unstable; urgency=medium * Really include Propellor.Property.FreeDesktop.@@ -479,7 +499,8 @@ 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.
README.md view
@@ -41,6 +41,8 @@ 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.
debian/changelog view
@@ -1,3 +1,23 @@+propellor (4.3.3) unstable; urgency=medium++ * 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+ * Iproved fix for bug that sometimes made --spin fail with+ "fatal: Couldn't find remote ref HEAD". The previous fix didn't work+ reliably.+ * User: add systemGroup and use it for systemAccountFor'+ Thanks, Félix Sipma. + * Export a Restic.backup' property.+ Thanks, Félix Sipma. + * Updated stack config to lts-8.22.++ -- Joey Hess <id@joeyh.name> Thu, 13 Jul 2017 12:34:09 -0400+ propellor (4.3.2) unstable; urgency=medium * Really include Propellor.Property.FreeDesktop.@@ -479,7 +499,8 @@ 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.
doc/README.mdwn view
@@ -41,6 +41,8 @@ 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.
joeyconfig.hs view
@@ -105,7 +105,7 @@ clam = host "clam.kitenet.net" $ props & standardSystem Unstable X86_64 ["Unreliable server. Anything here may be lost at any time!" ]- & ipv4 "64.137.239.3"+ & ipv4 "64.137.182.29" & CloudAtCost.decruft & Ssh.hostKeys hostContext
propellor.cabal view
@@ -1,5 +1,5 @@ Name: propellor-Version: 4.3.2+Version: 4.3.3 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -55,7 +55,7 @@ Executable propellor-config Default-Language: Haskell98- Main-Is: config.hs+ Main-Is: propellor-config.hs GHC-Options: -threaded -Wall -fno-warn-tabs -O0 if impl(ghc >= 8.0) GHC-Options: -fno-warn-redundant-constraints
src/Propellor/Bootstrap.hs view
@@ -1,4 +1,8 @@ module Propellor.Bootstrap (+ Bootstrapper(..),+ Builder(..),+ defaultBootstrapper,+ getBootstrapper, bootstrapPropellorCommand, checkBinaryCommand, installGitCommand,@@ -16,71 +20,119 @@ 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-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"+-- 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" --- 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,8 +150,13 @@ , "libghc-text-dev" , "libghc-hashable-dev" ]- fbsddeps =+ debdeps Stack = [ "gnupg"+ , "haskell-stack"+ ]++ fbsddeps Cabal =+ [ "gnupg" , "ghc" , "hs-cabal-install" , "hs-async"@@ -116,8 +173,13 @@ , "hs-text" , "hs-hashable" ]- archlinuxdeps =+ fbsddeps Stack = [ "gnupg"+ , "stack"+ ]++ archlinuxdeps Cabal =+ [ "gnupg" , "ghc" , "cabal-install" , "haskell-async"@@ -135,6 +197,10 @@ , "haskell-text" , "hashell-hashable" ]+ archlinuxdeps Stack = + [ "gnupg"+ , "stack"+ ] installGitCommand :: Maybe System -> ShellCommand installGitCommand msys = case msys of@@ -155,22 +221,28 @@ , "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 +275,7 @@ , 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"]
src/Propellor/DotDir.hs view
@@ -316,7 +316,7 @@ ] stackResolver :: String-stackResolver = "lts-7.16"+stackResolver = "lts-8.22" fullClone :: IO Result fullClone = do
src/Propellor/Property/Bootstrap.hs view
@@ -1,12 +1,40 @@-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(..),+ Builder(..),+ 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 +45,17 @@ -- | 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 +63,15 @@ 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.
src/Propellor/Property/Cron.hs view
@@ -80,7 +80,8 @@ -- | 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")
src/Propellor/Property/Restic.hs view
@@ -9,6 +9,7 @@ , init , restored , backup+ , backup' , KeepPolicy (..) ) where @@ -138,17 +139,17 @@ -- backup job will be run at a time. Other jobs will wait their turns to -- run. backup :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)-backup dir repo crontimes extraargs kp = backup' dir repo crontimes extraargs kp+backup dir repo crontimes extraargs kp = backup' [dir] repo crontimes extraargs kp `requires` restored dir repo -- | Does a backup, but does not automatically restore.-backup' :: FilePath -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)-backup' dir repo crontimes extraargs kp = cronjob+backup' :: [FilePath] -> ResticRepo -> Cron.Times -> [ResticParam] -> [KeepPolicy] -> Property (HasInfo + DebianLike)+backup' dirs repo crontimes extraargs kp = cronjob `describe` desc `requires` init repo where desc = val repo ++ " restic backup"- cronjob = Cron.niceJob ("restic_backup" ++ dir) crontimes (User "root") "/" $+ cronjob = Cron.niceJob ("restic_backup" ++ intercalate "_" dirs) crontimes (User "root") "/" $ "flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape backupcmd lockfile = "/var/lock/propellor-restic.lock" backupcmd = intercalate " && " $@@ -162,9 +163,8 @@ , shellEscape (getPasswordFile repo) ] ++ map shellEscape extraargs ++- [ "backup"- , shellEscape dir- ]+ [ "backup" ]+ ++ map shellEscape dirs pruneCommand = unwords $ [ "restic" , "-r"
src/Propellor/Property/User.hs view
@@ -22,17 +22,18 @@ systemAccountFor user@(User u) = systemAccountFor' user Nothing (Just (Group u)) systemAccountFor' :: User -> Maybe FilePath -> Maybe Group -> Property DebianLike-systemAccountFor' (User u) mhome mgroup = tightenTargets $ check nouser go+systemAccountFor' (User u) mhome mgroup = case mgroup of+ Nothing -> prop+ Just g -> prop+ `requires` systemGroup g `describe` ("system account for " ++ u) where+ prop = tightenTargets $ check nouser go nouser = isNothing <$> catchMaybeIO (getUserEntryForName u) go = cmdProperty "adduser" $- [ "--system" ]+ [ "--system", "--home" ] ++- "--home" : maybe- ["/nonexistent", "--no-create-home"]- ( \h -> [ h ] )- mhome+ maybe ["/nonexistent", "--no-create-home"] ( \h -> [h] ) mhome ++ maybe [] ( \(Group g) -> ["--ingroup", g] ) mgroup ++@@ -42,6 +43,16 @@ , u ] +systemGroup :: Group -> Property UnixLike+systemGroup (Group g) = check nogroup go+ `describe` ("system account for " ++ g)+ where+ nogroup = isNothing <$> catchMaybeIO (getGroupEntryForName g)+ go = cmdProperty "addgroup"+ [ "--system"+ , g+ ]+ -- | Removes user home directory!! Use with caution. nuked :: User -> Eep -> Property Linux nuked user@(User u) _ = tightenTargets $ check hashomedir go@@ -111,7 +122,7 @@ hClose h lockedPassword :: User -> Property DebianLike-lockedPassword user@(User u) = tightenTargets $ +lockedPassword user@(User u) = tightenTargets $ check (not <$> isLockedPassword user) go `describe` ("locked " ++ u ++ " password") where
src/Propellor/Protocol.hs view
@@ -53,11 +53,7 @@ hFlush h getMarked :: Handle -> Marker -> IO (Maybe String)-getMarked h marker = do- -- Avoid buffering anything in Handle, so that the data after- -- the marker will be available to be read from the underlying Fd.- hSetBuffering stdin NoBuffering- go =<< catchMaybeIO (hGetLine h)+getMarked h marker = go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing go (Just l) = case fromMarked marker l of@@ -69,8 +65,8 @@ debug ["received marked", marker] return (Just v) -reqMarked :: Stage -> Marker -> (String -> IO ()) -> IO ()-reqMarked stage marker a = do+req :: Stage -> Marker -> (String -> IO ()) -> IO ()+req stage marker a = do debug ["requested marked", marker] sendMarked' stdout statusMarker (show stage) maybe noop a =<< getMarked stdin marker
src/Propellor/Spin.hs view
@@ -93,6 +93,9 @@ 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 @@ updatecmd = intercalate " && " [ "cd " ++ localdir- , bootstrapPropellorCommand sys+ , bootstrapPropellorCommand bootstrapper sys , if viarelay then "./propellor --continue " ++ shellEscape (show (Relay target))@@ -178,11 +181,11 @@ update :: Maybe HostName -> IO () update forhost = do whenM hasGitRepo $- reqMarked NeedRepoUrl repoUrlMarker setRepoUrl+ req NeedRepoUrl repoUrlMarker setRepoUrl makePrivDataDir createDirectoryIfMissing True (takeDirectory privfile)- reqMarked NeedPrivData privDataMarker $+ req NeedPrivData privDataMarker $ writeFileProtected privfile whenM hasGitRepo $@@ -350,18 +353,30 @@ -- Request that it run git upload-pack, and connect that up to a git fetch -- to receive the data. gitPullFromUpdateServer :: IO ()-gitPullFromUpdateServer = reqMarked NeedGitPush gitPushMarker $ \_ -> do- -- Note that this relies on data not being buffered in the stdin- -- Handle, since such buffered data would not be available in the- -- FD passed to git fetch. - hin <- dup stdInput+gitPullFromUpdateServer = req NeedGitPush gitPushMarker $ \_ -> do+ -- IO involving stdin can cause data to be buffered in the Handle+ -- (even when it's set NoBuffering), but we need to pass a FD to + -- git fetch containing all of stdin after the gitPushMarker,+ -- including any that has been buffered.+ --+ -- To do so, create a pipe, and forward stdin, including any+ -- buffered part, through it.+ (pread, pwrite) <- System.Posix.IO.createPipe+ -- Note that there is a race between the createPipe and setting+ -- CloseOnExec. Another processess forked here would inherit+ -- pwrite and perhaps keep it open. However, propellor is not+ -- running concurrent threads at this point, so this is ok.+ setFdOption pwrite CloseOnExec True+ hwrite <- fdToHandle pwrite+ forwarder <- async $ stdin *>* hwrite+ let hin = pread hout <- dup stdOutput- hClose stdin hClose stdout -- Not using git pull because git 2.5.0 badly -- broke its option parser. unlessM (boolSystemNonConcurrent "git" (fetchparams hin hout)) $ errorMessage "git fetch from client failed"+ wait forwarder unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ errorMessage "git merge from client failed" where
− src/config.hs
@@ -1,29 +0,0 @@--- This is the main configuration file for Propellor, and is used to build--- the propellor program.--import Propellor-import qualified Propellor.Property.File as File-import qualified Propellor.Property.Apt as Apt-import qualified Propellor.Property.Cron as Cron-import qualified Propellor.Property.User as User--main :: IO ()-main = defaultMain hosts---- The hosts propellor knows about.-hosts :: [Host]-hosts =- [ mybox- ]---- An example host.-mybox :: Host-mybox = host "mybox.example.com" $ props- & osDebian Unstable X86_64- & Apt.stdSourcesList- & Apt.unattendedUpgrades- & Apt.installed ["etckeeper"]- & Apt.installed ["ssh"]- & User.hasSomePassword (User "root")- & File.dirExists "/var/www"- & Cron.runPropellor (Cron.Times "30 * * * *")
+ src/propellor-config.hs view
@@ -0,0 +1,29 @@+-- This is the main configuration file for Propellor, and is used to build+-- the propellor program.++import Propellor+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Cron as Cron+import qualified Propellor.Property.User as User++main :: IO ()+main = defaultMain hosts++-- The hosts propellor knows about.+hosts :: [Host]+hosts =+ [ mybox+ ]++-- An example host.+mybox :: Host+mybox = host "mybox.example.com" $ props+ & osDebian Unstable X86_64+ & Apt.stdSourcesList+ & Apt.unattendedUpgrades+ & Apt.installed ["etckeeper"]+ & Apt.installed ["ssh"]+ & User.hasSomePassword (User "root")+ & File.dirExists "/var/www"+ & Cron.runPropellor (Cron.Times "30 * * * *")
stack.yaml view
@@ -1,4 +1,4 @@ # When updating the resolver here, also update stackResolver in Propellor.DotDir-resolver: lts-7.16+resolver: lts-8.22 packages: - '.'