Merge branch 'joeyconfig'

9 files changed, 597 insertions, 56 deletions

diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index 00f1b0e9..1b89c008 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -43,11 +43,15 @@ ipv6 = addDNS . Address . IPv6
 -- problems with CNAMEs, and also means that when multiple hosts have the
 -- same alias, a DNS round-robin is automatically set up.
 alias :: Domain -> Property
-alias = addDNS . CNAME . AbsDomain
+alias d = pureInfoProperty ("alias " ++ d) $ mempty
+	{ _aliases = S.singleton d
+	-- A CNAME is added here, but the DNS setup code converts it to an
+	-- IP address when that makes sense.
+	, _dns = S.singleton $ CNAME $ AbsDomain d
+	} 
 
 addDNS :: Record -> Property
-addDNS r = pureInfoProperty (rdesc r) $
-	mempty { _dns = S.singleton r }
+addDNS r = pureInfoProperty (rdesc r) $ mempty { _dns = S.singleton r }
   where
 	rdesc (CNAME d) = unwords ["alias", ddesc d]
 	rdesc (Address (IPv4 addr)) = unwords ["ipv4", addr]
@@ -71,8 +75,15 @@ getSshPubKey = askInfo _sshPubKey
 hostMap :: [Host] -> M.Map HostName Host
 hostMap l = M.fromList $ zip (map hostName l) l 
 
+aliasMap :: [Host] -> M.Map HostName Host
+aliasMap = M.fromList . concat .
+	map (\h -> map (\aka -> (aka, h)) $ S.toList $ _aliases $ hostInfo h)
+
 findHost :: [Host] -> HostName -> Maybe Host
-findHost l hn = M.lookup hn (hostMap l)
+findHost l hn = maybe (findAlias l hn) Just (M.lookup hn (hostMap l))
+
+findAlias :: [Host] -> HostName -> Maybe Host
+findAlias l hn = M.lookup hn (aliasMap l)
 
 getAddresses :: Info -> [IPAddr]
 getAddresses = mapMaybe getIPAddr . S.toList . _dns
diff --git a/src/Propellor/Property/Apache.hs b/src/Propellor/Property/Apache.hs
index cf3e62cc..e6930893 100644
--- a/src/Propellor/Property/Apache.hs
+++ b/src/Propellor/Property/Apache.hs
@@ -10,20 +10,21 @@ type ConfigFile = [String]
 siteEnabled :: HostName -> ConfigFile -> RevertableProperty
 siteEnabled hn cf = RevertableProperty enable disable
   where
-	enable = trivial $ cmdProperty "a2ensite" ["--quiet", hn]
+	enable = trivial (cmdProperty "a2ensite" ["--quiet", hn])
 		`describe` ("apache site enabled " ++ hn)
 		`requires` siteAvailable hn cf
 		`requires` installed
 		`onChange` reloaded
-	disable = trivial $ File.notPresent (siteCfg hn)
-		`describe` ("apache site disabled " ++ hn)
+	disable = trivial $ combineProperties
+		("apache site disabled " ++ hn) 
+		(map File.notPresent (siteCfg hn))
 		`onChange` cmdProperty "a2dissite" ["--quiet", hn]
 		`requires` installed
 		`onChange` reloaded
 
 siteAvailable :: HostName -> ConfigFile -> Property
-siteAvailable hn cf = siteCfg hn `File.hasContent` (comment:cf)
-	`describe` ("apache site available " ++ hn)
+siteAvailable hn cf = combineProperties ("apache site available " ++ hn) $
+	map (`File.hasContent` (comment:cf)) (siteCfg hn)
   where
 	comment = "# deployed with propellor, do not modify"
 
@@ -39,8 +40,15 @@ modEnabled modname = RevertableProperty enable disable
 		`requires` installed
 		`onChange` reloaded
 
-siteCfg :: HostName -> FilePath
-siteCfg hn = "/etc/apache2/sites-available/" ++ hn
+-- This is a list of config files because different versions of apache
+-- use different filenames. Propellor simply writen them all.
+siteCfg :: HostName -> [FilePath]
+siteCfg hn =
+	-- Debian pre-2.4
+	[ "/etc/apache2/sites-available/" ++ hn
+	-- Debian 2.4+
+	, "/etc/apache2/sites-available/" ++ hn ++ ".conf"
+	] 
 
 installed :: Property
 installed = Apt.installed ["apache2"]
@@ -60,3 +68,19 @@ multiSSL = "/etc/apache2/conf.d/ssl" `File.hasContent`
 	]
 	`describe` "apache SNI enabled"
 	`onChange` reloaded
+
+-- | Config file fragment that can be inserted into a <Directory>
+-- stanza to allow global read access to the directory.
+--
+-- Works with multiple versions of apache that have different ways to do
+-- it.
+allowAll :: String
+allowAll = unlines
+	[ "<IfVersion < 2.4>"
+	, "Order allow,deny"
+	, "allow from all"
+	, "</IfVersion>"
+	, "<IfVersion >= 2.4>"
+	, "Require all granted"
+	, "</IfVersion>"
+	]
diff --git a/src/Propellor/Property/Cron.hs b/src/Propellor/Property/Cron.hs
index 5b070eff..d55c3dbb 100644
--- a/src/Propellor/Property/Cron.hs
+++ b/src/Propellor/Property/Cron.hs
@@ -4,6 +4,7 @@ import Propellor
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
 import Utility.SafeCommand
