propellor 0.3.1 → 0.4.0

raw patch · 31 files changed

+894/−226 lines, 31 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +15/−0
• Propellor/Attr.hs +54/−14
• Propellor/Engine.hs +1/−1
• Propellor/Property.hs +50/−35
• Propellor/Property/Apt.hs +43/−9
• Propellor/Property/Cmd.hs +2/−1
• Propellor/Property/Cron.hs +6/−4
• Propellor/Property/Dns.hs +349/−41
• Propellor/Property/Docker.hs +25/−28
• Propellor/Property/File.hs +6/−6
• Propellor/Property/Git.hs +1/−1
• Propellor/Property/Gpg.hs +1/−1
• Propellor/Property/Hostname.hs +1/−1
• Propellor/Property/Obnam.hs +63/−4
• Propellor/Property/Postfix.hs +1/−1
• Propellor/Property/Scheduled.hs +3/−3
• Propellor/Property/Service.hs +3/−3
• Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +1/−1
• Propellor/Property/SiteSpecific/GitHome.hs +3/−3
• Propellor/Property/SiteSpecific/JoeySites.hs +60/−4
• Propellor/Property/Ssh.hs +8/−8
• Propellor/Property/Sudo.hs +1/−1
• Propellor/Property/User.hs +1/−1
• Propellor/Types.hs +20/−22
• Propellor/Types/Attr.hs +10/−6
• Propellor/Types/Dns.hs +81/−0
• Propellor/Types/OS.hs +1/−0
• TODO +9/−4
• config-joey.hs +58/−22
• debian/changelog +15/−0
• propellor.cabal +2/−1

@@ -1,3 +1,18 @@+propellor (0.4.0) unstable; urgency=medium++  * Propellor can configure primary DNS servers, including generating+    zone files, which is done by looking at the properties of hosts+    in a domain.+  * The `cname` property was renamed to `alias` as it does not always+    generate CNAME in the DNS.+  * Constructor of Property has changed (use `property` function instead).+  * All Property combinators now combine together their Attr settings.+    So Attr settings can be made inside a propertyList, for example.+  * Run all cron jobs under chronic from moreutils to avoid unnecessary+    mails.++ -- Joey Hess <joeyh@debian.org>  Sat, 19 Apr 2014 02:09:56 -0400+ propellor (0.3.1) unstable; urgency=medium    * Merge scheduler bug fix from git-annex.

@@ -8,38 +8,65 @@ import "mtl" Control.Monad.Reader import qualified Data.Set as S import qualified Data.Map as M+import Data.Maybe import Control.Applicative -pureAttrProperty :: Desc -> (Attr -> Attr) -> AttrProperty -pureAttrProperty desc = AttrProperty $ Property ("has " ++ desc)-	(return NoChange)+pureAttrProperty :: Desc -> SetAttr -> Property +pureAttrProperty desc = Property ("has " ++ desc) (return NoChange) -hostname :: HostName -> AttrProperty+hostname :: HostName -> Property hostname name = pureAttrProperty ("hostname " ++ name) $ 	\d -> d { _hostname = name }  getHostName :: Propellor HostName getHostName = asks _hostname -os :: System -> AttrProperty+os :: System -> Property os system = pureAttrProperty ("Operating " ++ show system) $ 	\d -> d { _os = Just system }  getOS :: Propellor (Maybe System) getOS = asks _os -cname :: Domain -> AttrProperty-cname domain = pureAttrProperty ("cname " ++ domain) (addCName domain)+-- | Indidate that a host has an A record in the DNS.+--+-- TODO check at run time if the host really has this address.+-- (Can't change the host's address, but as a sanity check.)+ipv4 :: String -> Property+ipv4 addr = pureAttrProperty ("ipv4 " ++ addr)+	(addDNS $ Address $ IPv4 addr) -cnameFor :: IsProp p => Domain -> (Domain -> p) -> AttrProperty-cnameFor domain mkp =-	let p = mkp domain-	in AttrProperty p (addCName domain)+-- | Indidate that a host has an AAAA record in the DNS.+ipv6 :: String -> Property+ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)+	(addDNS $ Address $ IPv6 addr) -addCName :: HostName -> Attr -> Attr-addCName domain d = d { _cnames = S.insert domain (_cnames d) }+-- | Indicates another name for the host in the DNS.+alias :: Domain -> Property+alias domain = pureAttrProperty ("aka " ++ domain)+	(addDNS $ CNAME $ AbsDomain domain) -sshPubKey :: String -> AttrProperty+addDNS :: Record -> SetAttr+addDNS record d = d { _dns = S.insert record (_dns d) }++-- | Adds a DNS NamedConf stanza.+--+-- Note that adding a Master stanza for a domain always overrides an+-- existing Secondary stanza, while a Secondary stanza is only added+-- when there is no existing Master stanza.+addNamedConf :: NamedConf -> SetAttr+addNamedConf conf d = d { _namedconf = new }+  where+	m = _namedconf d+	domain = confDomain conf+	new = case (confType conf, confType <$> M.lookup domain m) of+		(Secondary, Just Master) -> m+		_  -> M.insert domain conf m++getNamedConf :: Propellor (M.Map Domain NamedConf)+getNamedConf = asks _namedconf++sshPubKey :: String -> Property sshPubKey k = pureAttrProperty ("ssh pubkey known") $ 	\d -> d { _sshPubKey = Just k } @@ -58,8 +85,21 @@ hostMap :: [Host] -> M.Map HostName Host hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l  +hostAttrMap :: [Host] -> M.Map HostName Attr+hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs+  where+	attrs = map hostAttr l+ findHost :: [Host] -> HostName -> Maybe Host findHost l hn = M.lookup hn (hostMap l)++getAddresses :: Attr -> [IPAddr]+getAddresses = mapMaybe getIPAddr . S.toList . _dns++hostAddresses :: HostName -> [Host] -> [IPAddr]+hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of+	Nothing -> []+	Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr  -- | Lifts an action into a different host. --

@@ -18,7 +18,7 @@ mainProperties :: Attr -> [Property] -> IO () mainProperties attr ps = do 	r <- runPropellor attr $-		ensureProperties [Property "overall" $ ensureProperties ps]+		ensureProperties [Property "overall" (ensureProperties ps) id] 	setTitle "propellor: done" 	hFlush stdout 	case r of

