Merge branch 'joeyconfig'

9 files changed, 107 insertions, 27 deletions

diff --git a/Makefile b/Makefile
index e53de8c5..7f4833fc 100644
--- a/Makefile
+++ b/Makefile
@@ -11,7 +11,7 @@ build: dist/setup-config
 
 deps:
 	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install gnupg ghc cabal-install libghc-missingh-dev libghc-ansi-terminal-dev libghc-ifelse-dev libghc-unix-compat-dev libghc-hslogger-dev libghc-network-dev libghc-quickcheck2-dev libghc-mtl-dev libghc-monadcatchio-transformers-dev; fi || true
-	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev || cabal update; cabal install async; fi || true
+	@if [ $$(whoami) = root ]; then apt-get --no-upgrade --no-install-recommends -y install libghc-async-dev || (cabal update; cabal install async); fi || true
 
 dist/setup-config: propellor.cabal
 	if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi
diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index acaf28db..98cfc64d 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -59,7 +59,7 @@ addNamedConf conf d = d { _namedconf = new }
   where
 	m = _namedconf d
 	domain = confDomain conf
-	new = case (confType conf, confType <$> M.lookup domain m) of
+	new = case (confDnsServerType conf, confDnsServerType <$> M.lookup domain m) of
 		(Secondary, Just Master) -> m
 		_  -> M.insert domain conf m
 
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
index 5be91c4f..ad04abe6 100644
--- a/Propellor/CmdLine.hs
+++ b/Propellor/CmdLine.hs
@@ -10,6 +10,7 @@ import System.Log.Handler.Simple
 import System.PosixCompat
 import Control.Exception (bracket)
 import System.Posix.IO
+import Data.Time.Clock.POSIX
 
 import Propellor
 import qualified Propellor.Property.Docker as Docker
@@ -346,14 +347,37 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
 				setLevel DEBUG .  setHandlers [f]
 	go _ = noop
 
--- Parameters can be passed to both ssh and scp.
+-- Parameters can be passed to both ssh and scp, to enable a ssh connection
+-- caching socket.
+--
+-- If the socket already exists, check if its mtime is older than 10
+-- minutes, and if so stop that ssh process, in order to not try to
+-- use an old stale connection. (atime would be nicer, but there's
+-- a good chance a laptop uses noatime)
 sshCachingParams :: HostName -> IO [CommandParam]
 sshCachingParams hn = do
 	home <- myHomeDir
 	let cachedir = home </> ".ssh" </> "propellor"
 	createDirectoryIfMissing False cachedir
 	let socketfile = cachedir </> hn ++ ".sock"
-	return
+	let ps = 
 		[ Param "-o", Param ("ControlPath=" ++ socketfile)
 		, Params "-o ControlMaster=auto -o ControlPersist=yes"
 		]
+
+	maybe noop (expireold ps socketfile)
+		=<< catchMaybeIO (getFileStatus socketfile)
+	
+	return ps
+		
+  where
+	expireold ps f s = do
+		now <- truncate <$> getPOSIXTime :: IO Integer
+		if modificationTime s > fromIntegral now - tenminutes
+			then touchFile f
+			else do
+				void $ boolSystem "ssh" $
+					[ Params "-O stop" ] ++ ps ++
+					[ Param "localhost" ]
+				nukeFile f
+	tenminutes = 600
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 40cadb6d..5c3162cb 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -40,6 +40,17 @@ import Data.List
 -- that cannot be configured elsewhere. This often includes NS records,
 -- TXT records and perhaps CNAMEs pointing at hosts that propellor does
 -- not control.
+--
+-- The primary server is configured to only allow zone transfers to
+-- secondary dns servers. These are determined in two ways:
+--
+-- 1. By looking at the properties of other hosts, to find hosts that
+-- are configured as the secondary dns server.
+--
+-- 2. By looking for NS Records in the passed list of records.
+--
+-- In either case, the secondary dns server Host should have an ipv4 and/or
+-- ipv6 property defined.
 primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
 primary hosts domain soa rs = RevertableProperty setup cleanup
   where
@@ -52,22 +63,31 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
 			`requires` namedConfWritten
 			`onChange` Service.reloaded "bind9"
 
