propellor 2.8.0 → 2.8.1

raw patch · 22 files changed

+256/−26 lines, 22 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +16/−0
• config-joey.hs +1/−1
• debian/changelog +16/−0
• propellor.cabal +3/−1
• src/Propellor/Bootstrap.hs +17/−2
• src/Propellor/Gpg.hs +9/−6
• src/Propellor/PrivData.hs +8/−0
• src/Propellor/PropAccum.hs +9/−3
• src/Propellor/Property/Aiccu.hs +3/−1
• src/Propellor/Property/Chroot.hs +1/−1
• src/Propellor/Property/DebianMirror.hs +2/−0
• src/Propellor/Property/Docker.hs +4/−3
• src/Propellor/Property/Firewall.hs +4/−4
• src/Propellor/Property/Kerberos.hs +94/−0
• src/Propellor/Property/LightDM.hs +2/−0
• src/Propellor/Property/Logcheck.hs +36/−0
• src/Propellor/Property/Nginx.hs +2/−0
• src/Propellor/Property/Prosody.hs +2/−0
• src/Propellor/Property/SiteSpecific/IABak.hs +4/−0
• src/Propellor/Property/Unbound.hs +11/−1
• src/Propellor/Types/Info.hs +11/−2
• src/Propellor/Types/PrivData.hs +1/−1

@@ -1,3 +1,19 @@+propellor (2.8.1) unstable; urgency=medium++  * Guard against power loss etc when building propellor, by updating+    the executable atomically.+  * Added Logcheck module, contributed by Jelmer Vernooij.+  * Added Kerberos module, contributed by Jelmer Vernooij.+  * Privdata that uses HostContext inside a container will now have the+    name of the container as its context, rather than the name of+    the host(s) where the container is used. This allows eg, having different+    passwords for a user in different containers. Note that previously,+    propellor would prompt using the container name as the context, but+    not actually use privdata using that context; so this is a bug fix.+  * Fix --add-key to not fail committing when no privdata file exists yet.++ -- Joey Hess <id@joeyh.name>  Sun, 04 Oct 2015 13:54:59 -0400+ propellor (2.8.0) unstable; urgency=medium    * Added Propellor.Property.Rsync.

@@ -455,7 +455,7 @@ 	& Docker.publish "2202:22" 	& Docker.publish "8001:80" 	& Apt.installed ["ssh"]-	& User.hasSomePassword (User "root")+	& User.hasPassword (User "root") 	& Ssh.permitRootLogin (Ssh.RootLogin True)  kiteShellBox :: Systemd.Container

@@ -1,3 +1,19 @@+propellor (2.8.1) unstable; urgency=medium++  * Guard against power loss etc when building propellor, by updating+    the executable atomically.+  * Added Logcheck module, contributed by Jelmer Vernooij.+  * Added Kerberos module, contributed by Jelmer Vernooij.+  * Privdata that uses HostContext inside a container will now have the+    name of the container as its context, rather than the name of+    the host(s) where the container is used. This allows eg, having different+    passwords for a user in different containers. Note that previously,+    propellor would prompt using the container name as the context, but+    not actually use privdata using that context; so this is a bug fix.+  * Fix --add-key to not fail committing when no privdata file exists yet.++ -- Joey Hess <id@joeyh.name>  Sun, 04 Oct 2015 13:54:59 -0400+ propellor (2.8.0) unstable; urgency=medium    * Added Propellor.Property.Rsync.

@@ -1,5 +1,5 @@ Name: propellor-Version: 2.8.0+Version: 2.8.1 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -91,6 +91,7 @@     Propellor.Property.Group     Propellor.Property.Grub     Propellor.Property.Journald+    Propellor.Property.Kerberos     Propellor.Property.Mount     Propellor.Property.Network     Propellor.Property.Nginx@@ -105,6 +106,7 @@     Propellor.Property.Rsync     Propellor.Property.List     Propellor.Property.LightDM+    Propellor.Property.Logcheck     Propellor.Property.Scheduled     Propellor.Property.Service     Propellor.Property.Ssh