@@ -5,6 +5,7 @@ import System.Directory import Control.Monad import Data.Monoid+import Data.List import Control.Monad.IfElse import "mtl" Control.Monad.Reader @@ -15,23 +16,21 @@ import Utility.Monad import System.FilePath -makeChange :: IO () -> Propellor Result-makeChange a = liftIO a >> return MadeChange--noChange :: Propellor Result-noChange = return NoChange+-- Constructs a Property.+property :: Desc -> Propellor Result -> Property+property d s = Property d s id  -- | Combines a list of properties, resulting in a single property -- that when run will run each property in the list in turn, -- and print out the description of each as it's run. Does not stop -- on failure; does propigate overall success/failure. propertyList :: Desc -> [Property] -> Property-propertyList desc ps = Property desc $ ensureProperties ps+propertyList desc ps = Property desc (ensureProperties ps) (combineSetAttrs ps)  -- | Combines a list of properties, resulting in one property that -- ensures each in turn, stopping on failure. combineProperties :: Desc -> [Property] -> Property-combineProperties desc ps = Property desc $ go ps NoChange+combineProperties desc ps = Property desc (go ps NoChange) (combineSetAttrs ps)   where   	go [] rs = return rs 	go (l:ls) rs = do@@ -44,26 +43,23 @@ -- that ensures the first, and if the first succeeds, ensures the second. -- The property uses the description of the first property. before :: Property -> Property -> Property-p1 `before` p2 = Property (propertyDesc p1) $ do-	r <- ensureProperty p1-	case r of-		FailedChange -> return FailedChange-		_ -> ensureProperty p2+p1 `before` p2 = p2 `requires` p1+	`describe` (propertyDesc p1)  -- | Makes a perhaps non-idempotent Property be idempotent by using a flag -- file to indicate whether it has run before. -- Use with caution. flagFile :: Property -> FilePath -> Property-flagFile property = flagFile' property . return+flagFile p = flagFile' p . return  flagFile' :: Property -> IO FilePath -> Property-flagFile' property getflagfile = Property (propertyDesc property) $ do+flagFile' p getflagfile = adjustProperty p $ \satisfy -> do 	flagfile <- liftIO getflagfile-	go flagfile =<< liftIO (doesFileExist flagfile)+	go satisfy flagfile =<< liftIO (doesFileExist flagfile)   where-	go _ True = return NoChange-	go flagfile False = do-		r <- ensureProperty property+	go _ _ True = return NoChange+	go satisfy flagfile False = do+		r <- satisfy 		when (r == MadeChange) $ liftIO $  			unlessM (doesFileExist flagfile) $ do 				createDirectoryIfMissing True (takeDirectory flagfile)@@ -73,22 +69,24 @@ --- | Whenever a change has to be made for a Property, causes a hook -- Property to also be run, but not otherwise. onChange :: Property -> Property -> Property-property `onChange` hook = Property (propertyDesc property) $ do-	r <- ensureProperty property-	case r of-		MadeChange -> do-			r' <- ensureProperty hook-			return $ r <> r'-		_ -> return r+p `onChange` hook = Property (propertyDesc p) satisfy (combineSetAttr p hook)+  where+	satisfy = do+		r <- ensureProperty p+		case r of+			MadeChange -> do+				r' <- ensureProperty hook+				return $ r <> r'+			_ -> return r  (==>) :: Desc -> Property -> Property (==>) = flip describe infixl 1 ==> --- | Makes a Property only be performed when a test succeeds.+-- | Makes a Property only need to do anything when a test succeeds. check :: IO Bool -> Property -> Property-check c property = Property (propertyDesc property) $ ifM (liftIO c)-	( ensureProperty property+check c p = adjustProperty p $ \satisfy -> ifM (liftIO c)+	( satisfy 	, return NoChange 	) @@ -99,8 +97,8 @@ -- to be made as it is to just idempotently assure the property is -- satisfied. For example, chmodding a file. trivial :: Property -> Property-trivial p = Property (propertyDesc p) $ do-	r <- ensureProperty p+trivial p = adjustProperty p $ \satisfy -> do+	r <- satisfy 	if r == MadeChange 		then return NoChange 		else return r@@ -110,10 +108,10 @@ -- -- Note that the operating system may not be declared for some hosts. withOS :: Desc -> (Maybe System -> Propellor Result) -> Property-withOS desc a = Property desc $ a =<< getOS+withOS desc a = property desc $ a =<< getOS  boolProperty :: Desc -> IO Bool -> Property-boolProperty desc a = Property desc $ ifM (liftIO a)+boolProperty desc a = property desc $ ifM (liftIO a) 	( return MadeChange 	, return FailedChange 	)@@ -133,16 +131,33 @@  -- | Adds a property to a Host ----- Can add Properties, RevertableProperties, and AttrProperties+-- Can add Properties and RevertableProperties (&) :: IsProp p => Host -> p -> Host-(Host ps as) & p = Host (ps ++ [toProp p]) (getAttr p . as)+(Host ps as) & p = Host (ps ++ [toProp p]) (setAttr p . as)  infixl 1 &  -- | Adds a property to the Host in reverted form. (!) :: Host -> RevertableProperty -> Host-(Host ps as) ! p = Host (ps ++ [toProp q]) (getAttr q . as)+(Host ps as) ! p = Host (ps ++ [toProp q]) (setAttr q . as)   where 	q = revert p  infixl 1 !++-- Changes the action that is performed to satisfy a property. +adjustProperty :: Property -> (Propellor Result -> Propellor Result) -> Property+adjustProperty p f = p { propertySatisfy = f (propertySatisfy p) }++-- Combines the Attr settings of two properties.+combineSetAttr :: (IsProp p, IsProp q) => p -> q -> SetAttr+combineSetAttr p q = setAttr p . setAttr q++combineSetAttrs :: IsProp p => [p] -> SetAttr+combineSetAttrs = foldl' (.) id . map setAttr++makeChange :: IO () -> Propellor Result+makeChange a = liftIO a >> return MadeChange++noChange :: Propellor Result+noChange = return NoChange

@@ -17,6 +17,8 @@ type Url = String type Section = String +type SourcesGenerator = DebianSuite -> [Line]+ showSuite :: DebianSuite -> String showSuite Stable = "stable" showSuite Testing = "testing"@@ -39,7 +41,7 @@ stdSections :: [Section] stdSections = ["main", "contrib", "non-free"] -binandsrc :: String -> DebianSuite -> [Line]+binandsrc :: String -> SourcesGenerator binandsrc url suite 	| isStable suite = [l, srcLine l, bl, srcLine bl] 	| otherwise = [l, srcLine l]@@ -47,14 +49,14 @@ 	l = debLine (showSuite suite) url stdSections 	bl = debLine backportSuite url stdSections -debCdn :: DebianSuite -> [Line]+debCdn :: SourcesGenerator debCdn = binandsrc "http://cdn.debian.net/debian" -kernelOrg :: DebianSuite -> [Line]+kernelOrg :: SourcesGenerator kernelOrg = binandsrc "http://mirrors.kernel.org/debian"  -- | Only available for Stable and Testing-securityUpdates :: DebianSuite -> [Line]+securityUpdates :: SourcesGenerator securityUpdates suite 	| isStable suite || suite == Testing = 		let l = "deb http://security.debian.org/ " ++ showSuite suite ++ "/updates " ++ unwords stdSections@@ -67,13 +69,27 @@ -- Since the CDN is sometimes unreliable, also adds backup lines using -- kernel.org. stdSourcesList :: DebianSuite -> Property-stdSourcesList suite = setSourcesList-	(concatMap (\gen -> gen suite) [debCdn, kernelOrg, securityUpdates])+stdSourcesList suite = stdSourcesList' suite []++-- | Adds additional sources.list generators.+--+-- Note that if a Property needs to enable an apt source, it's better+-- to do so via a separate file in /etc/apt/sources.list.d/+stdSourcesList' :: DebianSuite -> [SourcesGenerator] -> Property+stdSourcesList' suite more = setSourcesList+	(concatMap (\gen -> gen suite) generators) 	`describe` ("standard sources.list for " ++ show suite)+  where+	generators = [debCdn, kernelOrg, securityUpdates] ++ more  setSourcesList :: [Line] -> Property setSourcesList ls = sourcesList `File.hasContent` ls `onChange` update +setSourcesListD :: [Line] -> FilePath -> Property+setSourcesListD ls basename = f `File.hasContent` ls `onChange` update+  where+	f = "/etc/apt/sources.list.d/" ++ basename ++ ".list"+ runApt :: [String] -> Property runApt ps = cmdProperty' "apt-get" ps noninteractiveEnv @@ -141,8 +157,8 @@ -- | Package installation may fail becuse the archive has changed. -- Run an update in that case and retry. robustly :: Property -> Property-robustly p = Property (propertyDesc p) $ do-	r <- ensureProperty p+robustly p = adjustProperty p $ \satisfy -> do+	r <- satisfy 	if r == FailedChange 		then ensureProperty $ p `requires` update 		else return r@@ -194,7 +210,7 @@ reConfigure package vals = reconfigure `requires` setselections 	`describe` ("reconfigure " ++ package)   where-	setselections = Property "preseed" $ makeChange $+	setselections = property "preseed" $ makeChange $ 		withHandle StdinHandle createProcessSuccess 			(proc "debconf-set-selections" []) $ \h -> do 				forM_ vals $ \(tmpl, tmpltype, value) ->@@ -208,3 +224,21 @@ -- package names. serviceInstalledRunning :: Package -> Property serviceInstalledRunning svc = Service.running svc `requires` installed [svc]++data AptKey = AptKey+	{ keyname :: String+	, pubkey :: String+	}++trustsKey :: AptKey -> RevertableProperty+trustsKey k = RevertableProperty trust untrust+  where+	desc = "apt trusts key " ++ keyname k+	f = "/etc/apt/trusted.gpg.d" </> keyname k ++ ".gpg"+	untrust = File.notPresent f+	trust = check (not <$> doesFileExist f) $ property desc $ makeChange $ do+		withHandle StdinHandle createProcessSuccess+			(proc "gpg" ["--no-default-keyring", "--keyring", f, "--import", "-"]) $ \h -> do+				hPutStr h (pubkey k)+				hClose h+		nukeFile $ f ++ "~" -- gpg dropping

@@ -12,6 +12,7 @@ import "mtl" Control.Monad.Reader  import Propellor.Types+import Propellor.Property import Utility.Monad import Utility.SafeCommand import Utility.Env@@ -25,7 +26,7 @@ -- | A property that can be satisfied by running a command, -- with added environment. cmdProperty' :: String -> [String] -> [(String, String)] -> Property-cmdProperty' cmd params env = Property desc $ liftIO $ do+cmdProperty' cmd params env = property desc $ liftIO $ do 	env' <- addEntries env <$> getEnvironment 	ifM (boolSystemEnv cmd (map Param params) (Just env')) 		( return MadeChange

@@ -16,6 +16,8 @@ -- Only one instance of the cron job is allowed to run at a time, no matter -- how long it runs. This is accomplished using flock locking of the cron -- job file.+--+-- The cron job's output will only be emailed if it exits nonzero. job :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property job desc times user cddir command = cronjobfile `File.hasContent` 	[ "# Generated by propellor"@@ -24,13 +26,14 @@ 	, "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin" 	, "" 	, times ++ "\t" ++ user ++ "\t"-		++ "flock -n " ++ shellEscape cronjobfile+		++ "chronic flock -n " ++ shellEscape cronjobfile 		++ " sh -c " ++ shellEscape cmdline 	] 	`requires` Apt.serviceInstalledRunning "cron"+	`requires` Apt.installed ["util-linux", "moreutils"] 	`describe` ("cronned " ++ desc)   where-	cmdline = "cd " ++ cddir ++ " && " ++ command+	cmdline = "cd " ++ cddir ++ " && ( " ++ command ++ " )" 	cronjobfile = "/etc/cron.d/" ++ map sanitize desc 	sanitize c 		| isAlphaNum c = c@@ -40,8 +43,7 @@ niceJob :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property niceJob desc times user cddir command = job desc times user cddir 	("nice ionice -c 3 " ++ command)-	`requires` Apt.installed ["util-linux", "moreutils"]  -- | Installs a cron job to run propellor. runPropellor :: CronTimes -> Property-runPropellor times = niceJob "propellor" times "root" localdir "chronic make"+runPropellor times = niceJob "propellor" times "root" localdir "make"

@@ -1,49 +1,128 @@-module Propellor.Property.Dns where+module Propellor.Property.Dns (+	module Propellor.Types.Dns,+	primary,+	secondary,+	secondaryFor,+	mkSOA,+	rootAddressesFrom,+	writeZoneFile,+	nextSerialNumber,+	adjustSerialNumber,+	serialNumberOffset,+	genZone,+) where  import Propellor+import Propellor.Types.Dns import Propellor.Property.File+import Propellor.Types.Attr import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service--namedconf :: FilePath-namedconf = "/etc/bind/named.conf.local"--data Zone = Zone-	{ zdomain :: Domain-	, ztype :: Type-	, zfile :: FilePath-	, zmasters :: [IPAddr]-	, zconfiglines :: [String]-	}+import Utility.Applicative -zoneDesc :: Zone -> String-zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"+import qualified Data.Map as M+import qualified Data.Set as S+import Data.List -type IPAddr = String+-- | Primary dns server for a domain.+--+-- Most of the content of the zone file is configured by setting properties+-- of hosts. For example,+--+-- > host "foo.example.com"+-- >   & ipv4 "192.168.1.1"+-- >   & alias "mail.exmaple.com"+--+-- Will cause that hostmame and its alias to appear in the zone file,+-- with the configured IP address.+--+-- The [(Domain, Record)] list can be used for additional records+-- that cannot be configured elsewhere. For example, it might contain+-- CNAMEs pointing at hosts that propellor does not control.+primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property+primary hosts domain soa rs = withwarnings (check needupdate baseprop)+	`requires` servingZones+	`onChange` Service.reloaded "bind9"+  where+	(partialzone, warnings) = genZone hosts domain soa+	zone = partialzone { zHosts = zHosts partialzone ++ rs }+	zonefile = "/etc/bind/propellor/db." ++ domain+	baseprop = Property ("dns primary for " ++ domain)+		(makeChange $ writeZoneFile zone zonefile)+		(addNamedConf conf)+	withwarnings p = adjustProperty p $ \satisfy -> do+		mapM_ warningMessage warnings+		satisfy+	conf = NamedConf+		{ confDomain = domain+		, confType = Master+		, confFile = zonefile+		, confMasters = []+		, confLines = []+		}+	needupdate = do+		v <- readZonePropellorFile zonefile+		return $ case v of+			Nothing -> True+			Just oldzone ->+				-- compare everything except serial+				let oldserial = sSerial (zSOA oldzone)+				    z = zone { zSOA = (zSOA zone) { sSerial = oldserial } }+				in z /= oldzone || oldserial < sSerial (zSOA zone) -type Domain = String+-- | Secondary dns server for a domain.+--+-- The primary server is determined by looking at the properties of other+-- hosts to find which one is configured as the primary.+--+-- Note that if a host is declared to be a primary and a secondary dns+-- server for the same domain, the primary server config always wins.+secondary :: [Host] -> Domain -> Property+secondary hosts domain = secondaryFor masters hosts domain+  where+	masters = M.keys $ M.filter ismaster $ hostAttrMap hosts+	ismaster attr = case M.lookup domain (_namedconf attr) of+		Nothing -> False+		Just conf -> confType conf == Master && confDomain conf == domain -data Type = Master | Secondary-	deriving (Show, Eq)+-- | This variant is useful if the primary server does not have its DNS+-- configured via propellor.+secondaryFor :: [HostName] -> [Host] -> Domain -> Property+secondaryFor masters hosts domain = pureAttrProperty desc (addNamedConf conf)+	`requires` servingZones+  where+ 	desc = "dns secondary for " ++ domain+	conf = NamedConf+		{ confDomain = domain+		, confType = Secondary+		, confFile = "db." ++ domain+		, confMasters = concatMap (\m -> hostAddresses m hosts) masters+		, confLines = ["allow-transfer { }"]+		} -secondary :: Domain -> [IPAddr] -> Zone-secondary domain masters = Zone-	{ zdomain = domain-	, ztype = Secondary-	, zfile = "db." ++ domain-	, zmasters = masters-	, zconfiglines = ["allow-transfer { }"]-	}+-- | Rewrites the whole named.conf.local file to serve the zones+-- configured by `primary` and `secondary`, and ensures that bind9 is+-- running.+servingZones :: Property+servingZones = property "serving configured dns zones" go+	`requires` Apt.serviceInstalledRunning "bind9"+	`onChange` Service.reloaded "bind9"+  where+	go = do+		zs <- getNamedConf+		ensureProperty $+			hasContent namedConfFile $+				concatMap confStanza $ M.elems zs -zoneStanza :: Zone -> [Line]-zoneStanza z =+confStanza :: NamedConf -> [Line]+confStanza c = 	[ "// automatically generated by propellor"-	, "zone \"" ++ zdomain z ++ "\" {"-	, cfgline "type" (if ztype z == Master then "master" else "slave")-	, cfgline "file" ("\"" ++ zfile z ++ "\"")+	, "zone \"" ++ confDomain c ++ "\" {"+	, cfgline "type" (if confType c == Master then "master" else "slave")+	, cfgline "file" ("\"" ++ confFile c ++ "\"") 	] ++-	(if null (zmasters z) then [] else mastersblock) ++-	(map (\l -> "\t" ++ l ++ ";") (zconfiglines z)) +++	(if null (confMasters c) then [] else mastersblock) +++	(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++ 	[ "};" 	, "" 	]@@ -51,13 +130,242 @@ 	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";" 	mastersblock = 		[ "\tmasters {" ] ++-		(map (\ip -> "\t\t" ++ ip ++ ";") (zmasters z)) +++		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++ 		[ "\t};" ] --- | Rewrites the whole named.conf.local file to serve the specificed--- zones.-zones :: [Zone] -> Property-zones zs = hasContent namedconf (concatMap zoneStanza zs)-	`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))-	`requires` Apt.serviceInstalledRunning "bind9"-	`onChange` Service.reloaded "bind9"+namedConfFile :: FilePath+namedConfFile = "/etc/bind/named.conf.local"++-- | Generates a SOA with some fairly sane numbers in it.+--+-- The Domain is the domain to use in the SOA record. Typically+-- something like ns1.example.com. So, not the domain that this is the SOA+-- record for.+--+-- The SerialNumber can be whatever serial number was used by the domain+-- before propellor started managing it. Or 0 if the domain has only ever+-- been managed by propellor.+--+-- You do not need to increment the SerialNumber when making changes!+-- Propellor will automatically add the number of commits in the git+-- repository to the SerialNumber.+--+-- Handy trick: You don't need to list IPAddrs in the [Record],+-- just make some Host sets its `alias` to the root of domain.+mkSOA :: Domain -> SerialNumber -> [Record] -> SOA+mkSOA d sn rs = SOA+	{ sDomain = AbsDomain d+	, sSerial = sn+	, sRefresh = hours 4+	, sRetry = hours 1+	, sExpire = 2419200 -- 4 weeks+	, sNegativeCacheTTL = hours 8+	, sRecord = rs+	}+  where+	hours n = n * 60 * 60++rootAddressesFrom :: [Host] -> HostName -> [Record]+rootAddressesFrom hosts hn = map Address (hostAddresses hn hosts)++dValue :: BindDomain -> String+dValue (RelDomain d) = d+dValue (AbsDomain d) = d ++ "."+dValue (SOADomain) = "@"++rField :: Record -> String+rField (Address (IPv4 _)) = "A"+rField (Address (IPv6 _)) = "AAAA"+rField (CNAME _) = "CNAME"+rField (MX _ _) = "MX"+rField (NS _) = "NS"+rField (TXT _) = "TXT"+rField (SRV _ _ _ _) = "SRV"++rValue :: Record -> String+rValue (Address (IPv4 addr)) = addr+rValue (Address (IPv6 addr)) = addr+rValue (CNAME d) = dValue d+rValue (MX pri d) = show pri ++ " " ++ dValue d+rValue (NS d) = dValue d+rValue (SRV priority weight port target) = unwords+	[ show priority+	, show weight+	, show port+	, dValue target+	]+rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]+  where+	q = '"'++-- | Adjusts the serial number of the zone to +--+-- * Always be larger than the serial number in the Zone record.+-- * Always be larger than the passed SerialNumber+nextSerialNumber :: Zone -> SerialNumber -> Zone+nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial++adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone+adjustSerialNumber (Zone d soa l) f = Zone d soa' l+  where+	soa' = soa { sSerial = f (sSerial soa) }++-- | Count the number of git commits made to the current branch.+serialNumberOffset :: IO SerialNumber+serialNumberOffset = fromIntegral . length . lines+	<$> readProcess "git" ["log", "--pretty=%H"]++-- | Write a Zone out to a to a file.+--+-- The serial number in the Zone automatically has the serialNumberOffset+-- added to it. Also, just in case, the old serial number used in the zone+-- file is checked, and if it is somehow larger, its succ is used.+writeZoneFile :: Zone -> FilePath -> IO ()+writeZoneFile z f = do+	oldserial <- oldZoneFileSerialNumber f+	offset <- serialNumberOffset+	let z' = nextSerialNumber+		(adjustSerialNumber z (+ offset))+		oldserial+	createDirectoryIfMissing True (takeDirectory f)+	writeFile f (genZoneFile z')+	writeZonePropellorFile f z'++-- | Next to the zone file, is a ".propellor" file, which contains+-- the serialized Zone. This saves the bother of parsing+-- the horrible bind zone file format.+zonePropellorFile :: FilePath -> FilePath+zonePropellorFile f = f ++ ".propellor"++oldZoneFileSerialNumber :: FilePath -> IO SerialNumber+oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile++writeZonePropellorFile :: FilePath -> Zone -> IO ()+writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)++readZonePropellorFile :: FilePath -> IO (Maybe Zone)+readZonePropellorFile f = catchDefaultIO Nothing $+	readish <$> readFileStrict (zonePropellorFile f)++-- | Generating a zone file.+genZoneFile :: Zone -> String+genZoneFile (Zone zdomain soa rs) = unlines $+	header : genSOA zdomain soa ++ map genr rs+  where+	header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."++	genr (d, r) = genRecord zdomain (Just d, r)++genRecord :: Domain -> (Maybe BindDomain, Record) -> String+genRecord zdomain (mdomain, record) = intercalate "\t"+	[ hn+	, "IN"+	, rField record+	, rValue record+	]+  where+	hn = maybe "" (domainHost zdomain) mdomain++genSOA :: Domain -> SOA -> [String]+genSOA zdomain soa =+	header ++ map (genRecord zdomain) (zip (repeat Nothing) (sRecord soa))+  where+	header =+		-- "@ IN SOA ns1.example.com. root ("+		[ intercalate "\t"+			[ dValue SOADomain +			, "IN"+			, "SOA"+			, dValue (sDomain soa)+			, "root"+			, "("+			]+		, headerline sSerial "Serial"+		, headerline sRefresh "Refresh"+		, headerline sRetry "Retry"+		, headerline sExpire "Expire"+		, headerline sNegativeCacheTTL "Negative Cache TTL"+		, inheader ")"+		]+	headerline r comment = inheader $ show (r soa) ++ "\t\t" ++ com comment+	inheader l = "\t\t\t" ++ l++-- | Comment line in a zone file.+com :: String -> String+com s = "; " ++ s++type WarningMessage = String++-- | Generates a Zone for a particular Domain from the DNS properies of all+-- hosts that propellor knows about that are in that Domain.+genZone :: [Host] -> Domain -> SOA -> (Zone, [WarningMessage])+genZone hosts zdomain soa =+	let (warnings, zhosts) = partitionEithers $ concat $ map concat+		[ map hostips inzdomain+		, map hostrecords inzdomain+		, map addcnames (M.elems m)+		]+	in (Zone zdomain soa (nub zhosts), warnings)+  where+	m = hostAttrMap hosts+	-- Known hosts with hostname located in the zone's domain.+	inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m+	+	-- Each host with a hostname located in the zdomain+	-- should have 1 or more IPAddrs in its Attr.+	--+	-- If a host lacks any IPAddr, it's probably a misconfiguration,+	-- so warn.+	hostips :: Attr -> [Either WarningMessage (BindDomain, Record)]+	hostips attr+		| null l = [Left $ "no IP address defined for host " ++ _hostname attr]+		| otherwise = map Right l+	  where+		l = zip (repeat $ AbsDomain $ _hostname attr)+			(map Address $ getAddresses attr)++	-- Any host, whether its hostname is in the zdomain or not,+	-- may have cnames which are in the zdomain. The cname may even be+	-- the same as the root of the zdomain, which is a nice way to+	-- specify IP addresses for a SOA record.+	--+	-- Add Records for those.. But not actually, usually, cnames!+	-- Why not? Well, using cnames doesn't allow doing some things,+	-- including MX and round robin DNS, and certianly CNAMES+	-- shouldn't be used in SOA records.+	--+	-- We typically know the host's IPAddrs anyway.+	-- So we can just use the IPAddrs.+	addcnames :: Attr -> [Either WarningMessage (BindDomain, Record)]+	addcnames attr = concatMap gen $ filter (inDomain zdomain) $+		mapMaybe getCNAME $ S.toList (_dns attr)+	  where+		gen c = case getAddresses attr of+			[] -> [ret (CNAME c)]+			l -> map (ret . Address) l+		  where+		  	ret record = Right (c, record)+	+	-- Adds any other DNS records for a host located in the zdomain.+	hostrecords :: Attr -> [Either WarningMessage (BindDomain, Record)]+	hostrecords attr = map Right l+	  where+		l = zip (repeat $ AbsDomain $ _hostname attr)+			(S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))++inDomain :: Domain -> BindDomain -> Bool+inDomain domain (AbsDomain d) = domain == d || ('.':domain) `isSuffixOf` d+inDomain _ _ = False -- can't tell, so assume not++-- | Gets the hostname of the second domain, relative to the first domain,+-- suitable for using in a zone file.+domainHost :: Domain -> BindDomain -> String+domainHost _ (RelDomain d) = d+domainHost _ SOADomain = "@"+domainHost base (AbsDomain d)+	| dotbase `isSuffixOf` d = take (length d - length dotbase) d+	| base == d = "@"+	| otherwise = d+  where+	dotbase = '.':base+

@@ -25,7 +25,7 @@ -- | Configures docker with an authentication file, so that images can be -- pushed to index.docker.io. configured :: Property-configured = Property "docker configured" go `requires` installed+configured = property "docker configured" go `requires` installed   where 	go = withPrivData DockerAuthentication $ \cfg -> ensureProperty $  		"/root/.dockercfg" `File.hasContent` (lines cfg)@@ -64,7 +64,7 @@ 	-> RevertableProperty docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown)   where-	go desc a = Property (desc ++ " " ++ cn) $ do+	go desc a = property (desc ++ " " ++ cn) $ do 		hn <- getHostName   		let cid = ContainerId hn cn 		ensureProperties [findContainer hosts cid cn $ a cid]@@ -79,7 +79,7 @@ 	teardown cid (Container image _runparams) = 		combineProperties ("undocked " ++ fromContainerId cid) 			[ stoppedContainer cid-			, Property ("cleaned up " ++ fromContainerId cid) $+			, property ("cleaned up " ++ fromContainerId cid) $ 				liftIO $ report <$> mapM id 					[ removeContainer cid 					, removeImage image@@ -96,7 +96,7 @@ 	Nothing -> cantfind 	Just h -> maybe cantfind mk (mkContainer cid h)   where-	cantfind = containerDesc cid $ Property "" $ do+	cantfind = containerDesc cid $ property "" $ do 		liftIO $ warningMessage $ 			"missing definition for docker container \"" ++ cn2hn cn 		return FailedChange@@ -126,9 +126,9 @@ 	, gcimages 	]   where-	gccontainers = Property "docker containers garbage collected" $+	gccontainers = property "docker containers garbage collected" $ 		liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers)-	gcimages = Property "docker images garbage collected" $ do+	gcimages = property "docker images garbage collected" $ do 		liftIO $ report <$> (mapM removeImage =<< listImages)  data Container = Container Image [RunParam]@@ -140,51 +140,51 @@ type Image = String  -- | Set custom dns server for container.-dns :: String -> AttrProperty+dns :: String -> Property dns = runProp "dns"  -- | Set container host name.-hostname :: String -> AttrProperty+hostname :: String -> Property hostname = runProp "hostname"  -- | Set name for container. (Normally done automatically.)-name :: String -> AttrProperty+name :: String -> Property name = runProp "name"  -- | Publish a container's port to the host -- (format: ip:hostPort:containerPort | ip::containerPort | hostPort:containerPort)-publish :: String -> AttrProperty+publish :: String -> Property publish = runProp "publish"  -- | Username or UID for container.-user :: String -> AttrProperty+user :: String -> Property user = runProp "user"  -- | Mount a volume -- Create a bind mount with: [host-dir]:[container-dir]:[rw|ro] -- With just a directory, creates a volume in the container.-volume :: String -> AttrProperty+volume :: String -> Property volume = runProp "volume"  -- | Mount a volume from the specified container into the current -- container.-volumes_from :: ContainerName -> AttrProperty+volumes_from :: ContainerName -> Property volumes_from cn = genProp "volumes-from" $ \hn -> 	fromContainerId (ContainerId hn cn)  -- | Work dir inside the container. -workdir :: String -> AttrProperty+workdir :: String -> Property workdir = runProp "workdir"  -- | Memory limit for container. --Format: <number><optional unit>, where unit = b, k, m or g-memory :: String -> AttrProperty+memory :: String -> Property memory = runProp "memory"  -- | Link with another container on the same host.-link :: ContainerName -> ContainerAlias -> AttrProperty-link linkwith alias = genProp "link" $ \hn ->-	fromContainerId (ContainerId hn linkwith) ++ ":" ++ alias+link :: ContainerName -> ContainerAlias -> Property+link linkwith calias = genProp "link" $ \hn ->+	fromContainerId (ContainerId hn linkwith) ++ ":" ++ calias  -- | A short alias for a linked container. -- Each container has its own alias namespace.@@ -230,7 +230,7 @@ 	desc = "[" ++ fromContainerId cid ++ "] " ++ propertyDesc p  runningContainer :: ContainerId -> Image -> [RunParam] -> Property-runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ Property "running" $ do+runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ property "running" $ do 	l <- liftIO $ listContainers RunningContainers 	if cid `elem` l 		then do@@ -324,7 +324,7 @@ -- being run. So, retry connections to the client for up to -- 1 minute. provisionContainer :: ContainerId -> Property-provisionContainer cid = containerDesc cid $ Property "provision" $ liftIO $ do+provisionContainer cid = containerDesc cid $ property "provision" $ liftIO $ do 	let shim = Shim.file (localdir </> "propellor") (localdir </> shimdir cid) 	r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing) 	when (r /= FailedChange) $@@ -356,7 +356,7 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId cid ]  stoppedContainer :: ContainerId -> Property-stoppedContainer cid = containerDesc cid $ Property desc $ +stoppedContainer cid = containerDesc cid $ property desc $  	ifM (liftIO $ elem cid <$> listContainers RunningContainers) 		( liftIO cleanup `after` ensureProperty  			(boolProperty desc $ stopContainer cid)@@ -405,18 +405,15 @@ listImages :: IO [Image] listImages = lines <$> readProcess dockercmd ["images", "--all", "--quiet"] -runProp :: String -> RunParam -> AttrProperty-runProp field val = AttrProperty prop $ \attr ->+runProp :: String -> RunParam -> Property+runProp field val = pureAttrProperty (param) $ \attr -> 	attr { _dockerRunParams = _dockerRunParams attr ++ [\_ -> "--"++param] }   where 	param = field++"="++val-	prop = Property (param) (return NoChange) -genProp :: String -> (HostName -> RunParam) -> AttrProperty-genProp field mkval = AttrProperty prop $ \attr ->+genProp :: String -> (HostName -> RunParam) -> Property+genProp field mkval = pureAttrProperty field $ \attr -> 	attr { _dockerRunParams = _dockerRunParams attr ++ [\hn -> "--"++field++"=" ++ mkval hn] }-  where-	prop = Property field (return NoChange)  -- | The ContainerIdent of a container is written to -- /.propellor-ident inside it. This can be checked to see if

@@ -18,7 +18,7 @@ -- The file's permissions are preserved if the file already existed. -- Otherwise, they're set to 600. hasPrivContent :: FilePath -> Property-hasPrivContent f = Property desc $ withPrivData (PrivFile f) $ \privcontent -> +hasPrivContent f = property desc $ withPrivData (PrivFile f) $ \privcontent ->  	ensureProperty $ fileProperty' writeFileProtected desc 		(\_oldcontent -> lines privcontent) f   where@@ -48,13 +48,13 @@  -- | Removes a file. Does not remove symlinks or non-plain-files. notPresent :: FilePath -> Property-notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $ +notPresent f = check (doesFileExist f) $ property (f ++ " not present") $  	makeChange $ nukeFile f  fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property fileProperty = fileProperty' writeFile fileProperty' :: (FilePath -> String -> IO ()) -> Desc -> ([Line] -> [Line]) -> FilePath -> Property-fileProperty' writer desc a f = Property desc $ go =<< liftIO (doesFileExist f)+fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)   where 	go True = do 		ls <- liftIO $ lines <$> readFile f@@ -74,12 +74,12 @@  -- | Ensures a directory exists. dirExists :: FilePath -> Property-dirExists d = check (not <$> doesDirectoryExist d) $ Property (d ++ " exists") $+dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $ 	makeChange $ createDirectoryIfMissing True d  -- | Ensures that a file/dir has the specified owner and group. ownerGroup :: FilePath -> UserName -> GroupName -> Property-ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do+ownerGroup f owner group = property (f ++ " owner " ++ og) $ do 	r <- ensureProperty $ cmdProperty "chown" [og, f] 	if r == FailedChange 		then return r@@ -89,6 +89,6 @@  -- | Ensures that a file/dir has the specfied mode. mode :: FilePath -> FileMode -> Property-mode f v = Property (f ++ " mode " ++ show v) $ do+mode f v = property (f ++ " mode " ++ show v) $ do 	liftIO $ modifyFileMode f (\_old -> v) 	noChange

@@ -62,7 +62,7 @@ -- -- A branch can be specified, to check out. cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property-cloned owner url dir mbranch = check originurl (Property desc checkout)+cloned owner url dir mbranch = check originurl (property desc checkout) 	`requires` installed   where 	desc = "git cloned " ++ url ++ " to " ++ dir

@@ -21,7 +21,7 @@ -- The GpgKeyId does not have to be a numeric id; it can just as easily -- be a description of the key. keyImported :: GpgKeyId -> UserName -> Property-keyImported keyid user = flagFile' (Property desc go) genflag+keyImported keyid user = flagFile' (property desc go) genflag 	`requires` installed   where 	desc = user ++ " has gpg key " ++ show keyid

@@ -9,7 +9,7 @@ -- A FQDN also configures /etc/hosts, with an entry for 127.0.1.1, which is -- standard at least on Debian to set the FDQN (127.0.0.1 is localhost). sane :: Property-sane = Property ("sane hostname") (ensureProperty . setTo =<< getHostName)+sane = property ("sane hostname") (ensureProperty . setTo =<< getHostName)  setTo :: HostName -> Property setTo hn = combineProperties desc go

@@ -7,9 +7,6 @@  import Data.List -installed :: Property-installed = Apt.installed ["obnam"]- type ObnamParam = String  -- | An obnam repository can be used by multiple clients. Obnam uses@@ -68,7 +65,7 @@ -- The restore is performed atomically; restoring to a temp directory -- and then moving it to the directory. restored :: FilePath -> [ObnamParam] -> Property-restored dir params = Property (dir ++ " restored by obnam") go+restored dir params = property (dir ++ " restored by obnam") go 	`requires` installed   where 	go = ifM (liftIO needsRestore)@@ -94,3 +91,65 @@ 				return MadeChange 			, return FailedChange 			)++installed :: Property+installed = Apt.installed ["obnam"]++-- | Ensures that a recent version of obnam gets installed.+--+-- Only does anything for Debian Stable.+latestVersion :: Property+latestVersion = withOS "obnam latest version" $ \o -> case o of+	(Just (System (Debian suite) _)) | isStable suite -> ensureProperty $+		Apt.setSourcesListD (sources suite) "obnam"+			`requires` toProp (Apt.trustsKey key)+	_ -> noChange+  where+	sources suite = +		[ "deb http://code.liw.fi/debian " ++ Apt.showSuite suite ++ " main"+		]+	-- gpg key used by the code.liw.fi repository.+	key = Apt.AptKey "obnam" $ unlines+		[ "-----BEGIN PGP PUBLIC KEY BLOCK-----"+		, "Version: GnuPG v1.4.9 (GNU/Linux)"+		, ""+		, "mQGiBEfzuTgRBACcVNG/H6QJqLx5qiQs2zmPe6D6BWOWHfgNgG4IWzNstm21YDxb"+		, "KqwFG0gxcnZJGHkXAhkSfqTokYd0lc5eBemcA1pkceNjzMEX8wwiZ810HzJD4eEH"+		, "sjoWR8+qKrZeixzZqReAfqztcXoBGKQ0u1R1vpg1txUa75OM4BUqaUbsmwCgmS4x"+		, "DjMxSaUSPuu6vQ7ZGZBXSP0D/RQw8DBHMfsv3DiaqFqk8tkuUkpMFPIekHidSHlO"+		, "EACbncqbbyHksyCpFNVNcQIDHrOLjOZK9BAXkSd8I3ww7U+nLdDcCblrW8CZnJtm"+		, "ZYrxfaXaHZ/It9/RCAsQ+c8xtmyUPjsf//4Vf8olxNQHzgBSe5/LJRi4Vd53he+K"+		, "YP4LA/9IZbjvVmm8+8Y0pQrTHlI6nTImtzdBXHc4+T3lLBj9XODHLozC2kSBOQky"+		, "q/EisTITHTXL8vYg4NsKm5RTbPAuBwdtxcny8CXfOqKtGOdrebmKotGllTozzdPv"+		, "9p53cuce6oJ2oMUodc074JOGTWwDSgLiJX4nViGcU1wy/vtQnrQkY29kZS5saXcu"+		, "ZmkgYXJjaGl2ZSBrZXkgPGxpd0BsaXcuZmk+iGAEExECACAFAkfzuTgCGwMGCwkI"+		, "BwMCBBUCCAMEFgIDAQIeAQIXgAAKCRBG53tJR95LscKrAJ0ZtKqa2x6Kplwa2mzx"+		, "ItImbIGMJACdETqofDYzUN91yLAFlOnxAyrE+UyIRgQQEQIABgUCSFd5GgAKCRAf"+		, "u5W/LZrMjqr8AJ4xPVHpW8ZNlgMwDSVb075RnA2DiACgg2SR69jAHFQOWV6xfLRr"+		, "vh0bLKGJAhwEEAEIAAYFAktEyIwACgkQ61zh116FEfm7Lg//Wiy3TjWAk8YHUddv"+		, "zOioYzCxQ985GsVhJGAVPqSGOc9vfTWBJZ8J3l0NnYTRpEGucmbF9G+mAt9iGXu6"+		, "7yZkxyFdvbo7EDsqMU1wLOM6PiU+Un63MKlbTNmFn7OKE8aXPRAFgcyUO/qjdqoD"+		, "sa9FgU5Z0f60m9qah6BPXH6IzMLHYoiP7t8rCBIwLgyl3w2w+Fjt1DFpbW9Kb7jz"+		, "i8jFvC8jPmxV8xh2OSgVZyNk4qg6hIV8GVQY7AJt8OurZSckgQd7ifHK9JTGohtF"+		, "tXCiqeDEvnMF4A9HI/TcXJBzonZ8ds1JCq42nSSKmL+8TyjtUSD/xHygazuc0CK0"+		, "hFnQWBub60IfyV6F0oTagJ8cmARv2sezHAeHDkzPHE8RdjgktazH1eJrA4LheEd6"+		, "KeSnVtYWpw8dgMv5PleFyQiAj/t3C/N50fd15tUyfnH15G7nFjMQV2Yx35uwSxOj"+		, "376OWnDN/YGTNk283XXULbyVJYR8Q2unso20XQ94yQ2A5EpHHPrHoLxrL/ydM08d"+		, "nvKstLZIZtal1seiMkymtlSiGz25A5oqsclwS6VZCKdWA8HO/wlElOMcaHyl6Y1y"+		, "gYP7y9O5yFYKFOrCH0nFjJbwmkRiBLsxuuWsYgJigVGq/atSrtawkHdshpCw0HCY"+		, "N/RFcWkJ864BdsO0C0sDzueNkQO5Ag0ER/O5RBAIAJiwPH9tyJTgXcC2Y4XWboOq"+		, "rx5CkOnr5b45oS9cK2eIJ8TKxE3XgKLxUr3mIH0QR2kZgDOwNl0WY+7/CXjn+Spn"+		, "BokPg54rafEUePodGpGdUXdgrHhAMHYjh8fXFJ1SlQcg46/zc1wDI7jBCkGrK3V8"+		, "5cXDqwTFTN5LcjoSRWeM4Voa6pEfDdL3rMlnOw9R9gDHRBBb6CDSjWXqM86pR889"+		, "5QrR0SDwiJNrMoyxSjMXFKGBQAsYHJ82myZrlbuZbroZjVp5Uh7eB1ZiPljNVtcr"+		, "sksACIWBCo1rvLzrPXsLYOeV3cDDtYAkSwGfuzC1Etbe+qgfIroFTOqdefMw4s8A"+		, "AwUH/0KLXm4MS54QQspg3evu4Q4U/E8Hem5/FqB0GhBCitQ4rUsucKyY8/ItpUn5"+		, "ismLE60bQqka+Mzd/Zw18TCTzImv0ozAaZ2sNtBado7f6jcC8EDfY5zzK1ukcsAr"+		, "Qc5hdLHYuTQW5KpA6fKaW969OUzIwPbdVaCOLOBpxKC6N6iBspQYd6uiQtLw6EUO"+		, "50oQqUiJABf0eOocvdw5e2KQQpuC3205+VMYtyl4w3pdJihK8NK0AikGXzDVsbQt"+		, "l8kmB5ZrN4WIKhMke1FxbqQC5Q3XATvYRzpzzisZb/HYGNti8W6du5EUwJ0D2NRh"+		, "cu+twocOzW0VKfmrDApfifJ9OsSISQQYEQIACQUCR/O5RAIbDAAKCRBG53tJR95L"+		, "seQOAJ95KUyzjRjdYgZkDC69Mgu25L86UACdGduINUaRly43ag4kwUXxpqswBBM="+		, "=i2c3"+		, "-----END PGP PUBLIC KEY BLOCK-----"+		]