-	(partialzone, warnings) = genZone hosts domain soa
+	(partialzone, zonewarnings) = 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
+		mapM_ warningMessage $ zonewarnings ++ secondarywarnings
 		satisfy
 	conf = NamedConf
 		{ confDomain = domain
-		, confType = Master
+		, confDnsServerType = Master
 		, confFile = zonefile
 		, confMasters = []
+		, confAllowTransfer = nub $
+			concatMap (\h -> hostAddresses h hosts) $
+				secondaries ++ nssecondaries
 		, confLines = []
 		}
+	secondaries = otherServers Secondary hosts domain
+	secondarywarnings = map (\h -> "No IP address defined for DNS seconary " ++ h) $
+		filter (\h -> null (hostAddresses h hosts)) secondaries
+	nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
+	rootRecords = map snd $
+		filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
 	needupdate = do
 		v <- readZonePropellorFile zonefile
 		return $ case v of
@@ -86,12 +106,7 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
 -- 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 -> RevertableProperty
-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
+secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
 
 -- | This variant is useful if the primary server does not have its DNS
 -- configured via propellor.
@@ -105,12 +120,22 @@ secondaryFor masters hosts domain = RevertableProperty setup cleanup
  	desc = "dns secondary for " ++ domain
 	conf = NamedConf
 		{ confDomain = domain
-		, confType = Secondary
+		, confDnsServerType = Secondary
 		, confFile = "db." ++ domain
 		, confMasters = concatMap (\m -> hostAddresses m hosts) masters
-		, confLines = ["allow-transfer { }"]
+		, confAllowTransfer = []
+		, confLines = []
 		}
 
+otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
+otherServers wantedtype hosts domain =
+	M.keys $ M.filter wanted $ hostAttrMap hosts
+  where
+	wanted attr = case M.lookup domain (_namedconf attr) of
+		Nothing -> False
+		Just conf -> confDnsServerType conf == wantedtype
+			&& confDomain conf == domain
+
 -- | Rewrites the whole named.conf.local file to serve the zones
 -- configured by `primary` and `secondary`, and ensures that bind9 is
 -- running.
@@ -130,20 +155,26 @@ confStanza :: NamedConf -> [Line]
 confStanza c =
 	[ "// automatically generated by propellor"
 	, "zone \"" ++ confDomain c ++ "\" {"
-	, cfgline "type" (if confType c == Master then "master" else "slave")
+	, cfgline "type" (if confDnsServerType c == Master then "master" else "slave")
 	, cfgline "file" ("\"" ++ confFile c ++ "\"")
 	] ++
