packages feed

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 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: - '.'