propellor 2.15.1 → 2.15.2

raw patch · 19 files changed

+376/−128 lines, 19 files

Files

• CHANGELOG +13/−1
• Makefile +1/−1
• config-joey.hs +42/−5
• debian/changelog +13/−1
• propellor.cabal +3/−1
• src/Propellor/Bootstrap.hs +2/−2
• src/Propellor/CmdLine.hs +2/−1
• src/Propellor/Git.hs +6/−88
• src/Propellor/Git/Config.hs +47/−0
• src/Propellor/Git/VerifiedBranch.hs +51/−0
• src/Propellor/Gpg.hs +42/−24
• src/Propellor/Info.hs +2/−2
• src/Propellor/Property/HostingProvider/CloudAtCost.hs +1/−0
• src/Propellor/Property/LightDM.hs +4/−0
• src/Propellor/Property/Postfix.hs +136/−0
• src/Propellor/Property/PropellorRepo.hs +1/−1
• src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +1/−0
• src/Propellor/Property/SiteSpecific/JoeySites.hs +8/−1
• src/Propellor/Spin.hs +1/−0

@@ -1,3 +1,15 @@+propellor (2.15.2) unstable; urgency=medium++  * Added GNUPGBIN environment variable or git.program git config+    to control the command run for gpg. Allows eg, GNUPGBIN=gpg2+    Thanks, Félix Sipma.+  * Bootstrap apt-get installs run with deconf noninteractive frontend.+  * spin --via: Avoid committing on relay host.+  * Postfix: Add service property to enable/disable services in master.cf.+  * Added Munin module, contributed by Jelmer Vernooij.++ -- Joey Hess <id@joeyh.name>  Sun, 03 Jan 2016 16:56:26 -0400+ propellor (2.15.1) unstable; urgency=medium    * Added git configs propellor.spin-branch and propellor.forbid-dirty-spin.@@ -7,8 +19,8 @@   * Gpg.keyImported converted to not use a flag file and instead check     if gpg has the provided key already.     Thanks, Félix Sipma.-  * Merged Utility changes from git-annex.   * Clean build with ghc 7.10.+  * Merged Utility changes from git-annex.   -- Joey Hess <id@joeyh.name>  Sat, 19 Dec 2015 16:43:09 -0400 

@@ -37,7 +37,7 @@ # duplicate tags with Propellor.Property. removed from the start, as we # often import qualified by just the module base name. tags:-	find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags  2>/dev/null || true+	find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags 2>/dev/null | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags || true  dist/setup-config: propellor.cabal 	@if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi

@@ -46,6 +46,8 @@ 	[ darkstar 	, gnu 	, clam+	, mayfly+	, oyster 	, orca 	, honeybee 	, kite@@ -118,6 +120,8 @@ 		] 	& Apt.unattendedUpgrades 	& Network.ipv6to4+	& Systemd.persistentJournal+	& Journald.systemMaxUse "500MiB"  	& Tor.isRelay 	& Tor.named "kite1"@@ -134,15 +138,45 @@ 	& JoeySites.scrollBox 	& alias "scroll.joeyh.name" 	& alias "us.scroll.joeyh.name"++mayfly :: Host+mayfly = standardSystem "mayfly.kitenet.net" (Stable "jessie") "amd64"+	[ "Scratch VM. Contents can change at any time!" ]+	& ipv4 "104.167.118.15"++	& CloudAtCost.decruft+	& Apt.unattendedUpgrades+	& Network.ipv6to4+	& Systemd.persistentJournal+	& Journald.systemMaxUse "500MiB" 	-	-- ssh on some extra ports to deal with horrible networks-	-- while travelling-	& alias "travelling.kitenet.net"-	! Ssh.listenPort 80-	! Ssh.listenPort 443+	& Tor.isRelay+	& Tor.named "kite3"+	& Tor.bandwidthRate (Tor.PerMonth "400 GB") +oyster :: Host+oyster = standardSystem "oyster.kitenet.net" Unstable "amd64"+	[ "Unreliable server. Anything here may be lost at any time!" ]+	& ipv4 "104.167.117.109"++	& CloudAtCost.decruft+	& Ssh.hostKeys hostContext+		[ (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBP0ws/IxQegVU0RhqnIm5A/vRSPTO70wD4o2Bd1jL970dTetNyXzvWGe1spEbLjIYSLIO7WvOBSE5RhplBKFMUU=")+		]+	& Apt.unattendedUpgrades+	& Network.ipv6to4 	& Systemd.persistentJournal+	& Journald.systemMaxUse "500MiB" +	& Tor.isRelay+	& Tor.named "kite2"+	& Tor.bandwidthRate (Tor.PerMonth "400 GB")+	+	-- Nothing is using http port 80, so listen on+	-- that port for ssh, for traveling on bad networks that+	-- block 22.+	& Ssh.listenPort 80+ orca :: Host orca = standardSystem "orca.kitenet.net" Unstable "amd64" 	[ "Main git-annex build box." ]@@ -184,6 +218,9 @@ 	-- ipv6 used for remote access thru firewalls 	& Apt.serviceInstalledRunning "aiccu" 	& ipv6 "2001:4830:1600:187::2"+	-- restart to deal with failure to connect, tunnel issues, etc+	& Cron.job "aiccu restart daily" Cron.Daily (User "root") "/"+		"service aiccu stop; service aiccu start"  	-- In case compiler needs more than available ram 	& Apt.serviceInstalledRunning "swapspace"

@@ -1,3 +1,15 @@+propellor (2.15.2) unstable; urgency=medium++  * Added GNUPGBIN environment variable or git.program git config+    to control the command run for gpg. Allows eg, GNUPGBIN=gpg2+    Thanks, Félix Sipma.+  * Bootstrap apt-get installs run with deconf noninteractive frontend.+  * spin --via: Avoid committing on relay host.+  * Postfix: Add service property to enable/disable services in master.cf.+  * Added Munin module, contributed by Jelmer Vernooij.++ -- Joey Hess <id@joeyh.name>  Sun, 03 Jan 2016 16:56:26 -0400+ propellor (2.15.1) unstable; urgency=medium    * Added git configs propellor.spin-branch and propellor.forbid-dirty-spin.@@ -7,8 +19,8 @@   * Gpg.keyImported converted to not use a flag file and instead check     if gpg has the provided key already.     Thanks, Félix Sipma.-  * Merged Utility changes from git-annex.   * Clean build with ghc 7.10.+  * Merged Utility changes from git-annex.   -- Joey Hess <id@joeyh.name>  Sat, 19 Dec 2015 16:43:09 -0400 

@@ -1,5 +1,5 @@ Name: propellor-Version: 2.15.1+Version: 2.15.2 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -148,6 +148,8 @@   Other-Modules:     Propellor.Bootstrap     Propellor.Git+    Propellor.Git.Config+    Propellor.Git.VerifiedBranch     Propellor.Gpg     Propellor.Spin     Propellor.Ssh

@@ -63,7 +63,7 @@ 		, "cabal install --only-dependencies" 		] -	aptinstall p = "apt-get --no-upgrade --no-install-recommends -y install " ++ p+	aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install " ++ p  	-- This is the same deps listed in debian/control. 	debdeps =@@ -86,7 +86,7 @@ 		]  installGitCommand :: ShellCommand-installGitCommand = "if ! git --version >/dev/null; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git; fi"+installGitCommand = "if ! git --version >/dev/null; then apt-get update && DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git; fi"  buildPropellor :: IO () buildPropellor = unlessM (actionMessage "Propellor build" build) $

@@ -12,6 +12,7 @@ import Propellor.Base import Propellor.Gpg import Propellor.Git+import Propellor.Git.VerifiedBranch import Propellor.Bootstrap import Propellor.Spin import Propellor.Types.CmdLine@@ -118,7 +119,7 @@ 	go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline 	go True cmdline = updateFirst cmdline $ go False cmdline 	go False (Spin hs mrelay) = do-		commitSpin+		unless (isJust mrelay) commitSpin 		forM_ hs $ \hn -> withhost hn $ spin mrelay hn 	go False cmdline@(SimpleRun hn) = do 		forceConsole

@@ -1,60 +1,22 @@ module Propellor.Git where -import Propellor.Base-import Propellor.PrivData.Paths-import Propellor.Gpg-import Utility.FileMode+import Utility.Process+import Utility.Exception +import System.Directory+ getCurrentBranch :: IO String-getCurrentBranch = takeWhile (/= '\n') +getCurrentBranch = takeWhile (/= '\n') 	<$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]  getCurrentBranchRef :: IO String-getCurrentBranchRef = takeWhile (/= '\n') +getCurrentBranchRef = takeWhile (/= '\n') 	<$> readProcess "git" ["symbolic-ref", "HEAD"]  getCurrentGitSha1 :: String -> IO String getCurrentGitSha1 branchref = takeWhile (/= '\n') 	<$> readProcess "git" ["show-ref", "--hash", branchref] -setRepoUrl :: String -> IO ()-setRepoUrl "" = return ()-setRepoUrl url = do-	subcmd <- ifM hasOrigin (pure "set-url", pure "add")-	void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]-	-- same as --set-upstream-to, except origin branch-	-- may not have been pulled yet-	branch <- getCurrentBranch-	let branchval s = "branch." ++ branch ++ "." ++ s-	void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]-	void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]--getGitConfigValue :: String -> IO (Maybe String)-getGitConfigValue key = do-	value <- catchMaybeIO $-		takeWhile (/= '\n')-			<$> readProcess "git" ["config", key]-	return $ case value of-		Just v | not (null v) -> Just v-		_ -> Nothing---- `git config --bool propellor.blah` outputs "false" if propellor.blah is unset--- i.e. the git convention is that the default value of any git-config setting--- is "false".  So we don't need a Maybe Bool here.-getGitConfigBool :: String -> IO Bool-getGitConfigBool key = do-	value <- catchMaybeIO $-		takeWhile (/= '\n')-			<$> readProcess "git" ["config", "--bool", key]-	return $ case value of-		Just "true" -> True-		_ -> False--getRepoUrl :: IO (Maybe String)-getRepoUrl = getM getGitConfigValue urls-  where-	urls = ["remote.deploy.url", "remote.origin.url"]- hasOrigin :: IO Bool hasOrigin = catchDefaultIO False $ do 	rs <- lines <$> readProcess "git" ["remote"]@@ -62,47 +24,3 @@  hasGitRepo :: IO Bool hasGitRepo = doesFileExist ".git/HEAD"--{- To verify origin branch commit's signature, have to convince gpg- - to use our keyring.- - While running git log. Which has no way to pass options to gpg.- - Argh!- -}-verifyOriginBranch :: String -> IO Bool-verifyOriginBranch originbranch = do-	let gpgconf = privDataDir </> "gpg.conf"-	writeFile gpgconf $ unlines-		[ " keyring " ++ keyring-		, "no-auto-check-trustdb"-		]-	-- gpg is picky about perms-	modifyFileMode privDataDir (removeModes otherGroupModes)-	s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]-		(Just [("GNUPGHOME", privDataDir)])-	nukeFile $ privDataDir </> "trustdb.gpg"-	nukeFile $ privDataDir </> "pubring.gpg"-	nukeFile $ privDataDir </> "gpg.conf"-	return (s == "U\n" || s == "G\n")---- Returns True if HEAD is changed by fetching and merging from origin.-fetchOrigin :: IO Bool-fetchOrigin = do-	branchref <- getCurrentBranch-	let originbranch = "origin" </> branchref--	void $ actionMessage "Pull from central git repository" $-		boolSystem "git" [Param "fetch"]-	-	oldsha <- getCurrentGitSha1 branchref-	-	whenM (doesFileExist keyring) $-		ifM (verifyOriginBranch originbranch)-			( do-				putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"-				hFlush stdout-				void $ boolSystem "git" [Param "merge", Param originbranch]-			, warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"-			)-	-	newsha <- getCurrentGitSha1 branchref-	return $ oldsha /= newsha

@@ -0,0 +1,47 @@+module Propellor.Git.Config where++import Propellor.Git+import Utility.Process+import Utility.Exception+import Utility.SafeCommand+import Utility.Monad++import Control.Monad++getGitConfigValue :: String -> IO (Maybe String)+getGitConfigValue key = do+	value <- catchMaybeIO $+		takeWhile (/= '\n')+			<$> readProcess "git" ["config", key]+	return $ case value of+		Just v | not (null v) -> Just v+		_ -> Nothing++-- `git config --bool propellor.blah` outputs "false" if propellor.blah is unset+-- i.e. the git convention is that the default value of any git-config setting+-- is "false".  So we don't need a Maybe Bool here.+getGitConfigBool :: String -> IO Bool+getGitConfigBool key = do+	value <- catchMaybeIO $+		takeWhile (/= '\n')+			<$> readProcess "git" ["config", "--bool", key]+	return $ case value of+		Just "true" -> True+		_ -> False++setRepoUrl :: String -> IO ()+setRepoUrl "" = return ()+setRepoUrl url = do+	subcmd <- ifM hasOrigin (pure "set-url", pure "add")+	void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]+	-- same as --set-upstream-to, except origin branch+	-- may not have been pulled yet+	branch <- getCurrentBranch+	let branchval s = "branch." ++ branch ++ "." ++ s+	void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]+	void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]++getRepoUrl :: IO (Maybe String)+getRepoUrl = getM getGitConfigValue urls+  where+	urls = ["remote.deploy.url", "remote.origin.url"]