@@ -104,9 +104,24 @@ 		void $ cabal ["configure"] 		unlessM (cabal ["build"]) $ 			error "cabal build failed"-	nukeFile "propellor"-	createSymbolicLink "dist/build/propellor-config/propellor-config" "propellor"+	-- For safety against eg power loss in the middle of the build,+	-- make a copy of the binary, and move it into place atomically.+	-- This ensures that the propellor symlink only ever points at+	-- a binary that is fully built. Also, avoid ever removing+	-- or breaking the symlink.+	--+	-- Need cp -a to make build timestamp checking work.+	unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $+		error "cp of binary failed"+	rename (tmpfor safetycopy) safetycopy+	createSymbolicLink safetycopy (tmpfor dest)+	rename (tmpfor dest) dest 	return True+  where+	dest = "propellor"+	cabalbuiltbin = "dist/build/propellor-config/propellor-config"+	safetycopy = cabalbuiltbin ++ ".built"+	tmpfor f = f ++ ".propellortmp"  make :: FilePath -> [FilePath] -> IO Bool -> IO () make dest srcs builder = do

@@ -6,6 +6,7 @@ import System.Directory import Data.Maybe import Data.List.Utils+import Control.Monad  import Propellor.PrivData.Paths import Propellor.Message@@ -106,12 +107,14 @@ 	]  gitCommitKeyRing :: String -> IO Bool-gitCommitKeyRing action = gitCommit-	[ File keyring-	, File privDataFile-	, Param "-m"-	, Param ("propellor " ++ action)-	]+gitCommitKeyRing action = do+	-- Commit explicitly the keyring and privdata files, as other+	-- changes may be staged by the user and shouldn't be committed.+	tocommit <- filterM doesFileExist [ privDataFile, keyring]+	gitCommit $ (map File tocommit) ++ +		[ Param "-m"+		, Param ("propellor " ++ action)+		]  -- Adds --gpg-sign if there's a keyring. gpgSignParams :: [CommandParam] -> IO [CommandParam]

@@ -17,6 +17,7 @@ 	decryptPrivData, 	PrivMap, 	PrivInfo,+	forceHostContext, ) where  import Control.Applicative@@ -236,3 +237,10 @@ -- hosts need it. instance IsInfo PrivInfo where 	propigateInfo _ = True++-- | Sets the context of any privdata that uses HostContext to the+-- provided name.+forceHostContext :: String -> PrivInfo -> PrivInfo+forceHostContext name i = PrivInfo $ S.map go (fromPrivInfo i)+  where+	go (f, d, HostContext ctx) = (f, d, HostContext (const $ ctx name)) 

@@ -14,6 +14,7 @@ import Propellor.Types import Propellor.Property import Propellor.Types.Info+import Propellor.PrivData  -- | Starts accumulating the properties of a Host. --@@ -72,12 +73,16 @@ --  -- The Info of the propertyChildren is adjusted to only include  -- info that should be propigated out to the Property.+--+-- Any PrivInfo that uses HostContext is adjusted to use the name+-- of the container as its context. propigateContainer 	:: (PropAccum container)-	=> container+	=> String+	-> container 	-> Property HasInfo 	-> Property HasInfo-propigateContainer c prop = infoProperty+propigateContainer containername c prop = infoProperty 	(propertyDesc prop) 	(propertySatisfy prop) 	(propertyInfo prop)@@ -85,6 +90,7 @@   where 	hostprops = map go $ getProperties c 	go p = -		let i = propigatableInfo (propertyInfo p)+		let i = mapInfo (forceHostContext containername)+			(propigatableInfo (propertyInfo p)) 		    cs = map go (propertyChildren p) 		in infoProperty (propertyDesc p) (propertySatisfy p) i cs

