propellor 2.15.4 → 2.16.0

raw patch · 12 files changed

+210/−65 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +21/−0
• config-joey.hs +23/−9
• debian/changelog +21/−0
• propellor.cabal +1/−1
• src/Propellor/Property.hs +1/−1
• src/Propellor/Property/Chroot.hs +1/−1
• src/Propellor/Property/Debootstrap.hs +3/−3
• src/Propellor/Property/Firewall.hs +102/−13
• src/Propellor/Property/OS.hs +3/−3
• src/Propellor/Property/Obnam.hs +16/−10
• src/Propellor/Property/Ssh.hs +17/−23
• src/Propellor/Types/OS.hs +1/−1

@@ -1,3 +1,24 @@+propellor (2.16.0) unstable; urgency=medium++  * Obnam: Only let one backup job run at a time when a host has multiple+    different backup properties, to avoid concurrent jobs fighting over+    scarce resources (particularly memory). Other jobs block on a lock+    file.+  * Removed references to a Debian derivative from code and documentation+    because of an unfortunate trademark use policy.+    http://joeyh.name/blog/entry/trademark_nonsense/+  * That included changing a data constructor to "Buntish", an API change.+  * Firewall.rule: Now takes a Table parameter. (API change)+  * Firewall: add InIFace/OutIFace Rules, add Source/Destination Rules,+    add CustomTarget, and more improvements.+    Thanks, Félix Sipma.+  * Ssh.authorizedKey: Fix bug preventing it from working when the+    authorized_keys file does not yet exist.+  * Removed Ssh.unauthorizedKey and made Ssh.authorizedKey revertable.+    (API change)++ -- Joey Hess <id@joeyh.name>  Sat, 27 Feb 2016 13:31:57 -0400+ propellor (2.15.4) unstable; urgency=medium    * Build /usr/src/propellor/propellor.git reproducibly,

