summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/Attr.hs2
-rw-r--r--Propellor/CmdLine.hs28
-rw-r--r--Propellor/Property/Dns.hs65
-rw-r--r--Propellor/Property/SiteSpecific/JoeySites.hs31
-rw-r--r--Propellor/SimpleSh.hs4
-rw-r--r--Propellor/Types/Dns.hs16
6 files changed, 119 insertions, 27 deletions
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 73d427c0..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,19 +120,29 @@ 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.
servingZones :: Property
servingZones = namedConfWritten
- `requires` Apt.serviceInstalledRunning "bind9"
`onChange` Service.reloaded "bind9"
+ `requires` Apt.serviceInstalledRunning "bind9"
namedConfWritten :: Property
namedConfWritten = property "named.conf configured" $ do
@@ -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/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index b43d83f8..06865c45 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -102,6 +102,30 @@ kgbServer = withOS desc $ \o -> case o of
where
desc = "kgb.kitenet.net setup"
+mumbleServer :: [Host] -> Property
+mumbleServer hosts = combineProperties "mumble.debian.net"
+ [ Obnam.latestVersion
+ , Obnam.backup "/var/lib/mumble-server" "55 5 * * *"
+ [ "--repository=sftp://joey@turtle.kitenet.net/~/lib/backup/mumble.debian.net.obnam"
+ , "--client-name=mumble"
+ ] Obnam.OnlyClient
+ `requires` Ssh.keyImported SshRsa "root"
+ `requires` Ssh.knownHost hosts "turtle.kitenet.net" "root"
+ , trivial $ cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"]
+ , Apt.serviceInstalledRunning "mumble-server"
+ ]
+
+obnamLowMem :: Property
+obnamLowMem = combineProperties "obnam tuned for low memory use"
+ [ Obnam.latestVersion
+ , "/etc/obnam.conf" `File.containsLines`
+ [ "[config]"
+ , "# Suggested by liw to keep Obnam memory consumption down (at some speed cost)."
+ , "upload-queue-size = 128"
+ , "lru-size = 128"
+ ]
+ ]
+
-- git.kitenet.net and git.joeyh.name
gitServer :: [Host] -> Property
gitServer hosts = propertyList "git.kitenet.net setup"
@@ -229,9 +253,8 @@ mainhttpscert True =
, " SSLCertificateChainFile /etc/ssl/certs/startssl.pem"
]
-
-annexRsyncServer :: Property
-annexRsyncServer = combineProperties "rsync server for git-annex autobuilders"
+gitAnnexDistributor :: Property
+gitAnnexDistributor = combineProperties "git-annex distributor, including rsync server and signer"
[ Apt.installed ["rsync"]
, File.hasPrivContent "/etc/rsyncd.conf"
, File.hasPrivContent "/etc/rsyncd.secrets"
@@ -239,6 +262,8 @@ annexRsyncServer = combineProperties "rsync server for git-annex autobuilders"
`onChange` Service.running "rsync"
, endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild"
, endpoint "/srv/web/downloads.kitenet.net/git-annex/autobuild/x86_64-apple-mavericks"
+ -- git-annex distribution signing key
+ , Gpg.keyImported "89C809CB" "joey"
]
where
endpoint d = combineProperties ("endpoint " ++ d)
diff --git a/Propellor/SimpleSh.hs b/Propellor/SimpleSh.hs
index 7e0f19ff..c088eda7 100644
--- a/Propellor/SimpleSh.hs
+++ b/Propellor/SimpleSh.hs
@@ -32,7 +32,6 @@ simpleSh namedpipe = do
forever $ do
(client, _addr) <- accept s
h <- socketToHandle client ReadWriteMode
- hSetBuffering h LineBuffering
maybe noop (run h) . readish =<< hGetLine h
where
run h (Cmd cmd params) = do
@@ -47,6 +46,7 @@ simpleSh namedpipe = do
let runwriter = do
v <- readChan chan
hPutStrLn h (show v)
+ hFlush h
case v of
Done -> noop
_ -> runwriter
@@ -73,8 +73,8 @@ simpleShClient namedpipe cmd params handler = do
s <- socket AF_UNIX Stream defaultProtocol
connect s (SockAddrUnix namedpipe)
h <- socketToHandle s ReadWriteMode
- hSetBuffering h LineBuffering
hPutStrLn h $ show $ Cmd cmd params
+ hFlush h
resps <- catMaybes . map readish . lines <$> hGetContents h
hClose h `after` handler resps
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