+import Utility.FileMode
 
 import Data.Char
 
@@ -19,22 +20,33 @@ type CronTimes = String
 --
 -- 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"
-	, ""
-	, "SHELL=/bin/sh"
-	, "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
-	, ""
-	, times ++ "\t" ++ user ++ "\t"
-		++ "chronic flock -n " ++ shellEscape cronjobfile
-		++ " sh -c " ++ shellEscape cmdline
+job desc times user cddir command = combineProperties ("cronned " ++ desc)
+	[ cronjobfile `File.hasContent`
+		[ "# Generated by propellor"
+		, ""
+		, "SHELL=/bin/sh"
+		, "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin"
+		, ""
+		, times ++ "\t" ++ user ++ "\tchronic " ++ shellEscape scriptfile
+		]
+	-- Use a separate script because it makes the cron job name 
+	-- prettier in emails, and also allows running the job manually.
+	, scriptfile `File.hasContent`
+		[ "#!/bin/sh"
+		, "# Generated by propellor"
+		, "set -e"
+		, "flock -n " ++ shellEscape cronjobfile
+			++ " sh -c " ++ shellEscape cmdline
+		]
+	, scriptfile `File.mode` combineModes (readModes ++ executeModes)
 	]
 	`requires` Apt.serviceInstalledRunning "cron"
 	`requires` Apt.installed ["util-linux", "moreutils"]
-	`describe` ("cronned " ++ desc)
   where
 	cmdline = "cd " ++ cddir ++ " && ( " ++ command ++ " )"
-	cronjobfile = "/etc/cron.d/" ++ map sanitize desc
+	cronjobfile = "/etc/cron.d/" ++ name
+	scriptfile = "/usr/local/bin/" ++ name ++ "_cronjob"
+	name = map sanitize desc
 	sanitize c
 		| isAlphaNum c = c
 		| otherwise = '_'
@@ -42,7 +54,7 @@ job desc times user cddir command = cronjobfile `File.hasContent`
 -- | Installs a cron job, and runs it niced and ioniced.
 niceJob :: Desc -> CronTimes -> UserName -> FilePath -> String -> Property
 niceJob desc times user cddir command = job desc times user cddir
-	("nice ionice -c 3 " ++ command)
+	("nice ionice -c 3 sh -c " ++ shellEscape command)
 
 -- | Installs a cron job to run propellor.
 runPropellor :: CronTimes -> Property
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 0e738f25..bc499e07 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -18,28 +18,32 @@ f `hasContent` newcontent = fileProperty ("replace " ++ f)
 -- The file's permissions are preserved if the file already existed.
 -- Otherwise, they're set to 600.
 hasPrivContent :: FilePath -> Context -> Property
-hasPrivContent f context = withPrivData (PrivFile f) context $ \getcontent -> 
-	property desc $ getcontent $ \privcontent -> 
-		ensureProperty $ fileProperty' writeFileProtected desc
-			(\_oldcontent -> lines privcontent) f
-  where
-	desc = "privcontent " ++ f
+hasPrivContent = hasPrivContent' writeFileProtected
 
--- | Leaves the file world-readable.
+-- | Leaves the file at its default or current mode,
+-- allowing "private" data to be read.
+--
+-- Use with caution!
 hasPrivContentExposed :: FilePath -> Context -> Property
-hasPrivContentExposed f context = hasPrivContent f context `onChange`
-	mode f (combineModes (ownerWriteMode:readModes))
+hasPrivContentExposed = hasPrivContent' writeFile
+
+hasPrivContent' :: (String -> FilePath -> IO ()) -> FilePath -> Context -> Property
+hasPrivContent' writer f context = 
+	withPrivData (PrivFile f) context $ \getcontent -> 
+		property desc $ getcontent $ \privcontent -> 
+			ensureProperty $ fileProperty' writer desc
+				(\_oldcontent -> lines privcontent) f
+  where
+	desc = "privcontent " ++ f
 
 -- | Ensures that a line is present in a file, adding it to the end if not.
 containsLine :: FilePath -> Line -> Property
 f `containsLine` l = f `containsLines` [l]
 
 containsLines :: FilePath -> [Line] -> Property
-f `containsLines` l = fileProperty (f ++ " contains:" ++ show l) go f
+f `containsLines` ls = fileProperty (f ++ " contains:" ++ show ls) go f
   where
-	go ls
-		| all (`elem` ls) l = ls
-		| otherwise = ls++l
+	go content = content ++ filter (`notElem` content) ls
 
 -- | Ensures that a line is not present in a file.
 -- Note that the file is ensured to exist, so if it doesn't, an empty
diff --git a/src/Propellor/Property/Hostname.hs b/src/Propellor/Property/Hostname.hs
index 1cce4e60..c489e2fb 100644
--- a/src/Propellor/Property/Hostname.hs
+++ b/src/Propellor/Property/Hostname.hs
@@ -3,10 +3,14 @@ module Propellor.Property.Hostname where
 import Propellor
 import qualified Propellor.Property.File as File
 
+import Data.List
+
 -- | Ensures that the hostname is set using best practices.
 --
 -- Configures /etc/hostname and the current hostname.
 --
+-- Configures /etc/mailname with the domain part of the hostname.
+--
 -- /etc/hosts is also configured, with an entry for 127.0.1.1, which is
 -- standard at least on Debian to set the FDQN.
 --
