summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-04-19 02:10:56 -0400
committerJoey Hess2014-04-19 02:10:56 -0400
commit5dd316a0ad4abce5e81ea19e52caf7b57081cda3 (patch)
tree92070fc17e1a57245e1d0f89d5d3bf8599406d85
parent5b4f3d109ee7393b1e44cac60b43def2ce4c8b24 (diff)
parent6aeeaaab9073675e8c043d009c97ff62d809975b (diff)
Merge branch 'joeyconfig'
-rw-r--r--Propellor/Attr.hs74
-rw-r--r--Propellor/Engine.hs2
-rw-r--r--Propellor/Property.hs85
-rw-r--r--Propellor/Property/Apt.hs8
-rw-r--r--Propellor/Property/Cmd.hs3
-rw-r--r--Propellor/Property/Cron.hs2
-rw-r--r--Propellor/Property/Dns.hs390
-rw-r--r--Propellor/Property/Docker.hs53
-rw-r--r--Propellor/Property/File.hs12
-rw-r--r--Propellor/Property/Git.hs2
-rw-r--r--Propellor/Property/Gpg.hs2
-rw-r--r--Propellor/Property/Hostname.hs2
-rw-r--r--Propellor/Property/Obnam.hs17
-rw-r--r--Propellor/Property/Postfix.hs2
-rw-r--r--Propellor/Property/Scheduled.hs6
-rw-r--r--Propellor/Property/Service.hs6
-rw-r--r--Propellor/Property/SiteSpecific/GitAnnexBuilder.hs2
-rw-r--r--Propellor/Property/SiteSpecific/GitHome.hs6
-rw-r--r--Propellor/Property/SiteSpecific/JoeySites.hs61
-rw-r--r--Propellor/Property/Ssh.hs16
-rw-r--r--Propellor/Property/Sudo.hs2
-rw-r--r--Propellor/Property/User.hs2
-rw-r--r--Propellor/Types.hs42
-rw-r--r--Propellor/Types/Attr.hs16
-rw-r--r--Propellor/Types/Dns.hs81
-rw-r--r--Propellor/Types/OS.hs1
-rw-r--r--TODO13
-rw-r--r--config-joey.hs77
-rw-r--r--debian/changelog19
-rw-r--r--propellor.cabal3
30 files changed, 780 insertions, 227 deletions
diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index 94376b0d..05ea3ff5 100644
--- a/Propellor/Attr.hs
+++ b/Propellor/Attr.hs
@@ -8,38 +8,65 @@ import Propellor.Types.Attr
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)
-
-cnameFor :: IsProp p => Domain -> (Domain -> p) -> AttrProperty
-cnameFor domain mkp =
- let p = mkp domain
- in AttrProperty p (addCName domain)
-
-addCName :: HostName -> Attr -> Attr
-addCName domain d = d { _cnames = S.insert domain (_cnames d) }
-
-sshPubKey :: String -> AttrProperty
+-- | 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)
+
+-- | Indidate that a host has an AAAA record in the DNS.
+ipv6 :: String -> Property
+ipv6 addr = pureAttrProperty ("ipv6 " ++ addr)
+ (addDNS $ Address $ IPv6 addr)
+
+-- | Indicates another name for the host in the DNS.
+alias :: Domain -> Property
+alias domain = pureAttrProperty ("aka " ++ domain)
+ (addDNS $ CNAME $ AbsDomain domain)
+
+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,9 +85,22 @@ hostProperties (Host ps _) = ps
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.
--
-- For example, `fromHost hosts "otherhost" getSshPubKey`
diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs
index 81d979ac..55ce7f77 100644
--- a/Propellor/Engine.hs
+++ b/Propellor/Engine.hs
@@ -18,7 +18,7 @@ runPropellor attr a = runReaderT (runWithAttr a) attr
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
diff --git a/Propellor/Property.hs b/Propellor/Property.hs
index 5b1800ef..24494654 100644
--- a/Propellor/Property.hs
+++ b/Propellor/Property.hs
@@ -5,6 +5,7 @@ module Propellor.Property where
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 Propellor.Engine
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 @@ combineProperties desc ps = Property desc $ go ps NoChange
-- 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 @@ flagFile' property getflagfile = Property (propertyDesc property) $ do
--- | 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 @@ check c property = Property (propertyDesc property) $ ifM (liftIO c)
-- 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 @@ trivial p = Property (propertyDesc p) $ do
--
-- 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 @@ host hn = Host [] (\_ -> newAttr hn)
-- | 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
diff --git a/Propellor/Property/Apt.hs b/Propellor/Property/Apt.hs
index d31e8b46..9234cbbf 100644
--- a/Propellor/Property/Apt.hs
+++ b/Propellor/Property/Apt.hs
@@ -157,8 +157,8 @@ buildDepIn dir = go `requires` installedMin ["devscripts", "equivs"]
-- | 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
@@ -210,7 +210,7 @@ reConfigure :: Package -> [(String, String, String)] -> Property
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) ->
@@ -236,7 +236,7 @@ trustsKey k = RevertableProperty trust untrust
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
+ 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)
diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs
index 875c1f9a..bcd08246 100644
--- a/Propellor/Property/Cmd.hs
+++ b/Propellor/Property/Cmd.hs
@@ -12,6 +12,7 @@ import Data.List
import "mtl" Control.Monad.Reader
import Propellor.Types
+import Propellor.Property
import Utility.Monad
import Utility.SafeCommand
import Utility.Env
@@ -25,7 +26,7 @@ cmdProperty cmd params = cmdProperty' cmd params []
-- | 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
diff --git a/Propellor/Property/Cron.hs b/Propellor/Property/Cron.hs
index 0649ee9f..5b070eff 100644
--- a/Propellor/Property/Cron.hs
+++ b/Propellor/Property/Cron.hs
@@ -33,7 +33,7 @@ job desc times user cddir command = cronjobfile `File.hasContent`
`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
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 34e790d9..0708417d 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -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
+import Utility.Applicative
-namedconf :: FilePath
-namedconf = "/etc/bind/named.conf.local"
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.List
-data Zone = Zone
- { zdomain :: Domain
- , ztype :: Type
- , zfile :: FilePath
- , zmasters :: [IPAddr]
- , zconfiglines :: [String]
- }
-
-zoneDesc :: Zone -> String
-zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
-
-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 @@ zoneStanza z =
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
+
diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs
index d2555ea5..e5b8d64a 100644
--- a/Propellor/Property/Docker.hs
+++ b/Propellor/Property/Docker.hs
@@ -25,7 +25,7 @@ import Data.List.Utils
-- | 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 @@ docked
-> 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 @@ docked hosts cn = RevertableProperty (go "docked" setup) (go "undocked" teardown
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 @@ findContainer hosts cid cn mk = case findHost hosts (cn2hn cn) of
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 @@ garbageCollected = propertyList "docker garbage collected"
, 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 RunParam = String
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 @@ containerDesc cid p = p `describe` desc
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 @@ chain s = case toContainerId s of
-- 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 :: ContainerId -> IO Bool
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 @@ listContainers status =
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
diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs
index 8f23dab7..0b060177 100644
--- a/Propellor/Property/File.hs
+++ b/Propellor/Property/File.hs
@@ -18,7 +18,7 @@ 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 -> 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 @@ f `lacksLine` l = fileProperty (f ++ " remove: " ++ l) (filter (/= l)) f
-- | 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 @@ fileProperty' writer desc a f = Property desc $ go =<< liftIO (doesFileExist f)
-- | 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 @@ ownerGroup f owner group = Property (f ++ " owner " ++ og) $ do
-- | 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
diff --git a/Propellor/Property/Git.hs b/Propellor/Property/Git.hs
index 1dae94bf..ba370e51 100644
--- a/Propellor/Property/Git.hs
+++ b/Propellor/Property/Git.hs
@@ -62,7 +62,7 @@ type Branch = String
--
-- 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
diff --git a/Propellor/Property/Gpg.hs b/Propellor/Property/Gpg.hs
index e23111bb..64ea9fea 100644
--- a/Propellor/Property/Gpg.hs
+++ b/Propellor/Property/Gpg.hs
@@ -21,7 +21,7 @@ installed = Apt.installed ["gnupg"]
-- 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
diff --git a/Propellor/Property/Hostname.hs b/Propellor/Property/Hostname.hs
index 30e0992d..031abb9d 100644
--- a/Propellor/Property/Hostname.hs
+++ b/Propellor/Property/Hostname.hs
@@ -9,7 +9,7 @@ import qualified Propellor.Property.File as File
-- 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
diff --git a/Propellor/Property/Obnam.hs b/Propellor/Property/Obnam.hs
index 4d0584bb..32374b57 100644
--- a/Propellor/Property/Obnam.hs
+++ b/Propellor/Property/Obnam.hs
@@ -65,7 +65,7 @@ backup dir crontimes params numclients = cronjob `describe` desc
-- 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)
@@ -97,14 +97,17 @@ installed = Apt.installed ["obnam"]
-- | Ensures that a recent version of obnam gets installed.
--
--- Only useful on Stable.
+-- Only does anything for Debian Stable.
latestVersion :: Property
-latestVersion = propertyList "obnam latest version"
- [ toProp $ Apt.trustsKey key
- , Apt.setSourcesListD sources "obnam"
- ]
+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 = ["deb http://code.liw.fi/debian wheezy main"]
+ 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-----"
diff --git a/Propellor/Property/Postfix.hs b/Propellor/Property/Postfix.hs
index f4be27cf..9fa4a2c3 100644
--- a/Propellor/Property/Postfix.hs
+++ b/Propellor/Property/Postfix.hs
@@ -15,7 +15,7 @@ installed = Apt.serviceInstalledRunning "postfix"
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")
diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs
index 769a3931..f2911e50 100644
--- a/Propellor/Property/Scheduled.hs
+++ b/Propellor/Property/Scheduled.hs
@@ -19,13 +19,13 @@ import qualified Data.Map as M
-- 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 @@ period prop recurrance = Property desc $ do
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
diff --git a/Propellor/Property/Service.hs b/Propellor/Property/Service.hs
index c6498e57..14e769d0 100644
--- a/Propellor/Property/Service.hs
+++ b/Propellor/Property/Service.hs
@@ -13,19 +13,19 @@ type ServiceName = String
-- 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
diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
index 204a9ca7..677aa760 100644
--- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
+++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs
@@ -40,7 +40,7 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder"
-- 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
diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs
index ee46a9e4..6ed02146 100644
--- a/Propellor/Property/SiteSpecific/GitHome.hs
+++ b/Propellor/Property/SiteSpecific/GitHome.hs
@@ -8,16 +8,16 @@ import Utility.SafeCommand
-- | 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"]
]
diff --git a/Propellor/Property/SiteSpecific/JoeySites.hs b/Propellor/Property/SiteSpecific/JoeySites.hs
index 3d0ff246..b43d83f8 100644
--- a/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -16,9 +16,63 @@ import qualified Propellor.Property.Obnam as Obnam
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 @@ oldUseNetShellBox = check (not <$> Apt.isInstalled "oldusenet") $
, "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) _)) ->
diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs
index a39792cf..a4f87678 100644
--- a/Propellor/Property/Ssh.hs
+++ b/Propellor/Property/Ssh.hs
@@ -67,7 +67,7 @@ randomHostKeys :: Property
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 @@ randomHostKeys = flagFile prop "/etc/ssh/.unique_host_keys"
-- (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 @@ hostKey keytype = combineProperties desc
-- 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 @@ keyImported keytype user = combineProperties desc
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 @@ fromKeyType SshEd25519 = "ed25519"
-- | 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 @@ knownHost hosts hn user = Property desc $
-- | 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
diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs
index 66ceb580..68b56608 100644
--- a/Propellor/Property/Sudo.hs
+++ b/Propellor/Property/Sudo.hs
@@ -10,7 +10,7 @@ import Propellor.Property.User
-- | 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
diff --git a/Propellor/Property/User.hs b/Propellor/Property/User.hs
index 8e7afd81..eef2a57e 100644
--- a/Propellor/Property/User.hs
+++ b/Propellor/Property/User.hs
@@ -29,7 +29,7 @@ hasSomePassword user = check ((/= HasPassword) <$> getPasswordStatus user) $
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
diff --git a/Propellor/Types.hs b/Propellor/Types.hs
index fc767cd2..0e412e82 100644
--- a/Propellor/Types.hs
+++ b/Propellor/Types.hs
@@ -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 @@ module Propellor.Types
, GpgKeyId
, SshKeyType(..)
, module Propellor.Types.OS
+ , module Propellor.Types.Dns
) where
import Data.Monoid
@@ -33,8 +32,9 @@ import "MonadCatchIO-transformers" Control.Monad.CatchIO
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 @@ newtype Propellor p = Propellor { runWithAttr :: ReaderT Attr IO p }
-- 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 @@ class IsProp p where
-- | 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 @@ instance IsProp RevertableProperty where
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
diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs
index 1ff58148..8b7d3b09 100644
--- a/Propellor/Types/Attr.hs
+++ b/Propellor/Types/Attr.hs
@@ -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 @@ data Attr = Attr
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 Eq Attr where
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
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
new file mode 100644
index 00000000..e367202a
--- /dev/null
+++ b/Propellor/Types/Dns.hs
@@ -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)
diff --git a/Propellor/Types/OS.hs b/Propellor/Types/OS.hs
index 0635b271..23cc8a29 100644
--- a/Propellor/Types/OS.hs
+++ b/Propellor/Types/OS.hs
@@ -1,5 +1,6 @@
module Propellor.Types.OS where
+type HostName = String
type UserName = String
type GroupName = String
diff --git a/TODO b/TODO
index 93dcf0d4..85875a9d 100644
--- a/TODO
+++ b/TODO
@@ -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)
diff --git a/config-joey.hs b/config-joey.hs
index dec1f1bd..1bda9dd2 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -32,11 +32,15 @@ hosts :: [Host] -- * \ | | '--------'
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 @@ hosts = -- (o) `
& 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 @@ hosts = -- (o) `
-- 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 @@ hosts = -- (o) `
-- 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 @@ hosts = -- (o) `
& 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"]
@@ -222,17 +245,17 @@ cleanCloudAtCost = propertyList "cloudatcost cleanup"
]
]
-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
@@ -251,11 +274,23 @@ main = defaultMain hosts
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"
]
diff --git a/debian/changelog b/debian/changelog
index 3daeb395..beaca78a 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,8 +1,17 @@
-propellor (0.3.2) UNRELEASED; urgency=medium
-
- * Run all cron jobs under chronic from moreutils to avoid unnecessary mails.
-
- -- Joey Hess <joeyh@debian.org> Thu, 17 Apr 2014 21:00:43 -0400
+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
diff --git a/propellor.cabal b/propellor.cabal
index ad171b5e..68d7fb70 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -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 @@ Library
Propellor.Exception
Propellor.Types
Propellor.Types.OS
+ Propellor.Types.Dns
Other-Modules:
Propellor.Types.Attr
Propellor.CmdLine