diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs index 94376b0..05ea3ff 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) +-- | 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) -cnameFor :: IsProp p => Domain -> (Domain -> p) -> AttrProperty -cnameFor domain mkp = - let p = mkp domain - in AttrProperty p (addCName domain) +-- | Indidate that a host has an AAAA record in the DNS. +ipv6 :: String -> Property +ipv6 addr = pureAttrProperty ("ipv6 " ++ addr) + (addDNS $ Address $ IPv6 addr) -addCName :: HostName -> Attr -> Attr -addCName domain d = d { _cnames = S.insert domain (_cnames d) } +-- | Indicates another name for the host in the DNS. +alias :: Domain -> Property +alias domain = pureAttrProperty ("aka " ++ domain) + (addDNS $ CNAME $ AbsDomain domain) -sshPubKey :: String -> AttrProperty +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 81d979a..55ce7f7 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 5b1800e..2449465 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 d31e8b4..9234cbb 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 875c1f9..bcd0824 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 0649ee9..5b070ef 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 34e790d..0708417 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] - } +-- | 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) -zoneDesc :: Zone -> String -zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")" +-- | 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 -type IPAddr = String +-- | 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 { }"] + } -type Domain = String +-- | 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 -data Type = Master | Secondary - deriving (Show, Eq) - -secondary :: Domain -> [IPAddr] -> Zone -secondary domain masters = Zone - { zdomain = domain - , ztype = Secondary - , zfile = "db." ++ domain - , zmasters = masters - , zconfiglines = ["allow-transfer { }"] - } - -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 d2555ea..e5b8d64 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: , 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 8f23dab..0b06017 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 1dae94b..ba370e5 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 e23111b..64ea9fe 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 30e0992..031abb9 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 4d0584b..32374b5 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 f4be27c..9fa4a2c 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 769a393..f2911e5 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 c6498e5..14e769d 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 204a9ca..677aa76 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 ee46a9e..6ed0214 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 3d0ff24..b43d83f 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 ++ "/" + , " " + , " 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" + , " " + ] + ] + 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 a39792c..a4f8767 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 66ceb58..68b5660 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 8e7afd8..eef2a57 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 fc767cd..0e412e8 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 1ff5814..8b7d3b0 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 0000000..e367202 --- /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 0635b27..23cc8a2 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 93dcf0d..85875a9 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 dec1f1b..1bda9dd 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 3daeb39..beaca78 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,17 @@ -propellor (0.3.2) UNRELEASED; urgency=medium +propellor (0.4.0) unstable; urgency=medium - * Run all cron jobs under chronic from moreutils to avoid unnecessary mails. + * 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 Thu, 17 Apr 2014 21:00:43 -0400 + -- Joey Hess Sat, 19 Apr 2014 02:09:56 -0400 propellor (0.3.1) unstable; urgency=medium diff --git a/propellor.cabal b/propellor.cabal index ad171b5..68d7fb7 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 @@ -99,6 +99,7 @@ Library Propellor.Exception Propellor.Types Propellor.Types.OS + Propellor.Types.Dns Other-Modules: Propellor.Types.Attr Propellor.CmdLine