@@ -261,23 +261,32 @@ 	& Ssh.passwordAuthentication True 	-- Since ssh password authentication is allowed: 	& Fail2Ban.installed+	& Apt.serviceInstalledRunning "ntp"+	& "/etc/timezone" `File.hasContent` ["US/Eastern"]+ 	& Obnam.backupEncrypted "/" (Cron.Times "33 1 * * *")-		[ "--repository=sftp://2318@usw-s002.rsync.net/~/kite.obnam"+		[ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-root.obnam" 		, "--client-name=kitenet.net"+		, "--exclude=/home" 		, "--exclude=/var/cache" 		, "--exclude=/var/tmp"-		, "--exclude=/home/joey/lib"+		, "--exclude=/srv/git"+		, "--exclude=/var/spool/oldusenet" 		, "--exclude=.*/tmp/" 		, "--one-file-system" 		, Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6] 		] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")-		`requires` Ssh.userKeys (User "root")-			(Context "kite.kitenet.net")-			[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")-			]+		`requires` rootsshkey 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")-	& Apt.serviceInstalledRunning "ntp"-	& "/etc/timezone" `File.hasContent` ["US/Eastern"]+	& Obnam.backupEncrypted "/home" (Cron.Times "33 3 * * *")+		[ "--repository=sftp://2318@usw-s002.rsync.net/~/kite-home.obnam"+		, "--client-name=kitenet.net"+		, "--exclude=/home/joey/lib"+		, "--one-file-system"+		, Obnam.keepParam [Obnam.KeepDays 7, Obnam.KeepWeeks 4, Obnam.KeepMonths 6]+		] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")+		`requires` rootsshkey+		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")  	& alias "smtp.kitenet.net" 	& alias "imap.kitenet.net"@@ -337,6 +346,11 @@ 	& Apache.httpsVirtualHost "letsencrypt.joeyh.name" "/var/www/html" 		(LetsEncrypt.AgreeTOS (Just "id@joeyh.name")) 	& alias "letsencrypt.joeyh.name"+  where+	rootsshkey = Ssh.userKeys (User "root")+		(Context "kite.kitenet.net")+		[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")+		]  elephant :: Host elephant = standardSystem "elephant.kitenet.net" Unstable "amd64"@@ -583,7 +597,7 @@ monsters :: [Host]    -- Systems I don't manage with propellor, monsters =            -- but do want to track their public keys etc. 	[ host "usw-s002.rsync.net"-		& Ssh.hostPubKey SshEd25519 "ssh-ed25519 SHA256:DBW4gxagH9Q3Avnus+dxaoOS5L/Q/tZlT42bcoMp+4Y"+		& Ssh.hostPubKey SshEd25519 "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB7yTEBGfQYdwG/oeL+U9XPMIh/dW7XNs9T+M79YIOrd" 	, host "github.com"  		& Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ==" 	, host "gitlab.com"

@@ -1,3 +1,24 @@+propellor (2.16.0) unstable; urgency=medium++  * Obnam: Only let one backup job run at a time when a host has multiple+    different backup properties, to avoid concurrent jobs fighting over+    scarce resources (particularly memory). Other jobs block on a lock+    file.+  * Removed references to a Debian derivative from code and documentation+    because of an unfortunate trademark use policy.+    http://joeyh.name/blog/entry/trademark_nonsense/+  * That included changing a data constructor to "Buntish", an API change.+  * Firewall.rule: Now takes a Table parameter. (API change)+  * Firewall: add InIFace/OutIFace Rules, add Source/Destination Rules,+    add CustomTarget, and more improvements.+    Thanks, Félix Sipma.+  * Ssh.authorizedKey: Fix bug preventing it from working when the+    authorized_keys file does not yet exist.+  * Removed Ssh.unauthorizedKey and made Ssh.authorizedKey revertable.+    (API change)++ -- Joey Hess <id@joeyh.name>  Sat, 27 Feb 2016 13:31:57 -0400+ propellor (2.15.4) unstable; urgency=medium    * Build /usr/src/propellor/propellor.git reproducibly,

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

@@ -255,7 +255,7 @@ -- -- > myproperty = withOS "foo installed" $ \o -> case o of -- > 	(Just (System (Debian suite) arch)) -> ...--- > 	(Just (System (Ubuntu release) arch)) -> ...+-- > 	(Just (System (Buntish release) arch)) -> ... -- >	Nothing -> ... withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo withOS desc a = property desc $ a =<< getOS

@@ -90,7 +90,7 @@ instance ChrootBootstrapper Debootstrapped where 	buildchroot (Debootstrapped cf) system loc = case system of 		(Just s@(System (Debian _) _)) -> Right $ debootstrap s-		(Just s@(System (Ubuntu _) _)) -> Right $ debootstrap s+		(Just s@(System (Buntish _) _)) -> Right $ debootstrap s 		Nothing -> Left "Cannot debootstrap; `os` property not specified" 	  where 		debootstrap s = Debootstrap.built loc s cf

@@ -91,7 +91,7 @@ 	 extractSuite :: System -> Maybe String extractSuite (System (Debian s) _) = Just $ Apt.showSuite s-extractSuite (System (Ubuntu r) _) = Just r+extractSuite (System (Buntish r) _) = Just r  -- | Ensures debootstrap is installed. --@@ -108,12 +108,12 @@ 			)  	installon (Just (System (Debian _) _)) = aptinstall-	installon (Just (System (Ubuntu _) _)) = aptinstall+	installon (Just (System (Buntish _) _)) = aptinstall 	installon _ = sourceInstall  	remove = withOS "debootstrap removed" $ ensureProperty . removefrom 	removefrom (Just (System (Debian _) _)) = aptremove-	removefrom (Just (System (Ubuntu _) _)) = aptremove+	removefrom (Just (System (Buntish _) _)) = aptremove 	removefrom _ = sourceRemove 			 	aptinstall = Apt.installed ["debootstrap"]