@@ -0,0 +1,51 @@+module Propellor.Git.VerifiedBranch where++import Propellor.Base+import Propellor.Git+import Propellor.Gpg+import Propellor.PrivData.Paths+import Utility.FileMode++{- To verify origin branch commit's signature, have to convince gpg+ - to use our keyring.+ - While running git log. Which has no way to pass options to gpg.+ - Argh!+ -}+verifyOriginBranch :: String -> IO Bool+verifyOriginBranch originbranch = do+	let gpgconf = privDataDir </> "gpg.conf"+	writeFile gpgconf $ unlines+		[ " keyring " ++ keyring+		, "no-auto-check-trustdb"+		]+	-- gpg is picky about perms+	modifyFileMode privDataDir (removeModes otherGroupModes)+	s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]+		(Just [("GNUPGHOME", privDataDir)])+	nukeFile $ privDataDir </> "trustdb.gpg"+	nukeFile $ privDataDir </> "pubring.gpg"+	nukeFile $ privDataDir </> "gpg.conf"+	return (s == "U\n" || s == "G\n")++-- Returns True if HEAD is changed by fetching and merging from origin.+fetchOrigin :: IO Bool+fetchOrigin = do+	branchref <- getCurrentBranch+	let originbranch = "origin" </> branchref++	void $ actionMessage "Pull from central git repository" $+		boolSystem "git" [Param "fetch"]++	oldsha <- getCurrentGitSha1 branchref++	whenM (doesFileExist keyring) $+		ifM (verifyOriginBranch originbranch)+			( do+				putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"+				hFlush stdout+				void $ boolSystem "git" [Param "merge", Param originbranch]+			, warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"+			)++	newsha <- getCurrentGitSha1 branchref+	return $ oldsha /= newsha

@@ -13,21 +13,32 @@  import Propellor.PrivData.Paths import Propellor.Message+import Propellor.Git.Config import Utility.SafeCommand import Utility.Process import Utility.Monad import Utility.Misc import Utility.Tmp import Utility.FileSystemEncoding+import Utility.Env  type KeyId = String +getGpgBin :: IO String+getGpgBin = do+	gitGpgBin <- getGitConfigValue "gpg.program"+	case gitGpgBin of+		Nothing -> getEnvDefault "GNUPGBIN" "gpg"+		Just b -> return b+ keyring :: FilePath keyring = privDataDir </> "keyring.gpg"  -- Lists the keys in propellor's keyring. listPubKeys :: IO [KeyId]-listPubKeys = parse . lines <$> readProcess "gpg" listopts+listPubKeys = do+	gpgbin <- getGpgBin+	parse . lines <$> readProcess gpgbin listopts   where 	listopts = useKeyringOpts ++ ["--with-colons", "--list-public-keys"] 	parse = mapMaybe (keyIdField . split ":")@@ -43,23 +54,25 @@ 	]  addKey :: KeyId -> IO ()-addKey keyid = exitBool =<< allM (uncurry actionMessage)-	[ ("adding key to propellor's keyring", addkeyring)-	, ("staging propellor's keyring", gitAdd keyring)-	, ("updating encryption of any privdata", reencryptPrivData)-	, ("configuring git commit signing to use key", gitconfig)-	, ("committing changes", gitCommitKeyRing "add-key")-	]+addKey keyid = do+	gpgbin <- getGpgBin+	exitBool =<< allM (uncurry actionMessage)+		[ ("adding key to propellor's keyring", addkeyring gpgbin)+		, ("staging propellor's keyring", gitAdd keyring)+		, ("updating encryption of any privdata", reencryptPrivData)+		, ("configuring git commit signing to use key", gitconfig gpgbin)+		, ("committing changes", gitCommitKeyRing "add-key")+		]   where-	addkeyring = do+	addkeyring gpgbin' = do 		createDirectoryIfMissing True privDataDir 		boolSystem "sh" 			[ Param "-c"-			, Param $ "gpg --export " ++ keyid ++ " | gpg " +++			, Param $ gpgbin' ++ " --export " ++ keyid ++ " | gpg " ++ 				unwords (useKeyringOpts ++ ["--import"]) 			] -	gitconfig = ifM (snd <$> processTranscript "gpg" ["--list-secret-keys", keyid] Nothing)+	gitconfig gpgbin' = ifM (snd <$> processTranscript gpgbin' ["--list-secret-keys", keyid] Nothing) 		( boolSystem "git" 			[ Param "config" 			, Param "user.signingkey"@@ -71,15 +84,17 @@ 		)  rmKey :: KeyId -> IO ()-rmKey keyid = exitBool =<< allM (uncurry actionMessage)-	[ ("removing key from propellor's keyring", rmkeyring)-	, ("staging propellor's keyring", gitAdd keyring)-	, ("updating encryption of any privdata", reencryptPrivData)-	, ("configuring git commit signing to not use key", gitconfig)-	, ("committing changes", gitCommitKeyRing "rm-key")-	]+rmKey keyid = do+	gpgbin <- getGpgBin+	exitBool =<< allM (uncurry actionMessage)+		[ ("removing key from propellor's keyring", rmkeyring gpgbin)+		, ("staging propellor's keyring", gitAdd keyring)+		, ("updating encryption of any privdata", reencryptPrivData)+		, ("configuring git commit signing to not use key", gitconfig)+		, ("committing changes", gitCommitKeyRing "rm-key")+		]   where-	rmkeyring = boolSystem "gpg" $+	rmkeyring gpgbin' = boolSystem gpgbin' $ 		(map Param useKeyringOpts) ++ 		[ Param "--batch" 		, Param "--yes"@@ -137,14 +152,17 @@ 		else boolSystem "git" ps''  gpgDecrypt :: FilePath -> IO String-gpgDecrypt f = ifM (doesFileExist f)-	( writeReadProcessEnv "gpg" ["--decrypt", f] Nothing Nothing (Just fileEncoding)-	, return ""-	)+gpgDecrypt f = do+	gpgbin <- getGpgBin+	ifM (doesFileExist f)+		( writeReadProcessEnv gpgbin ["--decrypt", f] Nothing Nothing (Just fileEncoding)+		, return ""+		)  -- Encrypt file to all keys in propellor's keyring. gpgEncrypt :: FilePath -> String -> IO () gpgEncrypt f s = do+	gpgbin <- getGpgBin 	keyids <- listPubKeys 	let opts = 		[ "--default-recipient-self"@@ -152,7 +170,7 @@ 		, "--encrypt" 		, "--trust-model", "always" 		] ++ concatMap (\k -> ["--recipient", k]) keyids-	encrypted <- writeReadProcessEnv "gpg" opts Nothing (Just writer) Nothing+	encrypted <- writeReadProcessEnv gpgbin opts Nothing (Just writer) Nothing 	viaTmp writeFile f encrypted   where 	writer h = do

@@ -34,7 +34,7 @@ getOS :: Propellor (Maybe System) getOS = fromInfoVal <$> askInfo --- | Indidate that a host has an A record in the DNS.+-- | Indicate that a host has an A record in the DNS. -- -- When propellor is used to deploy a DNS server for a domain, -- the hosts in the domain are found by looking for these@@ -46,7 +46,7 @@ ipv4 :: String -> Property HasInfo ipv4 = addDNS . Address . IPv4 --- | Indidate that a host has an AAAA record in the DNS.+-- | Indicate that a host has an AAAA record in the DNS. ipv6 :: String -> Property HasInfo ipv6 = addDNS . Address . IPv6 

@@ -17,6 +17,7 @@ 		[ File.notPresent "/etc/rc.local" 		, File.notPresent "/etc/init.d/S97-setup.sh" 		, File.notPresent "/zang-debian.sh"+		, File.notPresent "/bin/npasswd" 		, User.nuked (User "user") User.YesReallyDeleteHome 		] 	]

@@ -5,7 +5,11 @@ module Propellor.Property.LightDM where  import Propellor.Base+import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.ConfFile as ConfFile++installed :: Property NoInfo+installed = Apt.installed ["lightdm"]  -- | Configures LightDM to skip the login screen and autologin as a user. autoLogin :: User -> Property NoInfo

@@ -129,6 +129,142 @@ 		Just n | n > 1 -> dedup c (M.insert k (n - 1) kc) rest 		_ -> dedup (fmt k v:c) kc rest +-- | The master config file for postfix.+masterCfFile :: FilePath+masterCfFile = "/etc/postfix/master.cf"++-- | A service that can be present in the master config file.+data Service = Service+	{ serviceType :: ServiceType+	, serviceCommand :: String+	, serviceOpts :: ServiceOpts+	}+	deriving (Show, Eq)++data ServiceType +	= InetService (Maybe HostName) ServicePort+	| UnixService FilePath PrivateService+	| FifoService FilePath PrivateService+	| PassService FilePath PrivateService+	deriving (Show, Eq)++-- Can be a port number or service name such as "smtp".+type ServicePort = String++type PrivateService = Bool++-- | Options for a service.+data ServiceOpts = ServiceOpts+	{ serviceUnprivileged :: Maybe Bool+	, serviceChroot :: Maybe Bool+	, serviceWakeupTime :: Maybe Int+	, serviceProcessLimit :: Maybe Int+	}+	deriving (Show, Eq)++defServiceOpts :: ServiceOpts+defServiceOpts = ServiceOpts+	{ serviceUnprivileged = Nothing+	, serviceChroot = Nothing+	, serviceWakeupTime = Nothing+	, serviceProcessLimit = Nothing+	}++formatServiceLine :: Service -> File.Line+formatServiceLine s = unwords $ map pad+	[ (10, case serviceType s of+		InetService (Just h) p -> h ++ ":" ++ p+		InetService Nothing p -> p+		UnixService f _ -> f+		FifoService f _ -> f+		PassService f _ -> f)+	, (6, case serviceType s of+		InetService _ _ -> "inet"+		UnixService _ _ -> "unix"+		FifoService _ _ -> "fifo"+		PassService _ _ -> "pass")+	, (8, case serviceType s of+		InetService _ _ -> bool False+		UnixService _ b -> bool b+		FifoService _ b -> bool b+		PassService _ b -> bool b)+	, (8, v bool serviceUnprivileged)+	, (8, v bool serviceChroot)+	, (8, v show serviceWakeupTime)+	, (8, v show serviceProcessLimit)+	, (0, serviceCommand s)+	]+  where+	v f sel = maybe "-" f (sel (serviceOpts s))+	bool True = "y"+	bool False = "n"+	pad (n, t) = t ++ replicate (n - 1 - length t) ' '++-- | Note that this does not handle multi-line service entries,+-- in which subsequent lines are indented. `serviceLine` does not generate+-- such entries.+parseServiceLine :: File.Line -> Maybe Service+parseServiceLine ('#':_) = Nothing+parseServiceLine (' ':_) = Nothing -- continuation of multiline entry+parseServiceLine l = Service+	<$> parsetype+	<*> parsecommand+	<*> parseopts+  where+	parsetype = do+		t <- getword 2+		case t of+			"inet" -> do+				v <- getword 1+				let (h,p) = separate (== ':') v+				if null p+					then Nothing+					else Just $ InetService+						(if null h then Nothing else Just h) p+			"unix" -> UnixService <$> getword 1 <*> parseprivate+			"fifo" -> FifoService <$> getword 1 <*> parseprivate+			"pass" -> PassService <$> getword 1 <*> parseprivate+			_ -> Nothing+	parseprivate = join . bool =<< getword 3+	+	parsecommand = case unwords (drop 7 ws) of+		"" -> Nothing+		s -> Just s++	parseopts = ServiceOpts+		<$> (bool =<< getword 4)+		<*> (bool =<< getword 5)+		<*> (int =<< getword 6)+		<*> (int =<< getword 7)++	bool "-" = Just Nothing+	bool "y" = Just (Just True)+	bool "n" = Just (Just False)+	bool _ = Nothing++	int "-" = Just Nothing+	int n = maybe Nothing (Just . Just) (readish n)++	getword n+		| nws >= n = Just (ws !! (n -1))+		| otherwise = Nothing+	ws = words l+	nws = length ws++-- | Enables a `Service` in postfix's `masterCfFile`.+service :: Service -> RevertableProperty NoInfo+service s = (enable <!> disable)+	`describe` desc+  where+	desc = "enabled postfix service " ++ show (serviceType s)+	enable = masterCfFile `File.containsLine` (formatServiceLine s)+		`onChange` reloaded+	disable = File.fileProperty desc (filter (not . matches)) masterCfFile+		`onChange` reloaded+	matches l = case parseServiceLine l of+		Just s' | s' == s -> True+		_ -> False+ -- | Installs saslauthd and configures it for postfix, authenticating -- against PAM. --

@@ -1,7 +1,7 @@ module Propellor.Property.PropellorRepo where  import Propellor.Base-import Propellor.Git+import Propellor.Git.Config  -- | Sets the url to use as the origin of propellor's git repository. --

@@ -118,6 +118,7 @@ 		& os osver 		& Apt.stdSourcesList 		& Apt.unattendedUpgrades+		& Apt.cacheCleaned 		& User.accountFor (User builduser) 		& tree arch flavor 

@@ -694,16 +694,23 @@ 		`describe` "pine configured to use local imap server" 	 	& Apt.serviceInstalledRunning "mailman"++	& Postfix.service ssmtp   where 	ctx = Context "kitenet.net" 	pinescript = "/usr/local/bin/pine" 	dovecotusers = "/etc/dovecot/users" +	ssmtp = Postfix.Service +		(Postfix.InetService Nothing "ssmtp")+		"smtpd" Postfix.defServiceOpts+ -- Configures postfix to relay outgoing mail to kitenet.net, with -- verification via tls cert. postfixClientRelay :: Context -> Property HasInfo postfixClientRelay ctx = Postfix.mainCfFile `File.containsLines`-	[ "relayhost = kitenet.net"+	-- Using smtps not smtp because more networks firewall smtp+	[ "relayhost = kitenet.net:smtps" 	, "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem" 	, "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem" 	, "smtp_tls_key_file = /etc/ssl/private/postfix.pem"

@@ -21,6 +21,7 @@ import Propellor.Protocol import Propellor.PrivData.Paths import Propellor.Git+import Propellor.Git.Config import Propellor.Ssh import Propellor.Gpg import Propellor.Bootstrap