@@ -29,6 +33,8 @@ setTo hn = combineProperties desc go
 			else Just $ trivial $ hostsline "127.0.1.1" [hn, basehost]
 		, Just $ trivial $ hostsline "127.0.0.1" ["localhost"]
 		, Just $ trivial $ cmdProperty "hostname" [basehost]
+		, Just $ "/etc/mailname" `File.hasContent`
+			[if null domain then hn else domain]
 		]
 	
 	hostsline ip names = File.fileProperty desc
@@ -37,3 +43,21 @@ setTo hn = combineProperties desc go
 	addhostsline ip names ls =
 		(ip ++ "\t" ++ (unwords names)) : filter (not . hasip ip) ls
 	hasip ip l = headMaybe (words l) == Just ip
+
+-- | Makes /etc/resolv.conf contain search and domain lines for 
+-- the domain that the hostname is in.
+searchDomain :: Property
+searchDomain = property desc (ensureProperty . go =<< asks hostName)
+  where
+	desc = "resolv.conf search and domain configured"
+	go hn =
+		let (_basehost, domain) = separate (== '.') hn
+		in  File.fileProperty desc (use domain) "/etc/resolv.conf"
+	use domain ls = filter wanted $ nub (ls ++ cfgs)
+	  where
+		cfgs = ["domain " ++ domain, "search " ++ domain]
+		wanted l
+			| l `elem` cfgs = True
+			| "domain " `isPrefixOf` l = False
+			| "search " `isPrefixOf` l = False
+			| otherwise = True
diff --git a/src/Propellor/Property/Obnam.hs b/src/Propellor/Property/Obnam.hs
index 15a8494c..b5c6d776 100644
--- a/src/Propellor/Property/Obnam.hs
+++ b/src/Propellor/Property/Obnam.hs
@@ -33,8 +33,8 @@ data NumClients = OnlyClient | MultipleClients
 -- >		[ "--repository=sftp://2318@usw-s002.rsync.net/~/mygitrepos.obnam"
 -- >		, "--encrypt-with=1B169BE1"
 -- >		] Obnam.OnlyClient
--- >		`requires` Gpg.keyImported "1B169BE1" "root"
--- >		`requires` Ssh.keyImported SshRsa "root"
+-- >		`requires` Gpg.keyImported "1B169BE1" "root" 
+-- >		`requires` Ssh.keyImported SshRsa "root" (Context hostname)
 --
 -- How awesome is that?
 backup :: FilePath -> Cron.CronTimes -> [ObnamParam] -> NumClients -> Property
diff --git a/src/Propellor/Property/Postfix.hs b/src/Propellor/Property/Postfix.hs
index ef96e086..b3d12727 100644
--- a/src/Propellor/Property/Postfix.hs
+++ b/src/Propellor/Property/Postfix.hs
@@ -2,24 +2,120 @@ module Propellor.Property.Postfix where
 
 import Propellor
 import qualified Propellor.Property.Apt as Apt
+import Propellor.Property.File
+import qualified Propellor.Property.Service as Service
+
+import qualified Data.Map as M
+import Data.List
+import Data.Char
 
 installed :: Property
 installed = Apt.serviceInstalledRunning "postfix"
 
+restarted :: Property
+restarted = Service.restarted "postfix"
+
+reloaded :: Property
+reloaded = Service.reloaded "postfix"
+
 -- | Configures postfix as a satellite system, which 
--- relats all mail through a relay host, which defaults to smtp.domain. 
+-- relays all mail through a relay host, which defaults to smtp.domain. 
 --
 -- The smarthost may refuse to relay mail on to other domains, without
 -- futher coniguration/keys. But this should be enough to get cron job
 -- mail flowing to a place where it will be seen.
 satellite :: Property
-satellite = setup `requires` installed
+satellite = check (not <$> mainCfIsSet "relayhost") setup
+	`requires` installed
   where
 	setup = trivial $ property "postfix satellite system" $ do
 		hn <- asks hostName