@@ -1,15 +1,22 @@ -- | Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com>--- +-- -- Properties for configuring firewall (iptables) rules  module Propellor.Property.Firewall ( 	rule, 	installed, 	Chain(..),-	Target(..),+	Table(..),+	TargetFilter(..),+	TargetNat(..),+	TargetMangle(..),+	TargetRaw(..),+	TargetSecurity(..), 	Proto(..), 	Rules(..),-	ConnectionState(..)+	ConnectionState(..),+	IPWithMask(..),+	fromIPWithMask ) where  import Data.Monoid@@ -23,7 +30,7 @@ installed :: Property NoInfo installed = Apt.installed ["iptables"] -rule :: Chain -> Target -> Rules -> Property NoInfo+rule :: Chain -> Table -> Rules -> Property NoInfo rule c t rs = property ("firewall rule: " <> show r) addIpTable   where 	r = Rule c t rs@@ -33,13 +40,13 @@ 		if exist 			then return NoChange 			else toResult <$> boolSystem "iptables" (add args)-	add params = (Param "-A") : params-	chk params = (Param "-C") : params+	add params = Param "-A" : params+	chk params = Param "-C" : params  toIpTable :: Rule -> [CommandParam] toIpTable r =  map Param $-	(show $ ruleChain r) :-	(toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ]+	show (ruleChain r) :+	toIpTableArg (ruleRules r) ++ toIpTableTable (ruleTable r)  toIpTableArg :: Rules -> [String] toIpTableArg Everything = []@@ -47,26 +54,105 @@ toIpTableArg (DPort (Port port)) = ["--dport", show port] toIpTableArg (DPortRange (Port f, Port t)) = 	["--dport", show f ++ ":" ++ show t]-toIpTableArg (IFace iface) = ["-i", iface]+toIpTableArg (InIFace iface) = ["-i", iface]+toIpTableArg (OutIFace iface) = ["-o", iface] toIpTableArg (Ctstate states) = 	[ "-m" 	, "conntrack"-	, "--ctstate", concat $ intersperse "," (map show states)+	, "--ctstate", intercalate "," (map show states) 	]+toIpTableArg (Source ipwm) =+	[ "-s"+	, intercalate "," (map fromIPWithMask ipwm)+	]+toIpTableArg (Destination ipwm) =+	[ "-d"+	, intercalate "," (map fromIPWithMask ipwm)+	] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' +data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int+	deriving (Eq, Show)++fromIPWithMask :: IPWithMask -> String+fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip+fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm+fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m+ data Rule = Rule 	{ ruleChain :: Chain-	, ruleTarget :: Target+	, ruleTable :: Table 	, ruleRules :: Rules 	} deriving (Eq, Show) +data Table = Filter TargetFilter | Nat TargetNat | Mangle TargetMangle | Raw TargetRaw | Security TargetSecurity+	deriving (Eq, Show)++toIpTableTable :: Table -> [String]+toIpTableTable f = ["-t", table, "-j", target]+  where+	(table, target) = toIpTableTable' f++toIpTableTable' :: Table -> (String, String)+toIpTableTable' (Filter target) = ("filter", fromTarget target)+toIpTableTable' (Nat target) = ("nat", fromTarget target)+toIpTableTable' (Mangle target) = ("mangle", fromTarget target)+toIpTableTable' (Raw target) = ("raw", fromTarget target)+toIpTableTable' (Security target) = ("security", fromTarget target)+ data Chain = INPUT | OUTPUT | FORWARD 	deriving (Eq, Show) -data Target = ACCEPT | REJECT | DROP | LOG+data TargetFilter = ACCEPT | REJECT | DROP | LOG | FilterCustom String 	deriving (Eq, Show) +class FromTarget a where+	fromTarget :: a -> String++instance FromTarget TargetFilter where+	fromTarget ACCEPT = "ACCEPT"+	fromTarget REJECT = "REJECT"+	fromTarget DROP = "DROP"+	fromTarget LOG = "LOG"+	fromTarget (FilterCustom f) = f++data TargetNat = NatPREROUTING | NatOUTPUT | NatPOSTROUTING | NatCustom String+	deriving (Eq, Show)++instance FromTarget TargetNat where+	fromTarget NatPREROUTING = "PREROUTING"+	fromTarget NatOUTPUT = "OUTPUT"+	fromTarget NatPOSTROUTING = "POSTROUTING"+	fromTarget (NatCustom f) = f++data TargetMangle = ManglePREROUTING | MangleOUTPUT | MangleINPUT | MangleFORWARD | ManglePOSTROUTING | MangleCustom String+	deriving (Eq, Show)++instance FromTarget TargetMangle where+	fromTarget ManglePREROUTING = "PREROUTING"+	fromTarget MangleOUTPUT = "OUTPUT"+	fromTarget MangleINPUT = "INPUT"+	fromTarget MangleFORWARD = "FORWARD"+	fromTarget ManglePOSTROUTING = "POSTROUTING"+	fromTarget (MangleCustom f) = f++data TargetRaw = RawPREROUTING | RawOUTPUT | RawCustom String+	deriving (Eq, Show)++instance FromTarget TargetRaw where+	fromTarget RawPREROUTING = "PREROUTING"+	fromTarget RawOUTPUT = "OUTPUT"+	fromTarget (RawCustom f) = f++data TargetSecurity = SecurityINPUT | SecurityOUTPUT | SecurityFORWARD | SecurityCustom String+	deriving (Eq, Show)++instance FromTarget TargetSecurity where+	fromTarget SecurityINPUT = "INPUT"+	fromTarget SecurityOUTPUT = "OUTPUT"+	fromTarget SecurityFORWARD = "FORWARD"+	fromTarget (SecurityCustom f) = f+ data Proto = TCP | UDP | ICMP 	deriving (Eq, Show) @@ -80,8 +166,11 @@ 	-- data type with proto + ports 	| DPort Port 	| DPortRange (Port,Port)-	| IFace Network.Interface+	| InIFace Network.Interface+	| OutIFace Network.Interface 	| Ctstate [ ConnectionState ]+	| Source [ IPWithMask ]+	| Destination [ IPWithMask ] 	| Rules :- Rules   -- ^Combine two rules 	deriving (Eq, Show) 

