X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/blobdiff_plain/8fcf1ae3524d2c7d914997b32c24ca697ab5a303..f4e0c48f17d3c959d3751faba9ce9cd0becfba41:/zone.lisp diff --git a/zone.lisp b/zone.lisp index 73f3f0f..9e5795d 100644 --- a/zone.lisp +++ b/zone.lisp @@ -63,7 +63,7 @@ (export 'timespec-seconds) (defun timespec-seconds (ts) "Convert a timespec TS to seconds. - A timespec may be a real count of seconds, or a list (COUNT UNIT): UNIT + A timespec may be a real count of seconds, or a list (COUNT UNIT). UNIT may be any of a number of obvious time units." (cond ((null ts) 0) ((realp ts) (floor ts)) @@ -200,8 +200,10 @@ (defstruct (zone-record (:conc-name zr-)) (export 'zone-subdomain) (defstruct (zone-subdomain (:conc-name zs-)) - "A subdomain. Slightly weird. Used internally by zone-process-records - below, and shouldn't escape." + "A subdomain. + + Slightly weird. Used internally by `zone-process-records', and shouldn't + escape." name ttl records) @@ -234,11 +236,12 @@ (defun zone-preferred-subnet-p (name) (export 'preferred-subnet-case) (defmacro preferred-subnet-case (&body clauses) - "CLAUSES have the form (SUBNETS . FORMS). + "Execute a form based on which networks are considered preferred. - Evaluate the first FORMS whose SUBNETS (a list or single symbol, not - evaluated) are considered preferred by zone-preferred-subnet-p. If - SUBNETS is the symbol t then the clause always matches." + The CLAUSES have the form (SUBNETS . FORMS) -- evaluate the first FORMS + whose SUBNETS (a list or single symbol, not evaluated) are listed in + `*preferred-subnets*'. If SUBNETS is the symbol `t' then the clause + always matches." `(cond ,@(mapcar (lambda (clause) (let ((subnets (car clause))) @@ -259,24 +262,43 @@ (defun zone-process-records (rec ttl func) TTL is the default time-to-live for records which don't specify one. - The syntax is a little fiddly to describe. It operates relative to a - subzone name NAME. + REC is a list of records of the form + + ({ :ttl TTL | TYPE DATA | (LABEL . REC) }*) + + The various kinds of entries have the following meanings. + + :ttl TTL Set the TTL for subsequent records (at this level of + nesting only). + + TYPE DATA Define a record with a particular TYPE and DATA. + Record types are defined using `defzoneparse' and + the syntax of the data is idiosyncratic. + + ((LABEL ...) . REC) Define records for labels within the zone. Any + records defined within REC will have their domains + prefixed by each of the LABELs. A singleton list + of labels may instead be written as a single + label. Note, therefore, that + + (host (sub :a \"169.254.1.1\")) - ZONE-RECORD: RR | TTL | SUBZONE - The body of a zone form is a sequence of these. + defines a record for `host.sub' -- not `sub.host'. - TTL: :ttl INTEGER - Sets the TTL for subsequent RRs in this zone or subzone. + If REC contains no top-level records, but it does define records for a + label listed in `*preferred-subnets*', then the records for the first such + label are also promoted to top-level. - RR: SYMBOL DATA - Adds a record for the current NAME; the SYMBOL denotes the record - type, and the DATA depends on the type. + The FUNC is called for each record encountered, represented as a + `zone-record' object. Zone parsers are not called: you get the record + types and data from the input form; see `zone-parse-records' if you want + the raw output." - SUBZONE: (LABELS ZONE-RECORD*) - Defines a subzone. The LABELS is either a list of labels, or a - singleton label. For each LABEL, evaluate the ZONE-RECORDs relative - to LABEL.NAME. The special LABEL `@' is a no-op." (labels ((sift (rec ttl) + ;; Parse the record list REC into lists of `zone-record' and + ;; `zone-subdomain' objects, sorting out TTLs and so on. + ;; Returns them as two values. + (collecting (top sub) (loop (unless rec @@ -297,7 +319,13 @@ (defun zone-process-records (rec ttl func) sub))) (t (error "Unexpected record form ~A" (car r)))))))) + (process (rec dom ttl) + ;; Recursirvely process the record list REC, with a list DOM of + ;; prefix labels, and a default TTL. Promote records for a + ;; preferred subnet to toplevel if there are no toplevel records + ;; already. + (multiple-value-bind (top sub) (sift rec ttl) (if (and dom (null top) sub) (let ((preferred @@ -320,12 +348,16 @@ (defun zone-process-records (rec ttl func) (process (zs-records s) (cons (zs-name s) dom) (zs-ttl s)))))) + + ;; Process the records we're given with no prefix. (process rec nil ttl))) (export 'zone-parse-host) (defun zone-parse-host (f zname) - "Parse a host name F: if F ends in a dot then it's considered absolute; - otherwise it's relative to ZNAME." + "Parse a host name F. + + If F ends in a dot then it's considered absolute; otherwise it's relative + to ZNAME." (setf f (stringify f)) (cond ((string= f "@") (stringify zname)) ((and (plusp (length f)) @@ -469,6 +501,11 @@ (defun zone-parse-head (head) (export 'zone-make-name) (defun zone-make-name (prefix zone-name) + "Compute a full domain name from a PREFIX and a ZONE-NAME. + + If the PREFIX ends with `.' then it's absolute already; otherwise, append + the ZONE-NAME, separated with a `.'. If PREFIX is nil, or `@', then + return the ZONE-NAME only." (if (or (not prefix) (string= prefix "@")) zone-name (let ((len (length prefix))) @@ -484,7 +521,9 @@ (defmacro defzoneparse (types (name data list &body body) "Define a new zone record type. - The TYPES may be a list of synonyms. The other arguments are as follows: + The arguments are as follows: + + TYPES A singleton type symbol, or a list of aliases. NAME The name of the record to be added. @@ -534,7 +573,7 @@ (defun ,func (,prefix ,zname ,data ,ttl ,col) :make-ptr-p ,tmakeptrp) ,col))) ,@body))) - ',type))))) + ',type))))) (export 'zone-parse-records) (defun zone-parse-records (zname ttl records) @@ -555,7 +594,7 @@ (export 'zone-parse) (defun zone-parse (zf) "Parse a ZONE form. - The syntax of a zone form is as follows: + The syntax of a zone form is as follows: ZONE-FORM: ZONE-HEAD ZONE-RECORD*