-		ensureProperty $ Apt.reConfigure "postfix"
-			[ ("postfix/main_mailer_type", "select", "Satellite system")
-			, ("postfix/root_address", "string", "root")
-			, ("postfix/destinations", "string", " ")
-			, ("postfix/mailname", "string", hn)
+		let (_, domain) = separate (== '.') hn
+		ensureProperties 
+			[ Apt.reConfigure "postfix"
+				[ ("postfix/main_mailer_type", "select", "Satellite system")
+				, ("postfix/root_address", "string", "root")
+				, ("postfix/destinations", "string", " ")
+				, ("postfix/mailname", "string", hn)
+				]
+			, mainCf ("relayhost", domain)
+				`onChange` reloaded
 			]
+
+-- | Sets up a file by running a property (which the filename is passed
+-- to). If the setup property makes a change, postmap will be run on the
+-- file, and postfix will be reloaded.
+mappedFile :: FilePath -> (FilePath -> Property) -> Property
+mappedFile f setup = setup f
+	`onChange` cmdProperty "postmap" [f]
+
+-- | Run newaliases command, which should be done after changing
+-- /etc/aliases.
+newaliases :: Property
+newaliases = trivial $ cmdProperty "newaliases" []
+
+-- | The main config file for postfix.
+mainCfFile :: FilePath
+mainCfFile = "/etc/postfix/main.cf"
+
+-- | Sets a main.cf name=value pair. Does not reload postfix immediately.
+mainCf :: (String, String) -> Property
+mainCf (name, value) = check notset set
+		`describe` ("postfix main.cf " ++ setting)
+  where
+	setting = name ++ "=" ++ value
+	notset = (/= Just value) <$> getMainCf name
+	set = cmdProperty "postconf" ["-e", setting]
+
+-- | Gets a man.cf setting.
+getMainCf :: String -> IO (Maybe String)
+getMainCf name = parse . lines <$> readProcess "postconf" [name]
+  where
+	parse (l:_) = Just $ 
+		case separate (== '=') l of
+			(_, (' ':v)) -> v
+			(_, v) -> v
+	parse [] = Nothing
+
+-- | Checks if a main.cf field is set. A field that is set to "" 
+-- is considered not set.
+mainCfIsSet :: String -> IO Bool
+mainCfIsSet name = do
+	v <- getMainCf name
+	return $ v /= Nothing && v /= Just ""
+
+-- | Parses main.cf, and removes any initial configuration lines that are
+-- overridden to other values later in the file.
+--
+-- For example, to add some settings, removing any old settings:
+--
+-- > mainCf `File.containsLines`
+-- >	[ "# I like bars."
+-- >	, "foo = bar"
+-- >	] `onChange` dedupMainCf
+--
+-- Note that multiline configurations that continue onto the next line
+-- are not currently supported.
+dedupMainCf :: Property
+dedupMainCf = fileProperty "postfix main.cf dedupped" dedupCf mainCfFile
+
+dedupCf :: [String] -> [String]
+dedupCf ls =
+	let parsed = map parse ls
+	in dedup [] (keycounts $ rights parsed) parsed
+  where	
+	parse l
+		| "#" `isPrefixOf` l = Left l
+		| "=" `isInfixOf` l = 
+			let (k, v) = separate (== '=') l
+			in Right ((filter (not . isSpace) k), v)
+		| otherwise = Left l
+	fmt k v = k ++ " =" ++ v
+
+	keycounts = M.fromListWith (+) . map (\(k, _v) -> (k, (1 :: Integer)))
+
+	dedup c _ [] = reverse c
+	dedup c kc ((Left v):rest) = dedup (v:c) kc rest
+	dedup c kc ((Right (k, v)):rest) = case M.lookup k kc of
+		Just n | n > 1 -> dedup c (M.insert k (n - 1) kc) rest
+		_ -> dedup (fmt k v:c) kc rest
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index c770907b..fa8773de 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -14,12 +14,14 @@ import qualified Propellor.Property.Service as Service
 import qualified Propellor.Property.User as User
 import qualified Propellor.Property.Obnam as Obnam
 import qualified Propellor.Property.Apache as Apache
+import qualified Propellor.Property.Postfix as Postfix
 import Utility.SafeCommand
 import Utility.FileMode
 import Utility.Path
 
 import Data.List
 import System.Posix.Files
+import Data.String.Utils
 
 oldUseNetServer :: [Host] -> Property
 oldUseNetServer hosts = propertyList ("olduse.net server")
@@ -59,9 +61,7 @@ oldUseNetServer hosts = propertyList ("olduse.net server")
 		, "  <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"
+		, Apache.allowAll
 		, "  </Directory>"
 		]
 	]
@@ -114,11 +114,11 @@ mumbleServer hosts = combineProperties hn
 	[ Apt.serviceInstalledRunning "mumble-server"
 	, Obnam.latestVersion
 	, Obnam.backup "/var/lib/mumble-server" "55 5 * * *"
-		[ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/" ++ hn ++ ".obnam"
+		[ "--repository=sftp://joey@usbackup.kitenet.net/~/lib/backup/" ++ hn ++ ".obnam"
 		, "--client-name=mumble"
 		] Obnam.OnlyClient
 		`requires` Ssh.keyImported SshRsa "root" (Context hn)
-		`requires` Ssh.knownHost hosts "turtle.kitenet.net" "root"
+		`requires` Ssh.knownHost hosts "usbackup.kitenet.net" "root"
 	, trivial $ cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
 	]
   where
@@ -142,7 +142,7 @@ gitServer hosts = propertyList "git.kitenet.net setup"
 	, Obnam.backup "/srv/git" "33 3 * * *"
 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/git.kitenet.net"
 		, "--encrypt-with=1B169BE1"
-		, "--client-name=wren"
+		, "--client-name=wren" -- historical
 		] Obnam.OnlyClient
 		`requires` Gpg.keyImported "1B169BE1" "root"
 		`requires` Ssh.keyImported SshRsa "root" (Context "git.kitenet.net")
@@ -191,8 +191,8 @@ gitServer hosts = propertyList "git.kitenet.net setup"
 type AnnexUUID = String
 
 -- | A website, with files coming from a git-annex repository.