@@ -85,8 +85,8 @@  	osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of 		(Just d@(System (Debian _) _)) -> debootstrap d-		(Just u@(System (Ubuntu _) _)) -> debootstrap u-		_ -> error "os is not declared to be Debian or Ubuntu"+		(Just u@(System (Buntish _) _)) -> debootstrap u+		_ -> error "os is not declared to be Debian or *buntu" 	 	debootstrap targetos = ensureProperty $ 		-- Ignore the os setting, and install debootstrap from@@ -221,7 +221,7 @@ preserveRootSshAuthorized = check (fileExist oldloc) $ 	property (newloc ++ " copied from old OS") $ do 		ks <- liftIO $ lines <$> readFile oldloc-		ensureProperties (map (Ssh.authorizedKey (User "root")) ks)+		ensureProperties (map (setupRevertableProperty . Ssh.authorizedKey (User "root")) ks)   where 	newloc = "/root/.ssh/authorized_keys" 	oldloc = oldOSDir ++ newloc

@@ -36,6 +36,10 @@ -- -- Note that this property does not make obnam encrypt the backup -- repository.+--+-- Since obnam uses a fair amount of system resources, only one obnam+-- backup job will be run at a time. Other jobs will wait their turns to+-- run. backup :: FilePath -> Cron.Times -> [ObnamParam] -> NumClients -> Property NoInfo backup dir crontimes params numclients = 	backup' dir crontimes params numclients@@ -59,16 +63,18 @@   where 	desc = dir ++ " backed up by obnam" 	cronjob = Cron.niceJob ("obnam_backup" ++ dir) crontimes (User "root") "/" $-		unwords $ catMaybes-			[ if numclients == OnlyClient-				-- forcelock fails if repo does not exist yet-				then Just $ forcelockcmd ++ " 2>/dev/null ;"-				else Nothing-			, Just backupcmd-			, if any isKeepParam params-				then Just $ "&& " ++ forgetcmd-				else Nothing-			]+		"flock " ++ shellEscape lockfile ++ " sh -c " ++ shellEscape cmdline+	lockfile = "/var/lock/propellor-obnam.lock"+	cmdline = unwords $ catMaybes+		[ if numclients == OnlyClient+			-- forcelock fails if repo does not exist yet+			then Just $ forcelockcmd ++ " 2>/dev/null ;"+			else Nothing+		, Just backupcmd+		, if any isKeepParam params+			then Just $ "&& " ++ forgetcmd+			else Nothing+		] 	forcelockcmd = unwords $ 		[ "obnam" 		, "force-lock"

