propellor 2.6.0 → 2.7.0

raw patch · 10 files changed

+112/−19 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +16/−0
• config-joey.hs +1/−1
• debian/changelog +16/−0
• propellor.cabal +1/−1
• src/Propellor/Property.hs +35/−0
• src/Propellor/Property/SiteSpecific/JoeySites.hs +2/−2
• src/Propellor/Property/Ssh.hs +30/−10
• src/Propellor/Property/Systemd.hs +2/−1
• src/Propellor/Shim.hs +3/−2
• src/Propellor/Spin.hs +6/−2

@@ -1,3 +1,19 @@+propellor (2.7.0) unstable; urgency=medium++  * Ssh.permitRootLogin type changed to allow configuring WithoutPassword+    and ForcedCommandsOnly (API change)+  * setSshdConfig type changed, and setSshdConfigBool added with old type.+  * Fix a bug in shim generation code for docker and chroots, that+    sometimes prevented deployment of docker containers.+  * Added onChangeFlagOnFail which is often a safer alternative to+    onChange.+    Thanks, Antoine Eiche.+  * Work around broken git pull option parser in git 2.5.0,+    which broke use of --upload-pack to send a git push when running+    propellor --spin.++ -- Joey Hess <id@joeyh.name>  Thu, 30 Jul 2015 12:05:46 -0400+ propellor (2.6.0) unstable; urgency=medium    * Replace String type synonym Docker.Image by a data type

@@ -441,7 +441,7 @@ 	& Docker.publish "8001:80" 	& Apt.installed ["ssh"] 	& User.hasSomePassword (User "root")-	& Ssh.permitRootLogin True+	& Ssh.permitRootLogin (Ssh.RootLogin True)  kiteShellBox :: Systemd.Container kiteShellBox = standardStableContainer "kiteshellbox"

@@ -1,3 +1,19 @@+propellor (2.7.0) unstable; urgency=medium++  * Ssh.permitRootLogin type changed to allow configuring WithoutPassword+    and ForcedCommandsOnly (API change)+  * setSshdConfig type changed, and setSshdConfigBool added with old type.+  * Fix a bug in shim generation code for docker and chroots, that+    sometimes prevented deployment of docker containers.+  * Added onChangeFlagOnFail which is often a safer alternative to+    onChange.+    Thanks, Antoine Eiche.+  * Work around broken git pull option parser in git 2.5.0,+    which broke use of --upload-pack to send a git push when running+    propellor --spin.++ -- Joey Hess <id@joeyh.name>  Thu, 30 Jul 2015 12:05:46 -0400+ propellor (2.6.0) unstable; urgency=medium    * Replace String type synonym Docker.Image by a data type

@@ -1,5 +1,5 @@ Name: propellor-Version: 2.6.0+Version: 2.7.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>

@@ -54,6 +54,41 @@ 			return $ r <> r' 		_ -> return r +-- | Same as `onChange` except that if property y fails, a flag file+-- is generated. On next run, if the flag file is present, property y+-- is executed even if property x doesn't change.+--+-- With `onChange`, if y fails, the property x `onChange` y returns+-- `FailedChange`. But if this property is applied again, it returns+-- `NoChange`. This behavior can cause trouble...+onChangeFlagOnFail+	:: (Combines (Property x) (Property y))+	=> FilePath+        -> Property x+        -> Property y+        -> CombinedType (Property x) (Property y)+onChangeFlagOnFail flagfile p1 p2 =+	combineWith go p1 p2+  where+	go s1 s2 = do+		r1 <- s1+		case r1 of+			MadeChange -> flagFailed s2+			_ -> ifM (liftIO $ doesFileExist flagfile)+				(flagFailed s2+				, return r1+				)+	flagFailed s = do+		r <- s+		liftIO $ case r of+			FailedChange -> createFlagFile+			_ -> removeFlagFile+		return r+	createFlagFile = unlessM (doesFileExist flagfile) $ do+		createDirectoryIfMissing True (takeDirectory flagfile)+		writeFile flagfile ""+	removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile+ -- | Alias for @flip describe@ (==>) :: IsProp (Property i) => Desc -> Property i -> Property i (==>) = flip describe

