X-Git-Url: https://git.distorted.org.uk/~mdw/zone/blobdiff_plain/4440be0decb5ad76b2d33c8d59c829d3bcbb3a69..b68068e3fc0ff8ac99977f783b64fc87953c0bde:/zone.lisp diff --git a/zone.lisp b/zone.lisp index 05af14f..8124b28 100644 --- a/zone.lisp +++ b/zone.lisp @@ -61,9 +61,10 @@ (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 may be any of a number of obvious - time units." + "Convert a timespec TS to seconds. + + 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)) ((atom ts) @@ -90,10 +91,11 @@ (maphash (lambda (key val) (declare (ignore val)) (collect key)) ht))) (defun iso-date (&optional time &key datep timep (sep #\ )) - "Construct a textual date or time in ISO format. The TIME is the universal - time to convert, which defaults to now; DATEP is whether to emit the date; - TIMEP is whether to emit the time, and SEP (default is space) is how to - separate the two." + "Construct a textual date or time in ISO format. + + The TIME is the universal time to convert, which defaults to now; DATEP is + whether to emit the date; TIMEP is whether to emit the time, and + SEP (default is space) is how to separate the two." (multiple-value-bind (sec min hr day mon yr dow dstp tz) (decode-universal-time (if (or (null time) (eq time :now)) @@ -228,10 +230,11 @@ (export 'preferred-subnet-case) (defmacro preferred-subnet-case (&body clauses) - "CLAUSES have the form (SUBNETS . FORMS) -- 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." + "CLAUSES have the form (SUBNETS . FORMS). + + 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." `(cond ,@(mapcar (lambda (clause) (let ((subnets (car clause))) @@ -248,8 +251,27 @@ clauses))) (defun zone-process-records (rec ttl func) - "Sort out the list of records in REC, calling FUNC for each one. TTL is - the default time-to-live for records which don't specify one." + "Sort out the list of records in REC, calling FUNC for each one. + + 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. + + ZONE-RECORD: RR | TTL | SUBZONE + The body of a zone form is a sequence of these. + + TTL: :ttl INTEGER + Sets the TTL for subsequent RRs in this zone or subzone. + + RR: SYMBOL DATA + Adds a record for the current NAME; the SYMBOL denotes the record + type, and the DATA depends on the type. + + 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) (collecting (top sub) (loop @@ -274,13 +296,12 @@ (process (rec dom ttl) (multiple-value-bind (top sub) (sift rec ttl) (if (and dom (null top) sub) - (let ((preferred nil)) - (dolist (s sub) - (when (some #'zone-preferred-subnet-p - (listify (zs-name s))) - (setf preferred s))) - (unless preferred - (setf preferred (car sub))) + (let ((preferred + (or (find-if (lambda (s) + (some #'zone-preferred-subnet-p + (listify (zs-name s)))) + sub) + (car sub)))) (when preferred (process (zs-records preferred) dom @@ -379,8 +400,10 @@ (export 'make-zone-serial) (defun make-zone-serial (name) - "Given a zone NAME, come up with a new serial number. This will (very - carefully) update a file ZONE.serial in the current directory." + "Given a zone NAME, come up with a new serial number. + + This will (very carefully) update a file ZONE.serial in the current + directory." (let* ((file (zone-file-name name :serial)) (last (with-open-file (in file :direction :input @@ -398,8 +421,8 @@ (safely-writing (out file) (format out ";; Serial number file for zone ~A~%~ - ;; (LAST-SEQ DAY MONTH YEAR)~%~ - ~S~%" + ;; (LAST-SEQ DAY MONTH YEAR)~%~ + ~S~%" name (cons seq now))) (from-mixed-base '(100 100 100) (reverse (cons seq now))))) @@ -408,10 +431,12 @@ ;;; Zone form parsing. (defun zone-parse-head (head) - "Parse the HEAD of a zone form. This has the form + "Parse the HEAD of a zone form. + + This has the form (NAME &key :source :admin :refresh :retry - :expire :min-ttl :ttl :serial) + :expire :min-ttl :ttl :serial) though a singleton NAME needn't be a list. Returns the default TTL and an soa structure representing the zone head." @@ -450,11 +475,12 @@ (export 'defzoneparse) (defmacro defzoneparse (types (name data list &key (prefix (gensym "PREFIX")) - (zname (gensym "ZNAME")) - (ttl (gensym "TTL"))) + (zname (gensym "ZNAME")) + (ttl (gensym "TTL"))) &body body) - "Define a new zone record type (or TYPES -- a list of synonyms is - permitted). The arguments are as follows: + "Define a new zone record type. + + The TYPES may be a list of synonyms. The other arguments are as follows: NAME The name of the record to be added. @@ -507,6 +533,9 @@ ',type))))) (defun zone-parse-records (zone records) + "Parse the body of a zone form. + + ZONE is the zone object; RECORDS is the body of the form." (let ((zname (zone-name zone))) (with-collection (rec) (flet ((parse-record (zr) @@ -527,7 +556,9 @@ (export 'zone-parse) (defun zone-parse (zf) - "Parse a ZONE form. The syntax of a zone form is as follows: + "Parse a ZONE form. + + The syntax of a zone form is as follows: ZONE-FORM: ZONE-HEAD ZONE-RECORD* @@ -653,7 +684,7 @@ (rec :name (zone-parse-host "mask" name) :type :a :data (ipnet-mask n)) - (rec :name (zone-parse-host "broadcast" name) + (rec :name (zone-parse-host "bcast" name) :type :a :data (ipnet-broadcast n))))) @@ -755,6 +786,7 @@ "Stream to write zone data on.") (defmethod zone-write :around (format zone stream) + (declare (ignore format)) (let ((*writing-zone* zone) (*zone-output-stream* stream)) (call-next-method)))