@@ -30,7 +30,6 @@ 	unauthorizedKeysFrom, 	authorizedKeys, 	authorizedKey,-	unauthorizedKey, 	hasAuthorizedKeys, 	getUserPubKeys, ) where@@ -372,7 +371,7 @@  	go [] = return NoChange 	go ls = ensureProperty $ combineProperties desc $-		map (unauthorizedKey localuser) ls+		map (revert . authorizedKey localuser) ls 	 authorizedKeyLines :: User -> Host -> Propellor [File.Line] authorizedKeyLines remoteuser remotehost = @@ -395,28 +394,23 @@  -- | Ensures that a user's authorized_keys contains a line. -- Any other lines in the file are preserved as-is.-authorizedKey :: User -> String -> Property NoInfo-authorizedKey user@(User u) l = property desc $ do-	f <- liftIO $ dotFile "authorized_keys" user-	modAuthorizedKey f user $-		f `File.containsLine` l-			`requires` File.dirExists (takeDirectory f)-  where-	desc = u ++ " has authorized_keys"---- | Reverts `authorizedKey`-unauthorizedKey :: User -> String -> Property NoInfo-unauthorizedKey user@(User u) l = property desc $ do-	f <- liftIO $ dotFile "authorized_keys" user-	ifM (liftIO $ doesFileExist f) -		( modAuthorizedKey f user $ f `File.lacksLine` l-		, return NoChange-		)+authorizedKey :: User -> String -> RevertableProperty NoInfo+authorizedKey user@(User u) l = add <!> remove   where-	desc = u ++ " lacks authorized_keys"+	add = property (u ++ " has authorized_keys") $ do+		f <- liftIO $ dotFile "authorized_keys" user+		modAuthorizedKey f user $+			f `File.containsLine` l+				`requires` File.dirExists (takeDirectory f)+	remove = property (u ++ " lacks authorized_keys") $ do+		f <- liftIO $ dotFile "authorized_keys" user+		ifM (liftIO $ doesFileExist f) +			( modAuthorizedKey f user $ f `File.lacksLine` l+			, return NoChange+			)  modAuthorizedKey :: FilePath -> User -> Property NoInfo -> Propellor Result modAuthorizedKey f user p = ensureProperty $ p-	`requires` File.mode f (combineModes [ownerWriteMode, ownerReadMode])-	`requires` File.ownerGroup f user (userGroup user)-	`requires` File.ownerGroup (takeDirectory f) user (userGroup user)+	`before` File.mode f (combineModes [ownerWriteMode, ownerReadMode])+	`before` File.ownerGroup f user (userGroup user)+	`before` File.ownerGroup (takeDirectory f) user (userGroup user)

@@ -24,7 +24,7 @@  data Distribution 	= Debian DebianSuite-	| Ubuntu Release+	| Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>) 	deriving (Show, Eq)  -- | Debian has several rolling suites, and a number of stable releases,