-	(if null (confMasters c) then [] else mastersblock) ++
+	mastersblock ++
+	allowtransferblock ++
 	(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
 	[ "};"
 	, ""
 	]
   where
 	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
-	mastersblock =
-		[ "\tmasters {" ] ++
-		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
+	ipblock name l = 
+		[ "\t" ++ name ++ " {" ] ++
+		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
 		[ "\t};" ]
+	mastersblock
+		| null (confMasters c) = []
+		| otherwise = ipblock "masters" (confMasters c)
+	-- an empty block prohibits any transfers
+	allowtransferblock = ipblock "allow-transfer" (confAllowTransfer c)
 
 namedConfFile :: FilePath
 namedConfFile = "/etc/bind/named.conf.local"
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index 9b2ad1e7..ba6a92dd 100644
--- a/Propellor/Types/Dns.hs
+++ b/Propellor/Types/Dns.hs
@@ -1,5 +1,7 @@
 module Propellor.Types.Dns where
 
+import Propellor.Types.OS (HostName)
+
 import Data.Word
 
 type Domain = String
@@ -14,14 +16,15 @@ fromIPAddr (IPv6 addr) = addr
 -- | Represents a bind 9 named.conf file.
 data NamedConf = NamedConf
 	{ confDomain :: Domain
-	, confType :: Type
+	, confDnsServerType :: DnsServerType
 	, confFile :: FilePath
 	, confMasters :: [IPAddr]
+	, confAllowTransfer :: [IPAddr]
 	, confLines :: [String]
 	}
 	deriving (Show, Eq, Ord)
 
-data Type = Master | Secondary
+data DnsServerType = Master | Secondary
 	deriving (Show, Eq, Ord)
 
 -- | Represents a bind 9 zone file.
@@ -66,6 +69,10 @@ getCNAME :: Record -> Maybe BindDomain
 getCNAME (CNAME d) = Just d
 getCNAME _ = Nothing
 
+getNS :: Record -> Maybe BindDomain
+getNS (NS d) = Just d
+getNS _ = Nothing
+
 -- | Bind serial numbers are unsigned, 32 bit integers.
 type SerialNumber = Word32
 
@@ -78,3 +85,8 @@ type SerialNumber = Word32
 -- to add nameservers, MX's, etc to a domain.
 data BindDomain = RelDomain Domain | AbsDomain Domain | RootDomain
 	deriving (Read, Show, Eq, Ord)
+
+domainHostName :: BindDomain -> Maybe HostName
+domainHostName (RelDomain d) = Just d
+domainHostName (AbsDomain d) = Just d
+domainHostName RootDomain = Nothing
diff --git a/config-joey.hs b/config-joey.hs
index 842da803..254e810a 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -112,6 +112,7 @@ hosts =               --                  (o)  `
 		& Apache.modEnabled "ssl"
 		& Apache.multiSSL
 		& File.ownerGroup "/srv/web" "joey" "joey"
+		& Apt.installed ["analog"]
 
 		& alias "git.kitenet.net"
 		& alias "git.joeyh.name"
@@ -145,6 +146,8 @@ hosts =               --                  (o)  `
 	
 		& alias "ns3.branchable.com"
 		& branchableSecondary
+		
+		& Dns.secondaryFor ["animx"] hosts "animx.eu.org"
 
 
 	    --'                        __|II|      ,.
@@ -297,6 +300,8 @@ monsters =	      -- but do want to track their public keys etc.
 		& 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 "github.com" 
 		& sshPubKey "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="
+	, host "ns6.gandi.net"
+		& ipv4 "217.70.177.40"
 	, host "turtle.kitenet.net"
 		& ipv4 "67.223.19.96"
 		& ipv6 "2001:4978:f:2d9::2"
@@ -337,4 +342,7 @@ monsters =	      -- but do want to track their public keys etc.
 		& alias "l10n.ikiwiki.info"
 		& alias "dist-bugs.kitenet.net"
 		& alias "family.kitenet.net"
+	, host "animx"
+		& ipv4 "76.7.162.101"
+		& ipv4 "76.7.162.186"
 	]
diff --git a/debian/changelog b/debian/changelog
index 97ffa34f..8579097d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,13 @@
-propellor (0.5.1) UNRELEASED; urgency=medium
+propellor (0.5.1) unstable; urgency=medium
 
+  * Primary DNS servers now have allow-transfer automatically populated
+    with the IP addresses of secondary dns servers. So, it's important
+    that all secondary DNS servers have an ipv4 (and/or ipv6) property
+    configured.
+  * Deal with old ssh connection caching sockets.
   * Add missing build deps and deps. Closes: #745459
 
- -- Joey Hess <joeyh@debian.org>  Tue, 22 Apr 2014 19:07:59 -0400
+ -- Joey Hess <joeyh@debian.org>  Thu, 24 Apr 2014 18:09:58 -0400
 
 propellor (0.5.0) unstable; urgency=medium
 
diff --git a/propellor.cabal b/propellor.cabal
index 0d8ace05..30d61af9 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -1,5 +1,5 @@
 Name: propellor
-Version: 0.5.0
+Version: 0.5.1
 Cabal-Version: >= 1.6
 License: GPL
 Maintainer: Joey Hess <joey@kitenet.net>
@@ -35,7 +35,7 @@ Description:
 
 Executable propellor
   Main-Is: propellor.hs
-  GHC-Options: -Wall
+  GHC-Options: -Wall -threaded
   Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, 
    IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal,
    containers, network, async, time, QuickCheck, mtl,
diff --git a/propellor.hs b/propellor.hs
index e4653f30..c7727751 100644
--- a/propellor.hs
+++ b/propellor.hs
@@ -74,7 +74,7 @@ wrapper args propellordir propellorbin = do
 		void $ boolSystem "git" [Param "remote", Param "add", Param "upstream", Param srcrepo]
 		-- Connect synthetic git repo with upstream history so
 		-- merging with upstream will work going forward.
-		-- Note -s outs is used to avoid getting any divergent
+		-- Note -s ours is used to avoid getting any divergent
 		-- changes from upstream.
 		when fromsrcdir $ do
 			void $ boolSystem "git" [Param "fetch", Param "upstream"]