@@ -15,7 +15,7 @@ satellite :: Property satellite = setup `requires` installed   where-	setup = trivial $ Property "postfix satellite system" $ do+	setup = trivial $ property "postfix satellite system" $ do 		hn <- getHostName 		ensureProperty $ Apt.reConfigure "postfix" 			[ ("postfix/main_mailer_type", "select", "Satellite system")

@@ -19,13 +19,13 @@ -- This uses the description of the Property to keep track of when it was -- last run. period :: Property -> Recurrance -> Property-period prop recurrance = Property desc $ do+period prop recurrance = flip describe desc $ adjustProperty prop $ \satisfy -> do 	lasttime <- liftIO $ getLastChecked (propertyDesc prop) 	nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime 	t <- liftIO localNow 	if Just t >= nexttime 		then do-			r <- ensureProperty prop+			r <- satisfy 			liftIO $ setLastChecked t (propertyDesc prop) 			return r 		else noChange@@ -37,7 +37,7 @@ periodParse :: Property -> String -> Property periodParse prop s = case toRecurrance s of 	Just recurrance -> period prop recurrance-	Nothing -> Property "periodParse" $ do+	Nothing -> property "periodParse" $ do 		liftIO $ warningMessage $ "failed periodParse: " ++ s 		noChange 

@@ -13,19 +13,19 @@ -- we can do is try to start the service, and if it fails, assume -- this means it's already running. running :: ServiceName -> Property-running svc = Property ("running " ++ svc) $ do+running svc = property ("running " ++ svc) $ do 	void $ ensureProperty $ 		scriptProperty ["service " ++ shellEscape svc ++ " start >/dev/null 2>&1 || true"] 	return NoChange  restarted :: ServiceName -> Property-restarted svc = Property ("restarted " ++ svc) $ do+restarted svc = property ("restarted " ++ svc) $ do 	void $ ensureProperty $ 		scriptProperty ["service " ++ shellEscape svc ++ " restart >/dev/null 2>&1 || true"] 	return NoChange  reloaded :: ServiceName -> Property-reloaded svc = Property ("reloaded " ++ svc) $ do+reloaded svc = property ("reloaded " ++ svc) $ do 	void $ ensureProperty $ 		scriptProperty ["service " ++ shellEscape svc ++ " reload >/dev/null 2>&1 || true"] 	return NoChange

@@ -40,7 +40,7 @@ 	-- The builduser account does not have a password set, 	-- instead use the password privdata to hold the rsync server 	-- password used to upload the built image.-	, Property "rsync password" $ do+	, property "rsync password" $ do 		let f = homedir </> "rsyncpassword" 		if rsyncupload  			then withPrivData (Password builduser) $ \p -> do

@@ -8,16 +8,16 @@ -- | Clones Joey Hess's git home directory, and runs its fixups script. installedFor :: UserName -> Property installedFor user = check (not <$> hasGitDir user) $ -	Property ("githome " ++ user) (go =<< liftIO (homedir user))+	property ("githome " ++ user) (go =<< liftIO (homedir user)) 		`requires` Apt.installed ["git"]   where 	go home = do 		let tmpdir = home </> "githome" 		ensureProperty $ combineProperties "githome setup" 			[ userScriptProperty user ["git clone " ++ url ++ " " ++ tmpdir]-			, Property "moveout" $ makeChange $ void $+			, property "moveout" $ makeChange $ void $ 				moveout tmpdir home-			, Property "rmdir" $ makeChange $ void $+			, property "rmdir" $ makeChange $ void $ 				catchMaybeIO $ removeDirectory tmpdir 			, userScriptProperty user ["rm -rf .aptitude/ .bashrc .profile; bin/mr checkout; bin/fixups"] 			]

@@ -16,9 +16,63 @@ import qualified Propellor.Property.Apache as Apache import Utility.SafeCommand +import Data.List+import System.Posix.Files++oldUseNetServer :: [Host] -> Property+oldUseNetServer hosts = propertyList ("olduse.net server")+	[ oldUseNetInstalled "oldusenet-server"+	, Obnam.latestVersion+	, Obnam.backup datadir "33 4 * * *"+		[ "--repository=sftp://2318@usw-s002.rsync.net/~/olduse.net"+		, "--client-name=spool"+		] Obnam.OnlyClient+		`requires` Ssh.keyImported SshRsa "root"+		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "root"+	, check (not . isSymbolicLink <$> getSymbolicLinkStatus newsspool) $+		property "olduse.net spool in place" $ makeChange $ do+			removeDirectoryRecursive newsspool+			createSymbolicLink (datadir </> "news") newsspool+	, Apt.installed ["leafnode"]+	, "/etc/news/leafnode/config" `File.hasContent` +		[ "# olduse.net configuration (deployed by propellor)"+		, "expire = 1000000" -- no expiry via texpire+		, "server = " -- no upstream server+		, "debugmode = 1"+		, "allowSTRANGERS = 42" -- lets anyone connect+		, "nopost = 1" -- no new posting (just gather them)+		]+	, "/etc/hosts.deny" `File.lacksLine` "leafnode: ALL"+	, Apt.serviceInstalledRunning "openbsd-inetd"+	, File.notPresent "/etc/cron.daily/leafnode"+	, File.notPresent "/etc/cron.d/leafnode"+	, Cron.niceJob "oldusenet-expire" "11 1 * * *" "news" newsspool $ intercalate ";"+		[ "find \\( -path ./out.going -or -path ./interesting.groups -or -path './*/.overview' \\) -prune -or -type f -ctime +60  -print | xargs --no-run-if-empty rm"+		, "find -type d -empty | xargs --no-run-if-empty rmdir"+		]+	, Cron.niceJob "oldusenet-uucp" "*/5 * * * *" "news" "/" $+		"/usr/bin/uucp " ++ datadir+	, toProp $ Apache.siteEnabled "nntp.olduse.net" $ apachecfg "nntp.olduse.net" False+		[ "  DocumentRoot " ++ datadir ++ "/"+		, "  <Directory " ++ datadir ++ "/>"+		, "    Options Indexes FollowSymlinks"+		, "    AllowOverride None"+		-- I had this in the file before.+		-- This may be needed by a newer version of apache?+		--, "    Require all granted"+		, "  </Directory>"+		]+	]+  where+	newsspool = "/var/spool/news"+	datadir = "/var/spool/oldusenet"+ oldUseNetShellBox :: Property-oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $-	propertyList ("olduse.net shellbox")+oldUseNetShellBox = oldUseNetInstalled "oldusenet"++oldUseNetInstalled :: Apt.Package -> Property+oldUseNetInstalled pkg = check (not <$> Apt.isInstalled pkg) $+	propertyList ("olduse.net " ++ pkg) 		[ Apt.installed (words "build-essential devscripts debhelper git libncursesw5-dev libpcre3-dev pkg-config bison libicu-dev libidn11-dev libcanlock2-dev libuu-dev ghc libghc-strptime-dev libghc-hamlet-dev libghc-ifelse-dev libghc-hxt-dev libghc-utf8-string-dev libghc-missingh-dev libghc-sha-dev") 			`describe` "olduse.net build deps" 		, scriptProperty@@ -26,12 +80,13 @@ 			, "git clone git://olduse.net/ /root/tmp/oldusenet/source" 			, "cd /root/tmp/oldusenet/source/" 			, "dpkg-buildpackage -us -uc"-			, "dpkg -i ../oldusenet*.deb || true"+			, "dpkg -i ../" ++ pkg ++ "_*.deb || true" 			, "apt-get -fy install" -- dependencies 			, "rm -rf /root/tmp/oldusenet" 			] `describe` "olduse.net built" 		] + kgbServer :: Property kgbServer = withOS desc $ \o -> case o of 	(Just (System (Debian Unstable) _)) ->@@ -50,7 +105,8 @@ -- git.kitenet.net and git.joeyh.name gitServer :: [Host] -> Property gitServer hosts = propertyList "git.kitenet.net setup"-	[ Obnam.backup "/srv/git" "33 3 * * *"+	[ Obnam.latestVersion+	, Obnam.backup "/srv/git" "33 3 * * *" 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net" 		, "--encrypt-with=1B169BE1" 		, "--client-name=wren"

@@ -67,7 +67,7 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" 	`onChange` restartSshd   where-	prop = Property "ssh random host keys" $ do+	prop = property "ssh random host keys" $ do 		void $ liftIO $ boolSystem "sh" 			[ Param "-c" 			, Param "rm -f /etc/ssh/ssh_host_*"@@ -81,8 +81,8 @@ -- (Uses a null username for host keys.) hostKey :: SshKeyType -> Property hostKey keytype = combineProperties desc-	[ Property desc (install writeFile (SshPubKey keytype "") ".pub")-	, Property desc (install writeFileProtected (SshPrivKey keytype "") "")+	[ property desc (install writeFile (SshPubKey keytype "") ".pub")+	, property desc (install writeFileProtected (SshPrivKey keytype "") "") 	] 	`onChange` restartSshd   where@@ -98,8 +98,8 @@ -- from the site's PrivData. keyImported :: SshKeyType -> UserName -> Property keyImported keytype user = combineProperties desc-	[ Property desc (install writeFile (SshPubKey keytype user) ".pub")-	, Property desc (install writeFileProtected (SshPrivKey keytype user) "")+	[ property desc (install writeFile (SshPubKey keytype user) ".pub")+	, property desc (install writeFileProtected (SshPrivKey keytype user) "") 	]   where 	desc = user ++ " has ssh key (" ++ fromKeyType keytype ++ ")"@@ -108,7 +108,7 @@ 		ifM (liftIO $ doesFileExist f) 			( noChange 			, ensureProperty $ combineProperties desc-				[ Property desc $ +				[ property desc $  					withPrivData p $ \key -> makeChange $ 						writer f key 				, File.ownerGroup f user user@@ -126,7 +126,7 @@  -- | Puts some host's ssh public key into the known_hosts file for a user. knownHost :: [Host] -> HostName -> UserName -> Property-knownHost hosts hn user = Property desc $+knownHost hosts hn user = property desc $ 	go =<< fromHost hosts hn getSshPubKey   where 	desc = user ++ " knows ssh key for " ++ hn@@ -143,7 +143,7 @@  -- | Makes a user have authorized_keys from the PrivData authorizedKeys :: UserName -> Property-authorizedKeys user = Property (user ++ " has authorized_keys") $+authorizedKeys user = property (user ++ " has authorized_keys") $ 	withPrivData (SshAuthorizedKeys user) $ \v -> do 		f <- liftIO $ dotFile "authorized_keys" user 		liftIO $ do

@@ -10,7 +10,7 @@ -- | Allows a user to sudo. If the user has a password, sudo is configured -- to require it. If not, NOPASSWORD is enabled for the user. enabledFor :: UserName -> Property-enabledFor user = Property desc go `requires` Apt.installed ["sudo"]+enabledFor user = property desc go `requires` Apt.installed ["sudo"]   where 	go = do 		locked <- liftIO $ isLockedPassword user

@@ -29,7 +29,7 @@ 	hasPassword user  hasPassword :: UserName -> Property-hasPassword user = Property (user ++ " has password") $+hasPassword user = property (user ++ " has password") $ 	withPrivData (Password user) $ \password -> makeChange $ 		withHandle StdinHandle createProcessSuccess 			(proc "chpasswd" []) $ \h -> do

@@ -5,15 +5,13 @@ module Propellor.Types 	( Host(..) 	, Attr-	, HostName 	, Propellor(..) 	, Property(..) 	, RevertableProperty(..)-	, AttrProperty(..) 	, IsProp 	, describe 	, toProp-	, getAttr+	, setAttr 	, requires 	, Desc 	, Result(..)@@ -23,6 +21,7 @@ 	, GpgKeyId 	, SshKeyType(..) 	, module Propellor.Types.OS+	, module Propellor.Types.Dns 	) where  import Data.Monoid@@ -33,8 +32,9 @@  import Propellor.Types.Attr import Propellor.Types.OS+import Propellor.Types.Dns -data Host = Host [Property] (Attr -> Attr)+data Host = Host [Property] SetAttr  -- | Propellor's monad provides read-only access to attributes of the -- system.@@ -53,16 +53,15 @@ -- property. data Property = Property 	{ propertyDesc :: Desc-	-- | must be idempotent; may run repeatedly 	, propertySatisfy :: Propellor Result+	-- ^ must be idempotent; may run repeatedly+	, propertyAttr :: SetAttr+	-- ^ a property can affect the overall Attr 	}  -- | A property that can be reverted. data RevertableProperty = RevertableProperty Property Property --- | A property that affects the Attr.-data AttrProperty = forall p. IsProp p => AttrProperty p (Attr -> Attr)- class IsProp p where 	-- | Sets description. 	describe :: p -> Desc -> p@@ -70,17 +69,21 @@ 	-- | Indicates that the first property can only be satisfied 	-- once the second one is. 	requires :: p -> Property -> p-	getAttr :: p -> (Attr -> Attr)+	setAttr :: p -> SetAttr  instance IsProp Property where 	describe p d = p { propertyDesc = d } 	toProp p = p-	x `requires` y = Property (propertyDesc x) $ do-		r <- propertySatisfy y-		case r of-			FailedChange -> return FailedChange-			_ -> propertySatisfy x-	getAttr _ = id+	setAttr = propertyAttr+	x `requires` y = Property (propertyDesc x) satisfy attr+	  where+	  	attr = propertyAttr x . propertyAttr y+		satisfy = do+			r <- propertySatisfy y+			case r of+				FailedChange -> return FailedChange+				_ -> propertySatisfy x+			  instance IsProp RevertableProperty where 	-- | Sets the description of both sides.@@ -89,13 +92,8 @@ 	toProp (RevertableProperty p1 _) = p1 	(RevertableProperty p1 p2) `requires` y = 		RevertableProperty (p1 `requires` y) p2-	getAttr _ = id--instance IsProp AttrProperty where-	describe (AttrProperty p a) d = AttrProperty (describe p d) a-	toProp (AttrProperty p _) = toProp p-	(AttrProperty p a) `requires` y = AttrProperty (p `requires` y) a-	getAttr (AttrProperty _ a) = a+	-- | Return the SetAttr of the currently active side.+	setAttr (RevertableProperty p1 _p2) = setAttr p1  type Desc = String 

@@ -1,15 +1,18 @@ module Propellor.Types.Attr where  import Propellor.Types.OS+import qualified Propellor.Types.Dns as Dns  import qualified Data.Set as S+import qualified Data.Map as M  -- | The attributes of a host. For example, its hostname. data Attr = Attr 	{ _hostname :: HostName-	, _cnames :: S.Set Domain 	, _os :: Maybe System 	, _sshPubKey :: Maybe String+	, _dns :: S.Set Dns.Record+	, _namedconf :: M.Map Dns.Domain Dns.NamedConf  	, _dockerImage :: Maybe String 	, _dockerRunParams :: [HostName -> String]@@ -18,8 +21,9 @@ instance Eq Attr where 	x == y = and 		[ _hostname x == _hostname y-		, _cnames x == _cnames y 		, _os x == _os y+		, _dns x == _dns y+		, _namedconf x == _namedconf y 		, _sshPubKey x == _sshPubKey y  		, _dockerImage x == _dockerImage y@@ -30,15 +34,15 @@ instance Show Attr where 	show a = unlines 		[ "hostname " ++ _hostname a-		, "cnames " ++ show (_cnames a) 		, "OS " ++ show (_os a) 		, "sshPubKey " ++ show (_sshPubKey a)+		, "dns " ++ show (_dns a)+		, "namedconf " ++ show (_namedconf a) 		, "docker image " ++ show (_dockerImage a) 		, "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) 		]  newAttr :: HostName -> Attr-newAttr hn = Attr hn S.empty Nothing Nothing Nothing []+newAttr hn = Attr hn Nothing Nothing S.empty M.empty Nothing [] -type HostName = String-type Domain = String+type SetAttr = Attr -> Attr

@@ -0,0 +1,81 @@+module Propellor.Types.Dns where++import Data.Word++type Domain = String++data IPAddr = IPv4 String | IPv6 String+	deriving (Read, Show, Eq, Ord)++fromIPAddr :: IPAddr -> String+fromIPAddr (IPv4 addr) = addr+fromIPAddr (IPv6 addr) = addr++-- | Represents a bind 9 named.conf file.+data NamedConf = NamedConf+	{ confDomain :: Domain+	, confType :: Type+	, confFile :: FilePath+	, confMasters :: [IPAddr]+	, confLines :: [String]+	}+	deriving (Show, Eq, Ord)++data Type = Master | Secondary+	deriving (Show, Eq, Ord)++-- | Represents a bind 9 zone file.+data Zone = Zone+	{ zDomain :: Domain+	, zSOA :: SOA+	, zHosts :: [(BindDomain, Record)]+	}+	deriving (Read, Show, Eq)++-- | Every domain has a SOA record, which is big and complicated.+data SOA = SOA+	{ sDomain :: BindDomain+	-- ^ Typically ns1.your.domain+	, sSerial :: SerialNumber+	-- ^ The most important parameter is the serial number,+	-- which must increase after each change.+	, sRefresh :: Integer+	, sRetry :: Integer+	, sExpire :: Integer+	, sNegativeCacheTTL :: Integer+	, sRecord :: [Record]+	-- ^ Records for the root of the domain. Typically NS, A, TXT+	}+	deriving (Read, Show, Eq)++-- | Types of DNS records.+--+-- This is not a complete list, more can be added.+data Record+	= Address IPAddr+	| CNAME BindDomain+	| MX Int BindDomain+	| NS BindDomain+	| TXT String+	| SRV Word16 Word16 Word16 BindDomain+	deriving (Read, Show, Eq, Ord)++getIPAddr :: Record -> Maybe IPAddr+getIPAddr (Address addr) = Just addr+getIPAddr _ = Nothing++getCNAME :: Record -> Maybe BindDomain+getCNAME (CNAME d) = Just d+getCNAME _ = Nothing++-- | Bind serial numbers are unsigned, 32 bit integers.+type SerialNumber = Word32++-- | Domains in the zone file must end with a period if they are absolute.+--+-- Let's use a type to keep absolute domains straight from relative+-- domains.+--+-- The SOADomain refers to the root SOA record.+data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain+	deriving (Read, Show, Eq, Ord)

@@ -1,5 +1,6 @@ module Propellor.Types.OS where +type HostName = String type UserName = String type GroupName = String 

@@ -15,7 +15,12 @@ * There is no way for a property of a docker container to require   some property be met outside the container. For example, some servers   need ntp installed for a good date source.-* Attributes can only be set in the top level property list for a Host.-  If an attribute is set inside a propertyList, it won't propigate out.-  Fix this. Probably the fix involves combining AttrProperty into Property.-  Then propertyList can gather the attributes from its list.+* Docking a container in a host should add to the host any cnames that+  are assigned to the container.+* Either `Ssh.hostKey` should set the sshPubKey attr+  (which seems hard, as attrs need to be able to be calculated without+  running any IO code, and here IO is needed along with decrypting the+  PrivData..), or the public key should not be stored in+  the PrivData, and instead configured using the attr.+  Getting the ssh host key into the attr will allow automatically+  exporting it via DNS (SSHFP record)

@@ -32,11 +32,15 @@ hosts =               --                  (o)  ` 	-- My laptop 	[ host "darkstar.kitenet.net"+		& ipv6 "2001:4830:1600:187::2" -- sixxs tunnel 		& Docker.configured 		& Apt.buildDep ["git-annex"] `period` Daily  	-- Nothing super-important lives here. 	, standardSystem "clam.kitenet.net" Unstable "amd64"+		& ipv4 "162.248.143.249"+		& ipv6 "2002:5044:5531::1"+ 		& cleanCloudAtCost 		& Apt.unattendedUpgrades 		& Network.ipv6to4@@ -44,18 +48,18 @@ 		& Postfix.satellite 		& Docker.configured -		& cname "shell.olduse.net"+		& alias "shell.olduse.net" 		& JoeySites.oldUseNetShellBox -		& cname "openid.kitenet.net"+		& alias "openid.kitenet.net" 		& Docker.docked hosts "openid-provider" 		 	`requires` Apt.installed ["ntp"] -		& cname "ancient.kitenet.net"+		& alias "ancient.kitenet.net" 		& Docker.docked hosts "ancient-kitenet"  		-- I'd rather this were on diatom, but it needs unstable.-		& cname "kgb.kitenet.net"+		& alias "kgb.kitenet.net" 		& JoeySites.kgbServer  		& Docker.garbageCollected `period` Daily@@ -63,6 +67,8 @@ 	 	-- Orca is the main git-annex build box. 	, standardSystem "orca.kitenet.net" Unstable "amd64"+		& ipv4 "138.38.108.179"+ 		& Hostname.sane 		& Apt.unattendedUpgrades 		& Postfix.satellite@@ -76,13 +82,14 @@ 	 	-- Important stuff that needs not too much memory or CPU.   	, standardSystem "diatom.kitenet.net" Stable "amd64"+		& ipv4 "107.170.31.195"+ 		& Hostname.sane 		& Ssh.hostKey SshDsa 		& Ssh.hostKey SshRsa 		& Ssh.hostKey SshEcdsa 		& Apt.unattendedUpgrades 		& Apt.serviceInstalledRunning "ntp"-		& Dns.zones myDnsSecondary 		& Postfix.satellite 	 		& Apt.serviceInstalledRunning "apache2"@@ -93,24 +100,40 @@ 		& Apache.multiSSL 		& File.ownerGroup "/srv/web" "joey" "joey" -		& cname "git.kitenet.net"-		& cname "git.joeyh.name"+		& alias "git.kitenet.net"+		& alias "git.joeyh.name" 		& JoeySites.gitServer hosts 	-		& cname "downloads.kitenet.net"+		& alias "downloads.kitenet.net" 		& JoeySites.annexWebSite hosts "/srv/git/downloads.git" 			"downloads.kitenet.net" 			"840760dc-08f0-11e2-8c61-576b7e66acfd" 			[("turtle", "ssh://turtle.kitenet.net/~/lib/downloads/")] 		& JoeySites.annexRsyncServer -		& cname "tmp.kitenet.net"+		& alias "tmp.kitenet.net" 		& JoeySites.annexWebSite hosts "/srv/git/joey/tmp.git" 			"tmp.kitenet.net" 			"26fd6e38-1226-11e2-a75f-ff007033bdba" 			[] 		& JoeySites.twitRss 		+		& alias "nntp.olduse.net"+		& alias "resources.olduse.net"+		& JoeySites.oldUseNetServer hosts+		+		& myDnsSecondary+		& Dns.primary hosts "olduse.net"+			( Dns.mkSOA "ns1.kitenet.net" 100+				[ NS (AbsDomain "ns1.kitenet.net")+				, NS (AbsDomain "ns6.gandi.net")+				, NS (AbsDomain "ns2.kitenet.net")+				, MX 0 (AbsDomain "kitenet.net")+				, TXT "v=spf1 a -all"+				]+			)+			[ (RelDomain "article", CNAME $ AbsDomain "virgil.koldfront.dk") ]+ 		& Apt.installed ["ntop"]  @@ -171,7 +194,8 @@ standardSystem :: HostName -> DebianSuite -> Architecture -> Host standardSystem hn suite arch = host hn 	& os (System (Debian suite) arch)-	& Apt.stdSourcesList suite `onChange` Apt.upgrade+	& Apt.stdSourcesList suite+		`onChange` Apt.upgrade 	& Apt.installed ["etckeeper"] 	& Apt.installed ["ssh"] 	& GitHome.installedFor "root"@@ -221,17 +245,17 @@ 		] 	] -myDnsSecondary :: [Dns.Zone]-myDnsSecondary =-	[ Dns.secondary "kitenet.net" master-	, Dns.secondary "joeyh.name" master-	, Dns.secondary "ikiwiki.info" master-	, Dns.secondary "olduse.net" master-	, Dns.secondary "branchable.com" branchablemaster+myDnsSecondary :: Property+myDnsSecondary = propertyList "dns secondary for all my domains"+	[ Dns.secondaryFor wren hosts "kitenet.net"+	, Dns.secondaryFor wren hosts "joeyh.name"+	, Dns.secondaryFor wren hosts "ikiwiki.info"+	, Dns.secondary hosts "olduse.net"+	, Dns.secondaryFor branchable hosts "branchable.com" 	]   where-	master = ["80.68.85.49", "2001:41c8:125:49::10"] -- wren-	branchablemaster = ["66.228.46.55", "2600:3c03::f03c:91ff:fedf:c0e5"]+	wren = ["wren.kitenet.net"]+	branchable = ["branchable.com"]  main :: IO () main = defaultMain hosts@@ -250,11 +274,23 @@   monsters :: [Host]    -- Systems I don't manage with propellor,-monsters =	      -- but do want to track their public keys.+monsters =	      -- but do want to track their public keys etc. 	[ host "usw-s002.rsync.net" 		& sshPubKey "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ=="-	, host "turtle.kitenet.net"-		& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw==" 	, host "github.com"  		& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="+	, host "turtle.kitenet.net"+		& ipv4 "67.223.19.96"+		& ipv6 "2001:4978:f:2d9::2"+		& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAokMXQiX/NZjA1UbhMdgAscnS5dsmy+Q7bWrQ6tsTZ/o+6N/T5cbjoBHOdpypXJI3y/PiJTDJaQtXIhLa8gFg/EvxMnMz/KG9skADW1361JmfCc4BxicQIO2IOOe6eilPr+YsnOwiHwL0vpUnuty39cppuMWVD25GzxXlS6KQsLCvXLzxLLuNnGC43UAM0q4UwQxDtAZEK1dH2o3HMWhgMP2qEQupc24dbhpO3ecxh2C9678a3oGDuDuNf7mLp3s7ptj5qF3onitpJ82U5o7VajaHoygMaSRFeWxP2c13eM57j3bLdLwxVXFhePcKXARu1iuFTLS5uUf3hN6MkQcOGw=="+	, host "wren.kitenet.net"+		& ipv4 "80.68.85.49"+		& ipv6 "2001:41c8:125:49::10"+		& alias "kite.kitenet.net"+	, host "branchable.com"+		& ipv4 "66.228.46.55"+		& ipv6 "2600:3c03::f03c:91ff:fedf:c0e5"+		& alias "olduse.net"+		& alias "www.olduse.net"+		& alias "git.olduse.net" 	]

@@ -1,3 +1,18 @@+propellor (0.4.0) unstable; urgency=medium++  * Propellor can configure primary DNS servers, including generating+    zone files, which is done by looking at the properties of hosts+    in a domain.+  * The `cname` property was renamed to `alias` as it does not always+    generate CNAME in the DNS.+  * Constructor of Property has changed (use `property` function instead).+  * All Property combinators now combine together their Attr settings.+    So Attr settings can be made inside a propertyList, for example.+  * Run all cron jobs under chronic from moreutils to avoid unnecessary+    mails.++ -- Joey Hess <joeyh@debian.org>  Sat, 19 Apr 2014 02:09:56 -0400+ propellor (0.3.1) unstable; urgency=medium    * Merge scheduler bug fix from git-annex.

@@ -1,5 +1,5 @@ Name: propellor-Version: 0.3.1+Version: 0.4.0 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess <joey@kitenet.net>@@ -99,6 +99,7 @@     Propellor.Exception     Propellor.Types     Propellor.Types.OS+    Propellor.Types.Dns   Other-Modules:     Propellor.Types.Attr     Propellor.CmdLine