-annexWebSite :: [Host] -> Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property
-annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using git-annex")
+annexWebSite :: Git.RepoUrl -> HostName -> AnnexUUID -> [(String, Git.RepoUrl)] -> Property
+annexWebSite origin hn uuid remotes = propertyList (hn ++" website using git-annex")
 	[ Git.cloned "joey" origin dir Nothing
 		`onChange` setup
 	, postupdatehook `File.hasContent`
@@ -206,8 +206,6 @@ annexWebSite hosts origin hn uuid remotes = propertyList (hn ++" website using g
 	dir = "/srv/web/" ++ hn
 	postupdatehook = dir </> ".git/hooks/post-update"
 	setup = userScriptProperty "joey" setupscript
-		`requires` Ssh.keyImported SshRsa "joey" (Context hn)
-		`requires` Ssh.knownHost hosts "turtle.kitenet.net" "joey"
 	setupscript = 
 		[ "cd " ++ shellEscape dir
 		, "git config annex.uuid " ++ shellEscape uuid
@@ -348,8 +346,27 @@ githubBackup = propertyList "github-backup box"
 	, let f = "/home/joey/.github-keys"
 	  in File.hasPrivContent f anyContext
 		`onChange` File.ownerGroup f "joey" "joey"
+	, Cron.niceJob "github-backup run" "30 4 * * *" "joey"
+		"/home/joey/lib/backup" $ intercalate "&&"
+			[ "mkdir -p github"
+			, "cd github"
+			, ". $HOME/.github-keys && github-backup joeyh"
+			]
 	]
 
+rsyncNetBackup :: [Host] -> Property
+rsyncNetBackup hosts = Cron.niceJob "rsync.net copied in daily" "30 5 * * *"
+	"joey" "/home/joey/lib/backup" "mkdir -p rsync.net && rsync --delete -az 2318@usw-s002.rsync.net: rsync.net"
+	`requires` Ssh.knownHost hosts "usw-s002.rsync.net" "joey"
+
+backupsBackedupTo :: [Host] -> HostName -> FilePath -> Property
+backupsBackedupTo hosts desthost destdir = Cron.niceJob desc
+	"1 1 * * 3" "joey" "/" cmd
+	`requires` Ssh.knownHost hosts desthost "joey"
+  where
+	desc = "backups copied to " ++ desthost ++ " weekly"
+	cmd = "rsync -az --delete /home/joey/lib/backup " ++ desthost ++ ":" ++ destdir
+
 obnamRepos :: [String] -> Property
 obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
 	(mkbase : map mkrepo rs)
@@ -360,3 +377,354 @@ obnamRepos rs = propertyList ("obnam repos for " ++ unwords rs)
 	mkdir d = File.dirExists d
 		`before` File.ownerGroup d "joey" "joey"
 
+podcatcher :: Property
+podcatcher = Cron.niceJob "podcatcher run hourly" "55 * * * *"
+	"joey" "/home/joey/lib/sound/podcasts"
+	"xargs git-annex importfeed -c annex.genmetadata=true < feeds; mr --quiet update"
+	`requires` Apt.installed ["git-annex", "myrepos"]
+
+kiteMailServer :: Property
+kiteMailServer = propertyList "kitenet.net mail server"
+	[ Postfix.installed
+	, Apt.installed ["postfix-pcre"]
+	, Apt.serviceInstalledRunning "postgrey"
+
+	, Apt.serviceInstalledRunning "spamassassin"
+	, "/etc/default/spamassassin" `File.containsLines`
+		[ "# Propellor deployed"
+		, "ENABLED=1"
+		, "CRON=1"
+		, "OPTIONS=\"--create-prefs --max-children 5 --helper-home-dir\""
+		, "CRON=1"
+		, "NICE=\"--nicelevel 15\""
+		] `onChange` Service.restarted "spamassassin"
+		`describe` "spamd enabled"
+		`requires` Apt.serviceInstalledRunning "cron"
+	
+	, Apt.serviceInstalledRunning "spamass-milter"
+	-- Add -m to prevent modifying messages Subject or body.
+	, "/etc/default/spamass-milter" `File.containsLine`
+		"OPTIONS=\"-m -u spamass-milter -i 127.0.0.1\""
+		`onChange` Service.restarted "spamass-milter"
+		`describe` "spamass-milter configured"
+	
+	, Apt.serviceInstalledRunning "amavisd-milter"
+	, "/etc/default/amavisd-milter" `File.containsLines`
+		[ "# Propellor deployed"
+		, "MILTERSOCKET=/var/spool/postfix/amavis/amavis.sock"
+		, "MILTERSOCKETOWNER=\"postfix:postfix\""
+		, "MILTERSOCKETMODE=\"0660\""
+		]
+		`onChange` Service.restarted "amavisd-milter"
+		`describe` "amavisd-milter configured for postfix"
+	, Apt.serviceInstalledRunning "clamav-freshclam"
+
+	, Apt.installed ["maildrop"]
+	, "/etc/maildroprc" `File.hasContent`
+		[ "# Global maildrop filter file (deployed with propellor)"
+		, "DEFAULT=\"$HOME/Maildir\""
+		, "MAILBOX=\"$DEFAULT/.\""
+		, "# Filter spam to a spam folder, unless .keepspam exists"
+		, "if (/^X-Spam-Status: Yes/)"
+		, "{"
+		, "  `test -e \"$HOME/.keepspam\"`"
+		, "  if ( $RETURNCODE != 0 )"
+		, "  to ${MAILBOX}spam"
+		, "}"
+		]
+		`describe` "maildrop configured"
+
+	, "/etc/aliases" `File.hasPrivContentExposed` ctx
+		`onChange` Postfix.newaliases
+	, hasJoeyCAChain
+	, "/etc/ssl/certs/postfix.pem" `File.hasPrivContentExposed` ctx
+	, "/etc/ssl/private/postfix.pem" `File.hasPrivContent` ctx
+
+	, "/etc/postfix/mydomain" `File.containsLines`
+		[ "/.*\\.kitenet\\.net/\tOK"
+		, "/ikiwiki\\.info/\tOK"
+		, "/joeyh\\.name/\tOK"
+		]
+		`onChange` Postfix.reloaded
+		`describe` "postfix mydomain file configured"
+	, "/etc/postfix/obscure_client_relay.pcre" `File.containsLine`
+		"/^Received: from ([^.]+)\\.kitenet\\.net.*using TLS.*by kitenet\\.net \\(([^)]+)\\) with (E?SMTPS?A?) id ([A-F[:digit:]]+)(.*)/ IGNORE"
+		`onChange` Postfix.reloaded
+		`describe` "postfix obscure_client_relay file configured"
+	, Postfix.mappedFile "/etc/postfix/virtual"
+		(flip File.containsLines
+			[ "# *@joeyh.name to joey"
+			, "@joeyh.name\tjoey"
+			]
+		) `describe` "postfix virtual file configured"
+		`onChange` Postfix.reloaded
+	, Postfix.mappedFile "/etc/postfix/relay_clientcerts" $
+		flip File.hasPrivContentExposed ctx
+	, Postfix.mainCfFile `File.containsLines`
+		[ "myhostname = kitenet.net"
+		, "mydomain = $myhostname"
+		, "append_dot_mydomain = no"
+		, "myorigin = kitenet.net"
+		, "mydestination = $myhostname, localhost.$mydomain, $mydomain, kite.$mydomain., localhost, regexp:$config_directory/mydomain"
+		, "mailbox_command = maildrop"
+		, "virtual_alias_maps = hash:/etc/postfix/virtual"
+
+		, "# Allow clients with trusted certs to relay mail through."
+		, "relay_clientcerts = hash:/etc/postfix/relay_clientcerts"
+		, "smtpd_relay_restrictions = permit_mynetworks,permit_tls_clientcerts,permit_sasl_authenticated,reject_unauth_destination"
+
+		, "# Filter out client relay lines from headers."
+		, "header_checks = pcre:$config_directory/obscure_client_relay.pcre"
+
+		, "# Enable postgrey."
+		, "smtpd_recipient_restrictions = permit_mynetworks,reject_unauth_destination,check_policy_service inet:127.0.0.1:10023"
+
+		, "# Enable spamass-milter and amavis-milter."
+		, "smtpd_milters = unix:/spamass/spamass.sock unix:amavis/amavis.sock"
+		, "milter_connect_macros = j {daemon_name} v {if_name} _"
+
+		, "# TLS setup -- server"
+		, "smtpd_tls_CAfile = /etc/ssl/certs/joeyca.pem"
+		, "smtpd_tls_cert_file = /etc/ssl/certs/postfix.pem"
+		, "smtpd_tls_key_file = /etc/ssl/private/postfix.pem"
+		, "smtpd_tls_loglevel = 1"
+		, "smtpd_tls_received_header = yes"
+		, "smtpd_use_tls = yes"
+		, "smtpd_tls_ask_ccert = yes"
+		, "smtpd_tls_session_cache_database = sdbm:/etc/postfix/smtpd_scache"
+
+		, "# TLS setup -- client"
+		, "smtp_tls_CAfile = /etc/ssl/certs/joeyca.pem"
+		, "smtp_tls_cert_file = /etc/ssl/certs/postfix.pem"
+		, "smtp_tls_key_file = /etc/ssl/private/postfix.pem"
+		, "smtp_tls_loglevel = 1"
+		, "smtp_use_tls = yes"
+		, "smtp_tls_session_cache_database = sdbm:/etc/postfix/smtp_scache"
+		]
+		`onChange` Postfix.dedupMainCf
+		`onChange` Postfix.reloaded
+		`describe` "postfix configured"
+	
+	, Apt.serviceInstalledRunning "dovecot-imapd"
+	, Apt.serviceInstalledRunning "dovecot-pop3d"
+	, "/etc/dovecot/conf.d/10-mail.conf" `File.containsLine`
+		"mail_location = maildir:~/Maildir"
+		`onChange` Service.reloaded "dovecot"
+		`describe` "dovecot mail.conf"
+	, "/etc/dovecot/conf.d/10-auth.conf" `File.containsLine`
+		"!include auth-passwdfile.conf.ext"
+		`onChange` Service.restarted "dovecot"
+		`describe` "dovecot auth.conf"
+	, File.hasPrivContent dovecotusers ctx
+		`onChange` (dovecotusers `File.mode`
+			combineModes [ownerReadMode, groupReadMode])
+	, File.ownerGroup dovecotusers "root" "dovecot"
+
+	, Apt.installed ["mutt", "bsd-mailx", "alpine"]
+
+	, pinescript `File.hasContent`
+		[ "#!/bin/sh"
+		, "# deployed with propellor"
+		, "set -e"
+		, "pass=$HOME/.pine-password"
+		, "if [ ! -e $pass ]; then"
+		, "\ttouch $pass"
+		, "fi"
+		, "chmod 600 $pass"
+		, "exec alpine -passfile $pass \"$@\""
+		]
+		`onChange` (pinescript `File.mode`
+			combineModes (readModes ++ executeModes))
+		`describe` "pine wrapper script"
+	, "/etc/pine.conf" `File.containsLines`
+		[ "inbox-path={localhost/novalidate-cert}inbox"
+		]
+		`describe` "pine configured to use local imap server"
+	]
+  where
+	ctx = Context "kitenet.net"
+	pinescript = "/usr/local/bin/pine"
+	dovecotusers = "/etc/dovecot/users"
+
+hasJoeyCAChain :: Property
+hasJoeyCAChain = "/etc/ssl/certs/joeyca.pem" `File.hasPrivContentExposed`
+	Context "joeyca.pem"
+
+kitenetHttps :: Property
+kitenetHttps = propertyList "kitenet.net https certs"
+	[ File.hasPrivContent "/etc/ssl/certs/web.pem" ctx
+	, File.hasPrivContent "/etc/ssl/private/web.pem" ctx
+	, File.hasPrivContent "/etc/ssl/certs/startssl.pem" ctx
+	, toProp $ Apache.modEnabled "ssl"
+	]
+  where
+	ctx = Context "kitenet.net"
+
+-- Legacy static web sites and redirections from kitenet.net to newer
+-- sites.
+legacyWebSites :: Property
+legacyWebSites = propertyList "legacy web sites"
+	[ Apt.serviceInstalledRunning "apache2"
+	, toProp $ Apache.modEnabled "rewrite"
+	, toProp $ Apache.modEnabled "cgi"
+	, toProp $ Apache.modEnabled "speling"
+	, userDirHtml
+	, kitenetHttps
+	, toProp $ Apache.siteEnabled "kitenet.net" $ apachecfg "kitenet.net" True
+		-- /var/www is empty
+		[ "DocumentRoot /var/www"
+		, "<Directory /var/www>"
+		, "  Options Indexes FollowSymLinks MultiViews ExecCGI Includes"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+		, "ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/"
+
+		-- for mailman cgi scripts
+		, "<Directory /usr/lib/cgi-bin>"
+		, "  AllowOverride None"
+		, "  Options ExecCGI"
+		, Apache.allowAll
+		, "</Directory>"
+		, "Alias /pipermail/ /var/lib/mailman/archives/public/"
+		, "<Directory /var/lib/mailman/archives/public/>"
+		, "  Options Indexes MultiViews FollowSymlinks"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+		, "Alias /images/ /usr/share/images/"
+		, "<Directory /usr/share/images/>"
+		, "  Options Indexes MultiViews"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+
+		, "RewriteEngine On"
+		, "# Force hostname to kitenet.net"
+		, "RewriteCond %{HTTP_HOST} !^kitenet\\.net [NC]"
+		, "RewriteCond %{HTTP_HOST} !^$"
+		, "RewriteRule ^/(.*) http://kitenet\\.net/$1 [L,R]"
+
+		, "# Moved pages"
+		, "RewriteRule /programs/debhelper http://joeyh.name/code/debhelper/ [L]"
+		, "RewriteRule /programs/satutils http://joeyh.name/code/satutils/ [L]"
+		, "RewriteRule /programs/filters http://joeyh.name/code/filters/ [L]"
+		, "RewriteRule /programs/ticker http://joeyh.name/code/ticker/ [L]"
+		, "RewriteRule /programs/pdmenu http://joeyh.name/code/pdmenu/ [L]"
+		, "RewriteRule /programs/sleepd http://joeyh.name/code/sleepd/ [L]"
+		, "RewriteRule /programs/Lingua::EN::Words2Nums http://joeyh.name/code/Words2Nums/ [L]"
+		, "RewriteRule /programs/wmbattery http://joeyh.name/code/wmbattery/ [L]"
+		, "RewriteRule /programs/dpkg-repack http://joeyh.name/code/dpkg-repack/ [L]"
+		, "RewriteRule /programs/debconf http://joeyh.name/code/debconf/ [L]"
+		, "RewriteRule /programs/perlmoo http://joeyh.name/code/perlmoo/ [L]"
+		, "RewriteRule /programs/alien http://joeyh.name/code/alien/ [L]"
+		, "RewriteRule /~joey/blog/entry/(.+)-[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9].html http://joeyh.name/blog/entry/$1/ [L]"
+		, "RewriteRule /~anna/.* http://waldeneffect\\.org/ [R]"
+		, "RewriteRule /~anna/.* http://waldeneffect\\.org/ [R]"
+		, "RewriteRule /~anna http://waldeneffect\\.org/ [R]"
+		, "RewriteRule /simpleid/ http://openid.kitenet.net:8081/simpleid/"
+		, "# Even the kite home page is not here any more!"
+		, "RewriteRule ^/$ http://www.kitenet.net/ [R]"
+		, "RewriteRule ^/index.html http://www.kitenet.net/ [R]"
+		, "RewriteRule ^/joey http://www.kitenet.net/joey/ [R]"
+		, "RewriteRule ^/joey/index.html http://www.kitenet.net/joey/ [R]"
+		, "RewriteRule ^/wifi http://www.kitenet.net/wifi/ [R]"
+		, "RewriteRule ^/wifi/index.html http://www.kitenet.net/wifi/ [R]"
+		
+		, "# Old ikiwiki filenames for kitenet.net wiki."
+		, "rewritecond $1 !^/~"
+		, "rewritecond $1 !^/doc/"
+		, "rewritecond $1 !^/pipermail/"
+		, "rewritecond $1 !^/cgi-bin/"
+		, "rewritecond $1 !.*/index$"
+		, "rewriterule (.+).html$ $1/ [r]"
+
+		, "# Old ikiwiki filenames for joey's wiki."
+		, "rewritecond $1 ^/~joey/"
+		, "rewritecond $1 !.*/index$"
+		, "rewriterule (.+).html$ http://kitenet.net/$1/ [L,R]"
+
+		, "# ~joey to joeyh.name"
+		, "rewriterule /~joey/(.*) http://joeyh.name/$1 [L]"
+
+		, "# Old familywiki location."
+		, "rewriterule /~family/(.*).html http://family.kitenet.net/$1 [L]"
+		, "rewriterule /~family/(.*).rss http://family.kitenet.net/$1/index.rss [L]"
+		, "rewriterule /~family(.*) http://family.kitenet.net$1 [L]"
+
+		, "rewriterule /~kyle/bywayofscience(.*) http://bywayofscience.branchable.com$1 [L]"
+		, "rewriterule /~kyle/family/wiki/(.*).html http://macleawiki.branchable.com/$1 [L]"
+		, "rewriterule /~kyle/family/wiki/(.*).rss http://macleawiki.branchable.com/$1/index.rss [L]"
+		, "rewriterule /~kyle/family/wiki(.*) http://macleawiki.branchable.com$1 [L]"
+		]
+	, alias "anna.kitenet.net"
+	, toProp $ Apache.siteEnabled "anna.kitenet.net" $ apachecfg "anna.kitenet.net" False
+		[ "DocumentRoot /home/anna/html"
+		, "<Directory /home/anna/html/>"
+		, "  Options Indexes ExecCGI"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+		]
+	, alias "sows-ear.kitenet.net"
+	, alias "www.sows-ear.kitenet.net"
+	, toProp $ Apache.siteEnabled "sows-ear.kitenet.net" $ apachecfg "sows-ear.kitenet.net" False
+		[ "ServerAlias www.sows-ear.kitenet.net"
+		, "DocumentRoot /srv/web/sows-ear.kitenet.net"
+		, "<Directory /srv/web/sows-ear.kitenet.net>"
+		, "  Options FollowSymLinks"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+		]
+	, alias "wortroot.kitenet.net"
+	, alias "www.wortroot.kitenet.net"
+	, toProp $ Apache.siteEnabled "wortroot.kitenet.net" $ apachecfg "wortroot.kitenet.net" False
+		[ "ServerAlias www.wortroot.kitenet.net"
+		, "DocumentRoot /srv/web/wortroot.kitenet.net"
+		, "<Directory /srv/web/wortroot.kitenet.net>"
+		, "  Options FollowSymLinks"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+		]
+	, alias "creeksidepress.com"
+	, toProp $ Apache.siteEnabled "creeksidepress.com" $ apachecfg "creeksidepress.com" False
+		[ "ServerAlias www.creeksidepress.com"
+		, "DocumentRoot /srv/web/www.creeksidepress.com"
+		, "<Directory /srv/web/www.creeksidepress.com>"
+		, "  Options FollowSymLinks"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+		]
+	, alias "joey.kitenet.net"
+	, toProp $ Apache.siteEnabled "joey.kitenet.net" $ apachecfg "joey.kitenet.net" False
+		[ "DocumentRoot /home/joey/html"
+		, "<Directory /home/joey/html/>"
+		, "  Options Indexes ExecCGI"
+		, "  AllowOverride None"
+		, Apache.allowAll
+		, "</Directory>"
+
+		, "RewriteEngine On"
+
+		, "# Old ikiwiki filenames for joey's wiki."
+		, "rewritecond $1 !.*/index$"
+		, "rewriterule (.+).html$ http://joeyh.name/$1/ [l]"
+
+		, "rewritecond $1 !.*/index$"
+		, "rewriterule (.+).rss$ http://joeyh.name/$1/index.rss [l]"
+		
+		, "# Redirect all to joeyh.name."
+		, "rewriterule (.*) http://joeyh.name$1 [r]"
+		]
+	]
+
+userDirHtml :: Property
+userDirHtml = File.fileProperty "apache userdir is html" (map munge) conf
+	`onChange` Apache.reloaded
+	`requires` (toProp $ Apache.modEnabled "userdir")
+  where
+	munge = replace "public_html" "html"
+	conf = "/etc/apache2/mods-available/userdir.conf"
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index 8856e06f..de072aa0 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -12,6 +12,7 @@ data Info = Info
 	{ _os :: Val System
 	, _privDataFields :: S.Set (PrivDataField, Context)
 	, _sshPubKey :: Val String
+	, _aliases :: S.Set HostName
 	, _dns :: S.Set Dns.Record
 	, _namedconf :: Dns.NamedConfMap
 	, _dockerinfo :: DockerInfo
@@ -19,11 +20,12 @@ data Info = Info
 	deriving (Eq, Show)
 
 instance Monoid Info where
-	mempty = Info mempty mempty mempty mempty mempty mempty
+	mempty = Info mempty mempty mempty mempty mempty mempty mempty
 	mappend old new = Info
 		{ _os = _os old <> _os new
 		, _privDataFields = _privDataFields old <> _privDataFields new
 		, _sshPubKey = _sshPubKey old <> _sshPubKey new
+		, _aliases = _aliases old <> _aliases new
 		, _dns = _dns old <> _dns new
 		, _namedconf = _namedconf old <> _namedconf new
 		, _dockerinfo = _dockerinfo old <> _dockerinfo new