@@ -1,3 +1,5 @@+-- | Maintainer: Jelmer Vernooij <jelmer@samba.org>+ module Propellor.Property.Aiccu ( 	installed, 	restarted,@@ -46,5 +48,5 @@ 		property "aiccu configured" . writeConfig 	writeConfig :: (((PrivDataField, PrivData) -> Propellor Result) -> Propellor Result) -> Propellor Result 	writeConfig getpassword = getpassword $ ensureProperty . go-	go (Password _, p) = confPath `File.hasContentProtected` config u t p+	go (Password u', p) = confPath `File.hasContentProtected` config u' t p 	go (f, _) = error $ "Unexpected type of privdata: " ++ show f

@@ -83,7 +83,7 @@ 	teardown = toProp (revert built)  propigateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo-propigateChrootInfo c p = propigateContainer c p'+propigateChrootInfo c@(Chroot location _ _ _) p = propigateContainer location c p'   where 	p' = infoProperty 		(propertyDesc p)

@@ -1,3 +1,5 @@+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>+ module Propellor.Property.DebianMirror 	( DebianPriority(..) 	, showPriority

@@ -19,7 +19,7 @@ 	Image(..), 	latestImage, 	ContainerName,-	Container,+	Container(..), 	HasImage(..), 	-- * Container configuration 	dns,@@ -171,7 +171,7 @@ 	image = getImageName ctr  propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo-propigateContainerInfo ctr@(Container _ h) p = propigateContainer ctr p'+propigateContainerInfo ctr@(Container _ h) p = propigateContainer cn ctr p'   where 	p' = infoProperty 		(propertyDesc p)@@ -179,7 +179,8 @@ 		(propertyInfo p <> dockerinfo) 		(propertyChildren p) 	dockerinfo = dockerInfo $-		mempty { _dockerContainers = M.singleton (hostName h) h }+		mempty { _dockerContainers = M.singleton cn h }+	cn = hostName h  mkContainerInfo :: ContainerId -> Container -> ContainerInfo mkContainerInfo cid@(ContainerId hn _cn) (Container img h) = 

@@ -1,7 +1,7 @@--- |Properties for configuring firewall (iptables) rules------ Copyright 2014 Arnaud Bailly <arnaud.oqube@gmail.com>--- License: BSD-2-Clause+-- | Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com>+-- +-- Properties for configuring firewall (iptables) rules+ module Propellor.Property.Firewall ( 	rule, 	installed,

@@ -0,0 +1,94 @@+-- | Maintainer: Jelmer Vernooij <jelmer@samba.org>++module Propellor.Property.Kerberos where++import Utility.Process++import Propellor+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.File as File+import Propellor.Property.User++type Realm = String+type Principal = String+type Kvno = Integer++-- Standard paths in MIT Kerberos++defaultKeyTab :: FilePath+defaultKeyTab = "/etc/krb5.keytab"++kadmAclPath :: FilePath+kadmAclPath = "/etc/krb5kdc/kadm5.acl"++kpropdAclPath :: FilePath+kpropdAclPath = "/etc/krb5kdc/kpropd.acl"++kdcConfPath :: FilePath+kdcConfPath = "/etc/krb5kdc/kdc.conf"++keyTabPath :: Maybe FilePath -> FilePath+keyTabPath = maybe defaultKeyTab id++-- | Create a principal from a primary, instance and realm+principal :: String -> Maybe String -> Maybe Realm -> Principal+principal p i r = p ++ maybe "" ("/"++) i ++ maybe "" ("@" ++) r++installed :: Property NoInfo+installed = Apt.installed ["krb5-user"]++kdcInstalled :: Property NoInfo+kdcInstalled = Apt.serviceInstalledRunning "krb5-kdc"++adminServerInstalled :: Property NoInfo+adminServerInstalled = Apt.serviceInstalledRunning "krb5-admin-server"++kpropServerInstalled :: Property HasInfo+kpropServerInstalled = propertyList "kprop server installed" $ props+	& kdcInstalled+	& Apt.installed ["openbsd-inetd"]+	& "/etc/inetd.conf" `File.containsLines`+	[ "krb5_prop\tstream\ttcp\tnowait\troot\t/usr/sbin/kpropd kpropd"+	, "krb5_prop\tstream\ttcp6\tnowait\troot\t/usr/sbin/kpropd kpropd"+	]++kpropAcls :: [String] -> Property NoInfo+kpropAcls ps = kpropdAclPath `File.hasContent` ps `describe` "kprop server ACLs"++k5srvutil :: (Maybe FilePath) -> [String] -> IO String+k5srvutil kt cmd = readProcess "k5srvutil" (maybe [] (\x -> ["-f", x]) kt ++ cmd)++-- Keytab management+keytabEntries :: Maybe FilePath -> IO [(Kvno, Principal)]+keytabEntries p = do+	c <- k5srvutil p ["list"]+	return $ map parseLine (drop 3 $ lines c)+  where+	parseLine l = (Prelude.read x, y) where (x, y) = splitAt 5 l++checkKeyTabEntry' :: Maybe FilePath -> (Kvno, Principal) -> IO Bool+checkKeyTabEntry' path entry = do+	entries <- keytabEntries path+	return $ entry `elem` entries++checkKeyTabEntry :: Maybe FilePath -> Principal -> IO Bool+checkKeyTabEntry path princ = do+	entries <- keytabEntries path+	return $ princ `elem` (map snd entries)++-- k5login files+k5loginPath :: User -> IO FilePath+k5loginPath user = do+	h <- homedir user+	return $ h </> ".k5login"++k5login :: User -> [Principal] -> Property NoInfo+k5login user@(User u) ps = property (u ++ " has k5login") $ do+	f <- liftIO $ k5loginPath user+	liftIO $ do+		createDirectoryIfMissing True (takeDirectory f)+		writeFile f (unlines ps)+	ensureProperties+		[ File.ownerGroup f user (userGroup user)+		, File.ownerGroup (takeDirectory f) user (userGroup user)+		]

@@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} +-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>+ module Propellor.Property.LightDM where  import Propellor

@@ -0,0 +1,36 @@+-- | Maintainer: Jelmer Vernooij <jelmer@jelmer.uk>++module Propellor.Property.Logcheck (+	ReportLevel (Workstation, Server, Paranoid),+	Service,+	defaultPrefix,+	ignoreFilePath,+	ignoreLines,+	installed,+) where++import Propellor+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.File as File++data ReportLevel = Workstation | Server | Paranoid+type Service = String++instance Show ReportLevel where+	show Workstation = "workstation"+	show Server = "server"+	show Paranoid = "paranoid"++-- The common prefix used by default in syslog lines.+defaultPrefix :: String+defaultPrefix = "^\\w{3} [ :[:digit:]]{11} [._[:alnum:]-]+ "++ignoreFilePath :: ReportLevel -> Service -> FilePath+ignoreFilePath t n = "/etc/logcheck/ignore.d." ++ (show t) </> n++ignoreLines :: ReportLevel -> Service -> [String] -> Property NoInfo+ignoreLines t n ls = (ignoreFilePath t n) `File.containsLines` ls+	`describe` ("logcheck ignore lines for " ++ n ++ "(" ++ (show t) ++ ")")++installed :: Property NoInfo+installed = Apt.installed ["logcheck"]

@@ -1,3 +1,5 @@+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>+ module Propellor.Property.Nginx where  import Propellor

@@ -1,3 +1,5 @@+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>+ module Propellor.Property.Prosody where  import Propellor

@@ -37,6 +37,10 @@ 	& Cron.niceJob "shardmaint" Cron.Daily (User "root") "/" 		"/usr/local/IA.BAK/shardmaint-fast; /usr/local/IA.BAK/shardmaint" 	& Apt.installed ["git-annex"]+	& Apt.installed ["libmail-sendmail-perl"]+	& Cron.niceJob "expireemailer" Cron.Daily (User "root") +		"/usr/local/IA.BAK"+		"./expireemailer"  registrationServer :: [Host] -> Property HasInfo registrationServer knownhosts = propertyList "iabak registration server" $ props

@@ -1,9 +1,19 @@--- | Properties for the Unbound caching DNS server+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>+--+-- Properties for the Unbound caching DNS server  module Propellor.Property.Unbound 	( installed 	, restarted 	, reloaded+	, UnboundSection+	, UnboundZone+	, UnboundHost+	, UnboundSetting+	, UnboundValue+	, UnboundKey+	, ConfSection+	, ZoneType 	, cachingDnsServer 	) where 

@@ -5,6 +5,7 @@ 	IsInfo(..), 	addInfo, 	getInfo,+	mapInfo, 	propigatableInfo, 	InfoVal(..), 	fromInfoVal,@@ -16,8 +17,6 @@ import Data.Maybe  -- | Information about a Host, which can be provided by its properties.------ Any value in the `IsInfo` type class can be added to an Info. data Info = Info [(Dynamic, Bool)]  instance Show Info where@@ -37,11 +36,21 @@ 	-- container to its Host? 	propigateInfo :: v -> Bool +-- | Any value in the `IsInfo` type class can be added to an Info. addInfo :: IsInfo v => Info -> v -> Info addInfo (Info l) v = Info ((toDyn v, propigateInfo v):l)  getInfo :: IsInfo v => Info -> v getInfo (Info l) = mconcat (mapMaybe (fromDynamic . fst) (reverse l))++-- | Maps a function over all values stored in the Info that are of the+-- appropriate type.+mapInfo :: IsInfo v => (v -> v) -> Info -> Info+mapInfo f (Info l) = Info (map go l)+  where+	go (i, p) = case fromDynamic i of+		Nothing -> (i, p)+		Just v -> (toDyn (f v), p)  -- | Filters out parts of the Info that should not propigate out of a -- container.

@@ -61,7 +61,7 @@ newtype Context = Context String 	deriving (Read, Show, Ord, Eq) --- | A context that varies depending on the HostName where it's used.+-- | A context that may vary depending on the HostName where it's used. newtype HostContext = HostContext { mkHostContext :: HostName -> Context }  instance Show HostContext where