@@ -387,7 +387,7 @@ -- Work around for expired ssl cert. pumpRss :: Property NoInfo pumpRss = Cron.job "pump rss" (Cron.Times "15 * * * *") (User "joey") "/srv/web/tmp.kitenet.net/"-	"wget https://pump2rss.com/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom"+	"wget https://rss.io.jpope.org/feed/joeyh@identi.ca.atom -O pump.atom.new --no-check-certificate 2>/dev/null; sed 's/ & / /g' pump.atom.new > pump.atom"  ircBouncer :: Property HasInfo ircBouncer = propertyList "IRC bouncer" $ props@@ -405,7 +405,7 @@  kiteShellBox :: Property NoInfo kiteShellBox = propertyList "kitenet.net shellinabox"-	[ Apt.installed ["openssl", "shellinabox"]+	[ Apt.installed ["openssl", "shellinabox", "openssh-client"] 	, File.hasContent "/etc/default/shellinabox" 		[ "# Deployed by propellor" 		, "SHELLINABOX_DAEMON_START=1"

@@ -1,7 +1,10 @@ module Propellor.Property.Ssh ( 	PubKeyText, 	sshdConfig,+	ConfigKeyword,+	setSshdConfigBool, 	setSshdConfig,+	RootLogin(..), 	permitRootLogin, 	passwordAuthentication, 	noPasswords,@@ -28,6 +31,7 @@  import System.PosixCompat import qualified Data.Map as M+import Data.List  type PubKeyText = String @@ -38,21 +42,37 @@ sshdConfig :: FilePath sshdConfig = "/etc/ssh/sshd_config" -setSshdConfig :: String -> Bool -> Property NoInfo-setSshdConfig setting allowed = combineProperties "sshd config"-	[ sshdConfig `File.lacksLine` (sshline $ not allowed)-	, sshdConfig `File.containsLine` (sshline allowed)-	]+type ConfigKeyword = String++setSshdConfigBool :: ConfigKeyword -> Bool -> Property NoInfo+setSshdConfigBool setting allowed = setSshdConfig setting (sshBool allowed)++setSshdConfig :: ConfigKeyword -> String -> Property NoInfo+setSshdConfig setting val = File.fileProperty desc f sshdConfig 	`onChange` restarted-	`describe` unwords [ "ssh config:", setting, sshBool allowed ]   where-	sshline v = setting ++ " " ++ sshBool v+	desc = unwords [ "ssh config:", setting, val ]+	cfgline = setting ++ " " ++ val+	wantedline s+		| s == cfgline = True+		| (setting ++ " ") `isPrefixOf` s = False+		| otherwise = True+	f ls +		| cfgline `elem` ls = filter wantedline ls+		| otherwise = filter wantedline ls ++ [cfgline] -permitRootLogin :: Bool -> Property NoInfo-permitRootLogin = setSshdConfig "PermitRootLogin"+data RootLogin+	= RootLogin Bool  -- ^ allow or prevent root login+	| WithoutPassword -- ^ disable password authentication for root, while allowing other authentication methods+	| ForcedCommandsOnly -- ^ allow root login with public-key authentication, but only if a forced command has been specified for the public key +permitRootLogin :: RootLogin -> Property NoInfo+permitRootLogin (RootLogin b) = setSshdConfigBool "PermitRootLogin" b+permitRootLogin WithoutPassword = setSshdConfig "PermitRootLogin" "without-password"+permitRootLogin ForcedCommandsOnly = setSshdConfig "PermitRootLogin" "forced-commands-only"+ passwordAuthentication :: Bool -> Property NoInfo-passwordAuthentication = setSshdConfig "PasswordAuthentication"+passwordAuthentication = setSshdConfigBool "PasswordAuthentication"  -- | Configure ssh to not allow password logins. --

@@ -134,7 +134,8 @@ -- Does not ensure that the relevant daemon notices the change immediately. -- -- This assumes that there is only one [Header] per file, which is--- currently the case. And it assumes the file already exists with+-- currently the case for files like journald.conf and system.conf. +-- And it assumes the file already exists with -- the right [Header], so new lines can just be appended to the end. configured :: FilePath -> Option -> String -> Property NoInfo configured cfgfile option value = combineProperties desc

@@ -20,7 +20,7 @@ -- Propellor may be running from an existing shim, in which case it's -- simply reused. setup :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath-setup propellorbin propellorbinpath dest = checkAlreadyShimmed propellorbin $ do+setup propellorbin propellorbinpath dest = checkAlreadyShimmed shim $ do 	createDirectoryIfMissing True dest  	libs <- parseLdd <$> readProcess "ldd" [propellorbin]@@ -39,7 +39,6 @@ 		fromMaybe (error "cannot find gconv directory") $ 			headMaybe $ filter ("/gconv/" `isInfixOf`) glibclibs 	let linkerparams = ["--library-path", intercalate ":" libdirs ]-	let shim = file propellorbin dest 	writeFile shim $ unlines 		[ shebang 		, "GCONV_PATH=" ++ shellEscape gconvdir@@ -49,6 +48,8 @@ 		] 	modifyFileMode shim (addModes executeModes) 	return shim+  where+	shim = file propellorbin dest  shebang :: String shebang = "#!/bin/sh"

@@ -147,11 +147,15 @@ 			hout <- dup stdOutput 			hClose stdin 			hClose stdout+			-- Not using git pull because git 2.5.0 badly+			-- broke its option parser. 			unlessM (boolSystem "git" (pullparams hin hout)) $-				errorMessage "git pull from client failed"+				errorMessage "git fetch from client failed"+			unlessM (boolSystem "git" [Param "merge", Param "FETCH_HEAD"]) $+				errorMessage "git merge from client failed"   where 	pullparams hin hout =-		[ Param "pull"+		[ Param "fetch" 		, Param "--progress" 		, Param "--upload-pack" 		, Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout