diff --git a/Makefile b/Makefile index e53de8c..7f4833f 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 acaf28d..98cfc64 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 5be91c4..ad04abe 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 40cadb6..5c3162c 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 9b2ad1e..ba6a92d 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 842da80..254e810 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 97ffa34..8579097 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 Tue, 22 Apr 2014 19:07:59 -0400 + -- Joey Hess Thu, 24 Apr 2014 18:09:58 -0400 propellor (0.5.0) unstable; urgency=medium diff --git a/propellor.cabal b/propellor.cabal index 0d8ace0..30d61af 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 @@ -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 e4653f3..c772775 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"]