X-Git-Url: https://git.distorted.org.uk/~mdw/zone/blobdiff_plain/64e34a970f8a28e8317b9e5faa1e608639aada7f..75f39e1a706ce77daec78c32b41a123c8f7be82c:/zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 8769fa3..762c6e2 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
@@ -378,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
@@ -397,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)))))
@@ -407,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."
@@ -449,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.
 
@@ -506,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)
@@ -526,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*
@@ -590,6 +622,48 @@
   ":txt TEXT"
   (rec :data data))
 
+(defzoneparse :dkim (name data rec)
+  ":dkim (KEYFILE {:TAG VALUE}*)"
+  (destructuring-bind (file &rest plist) (listify data)
+    (let ((things nil) (out nil))
+      (labels ((flush ()
+		 (when out
+		   (push (get-output-stream-string out) things)
+		   (setf out nil)))
+	       (emit (text)
+		 (let ((len (length text)))
+		   (when (and out (> (+ (file-position out)
+					(length text))
+				     64))
+		     (flush))
+		   (when (plusp len)
+		     (cond ((< len 64)
+			    (unless out (setf out (make-string-output-stream)))
+			    (write-string text out))
+			   (t
+			    (do ((i 0 j)
+				 (j 64 (+ j 64)))
+				((>= i len))
+			      (push (subseq text i (min j len)) things))))))))
+	(do ((p plist (cddr p)))
+	    ((endp p))
+	  (emit (format nil "~(~A~)=~A;" (car p) (cadr p))))
+	(emit (with-output-to-string (out)
+		(write-string "p=" out)
+		(when file
+		  (with-open-file (in file :direction :input)
+		    (loop
+		      (when (string= (read-line in)
+				     "-----BEGIN PUBLIC KEY-----")
+			(return)))
+		    (loop
+		      (let ((line (read-line in)))
+			(if (string= line "-----END PUBLIC KEY-----")
+			    (return)
+			    (write-string line out)))))))))
+      (rec :type :txt
+	   :data (nreverse things)))))
+
 (defzoneparse :mx (name data rec :zname zname)
   ":mx ((HOST :prio INT :ip IPADDR)*)"
   (dolist (mx (listify data))
@@ -754,6 +828,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)))
@@ -862,6 +937,8 @@ $TTL ~2@*~D~2%"
   (:method ((type (eql :srv)) data)
     (destructuring-bind (prio weight port host) data
       (list "~2D ~5D ~5D ~A" prio weight port (bind-hostname host))))
-  (:method ((type (eql :txt)) data) (list "~S" (stringify data))))
+  (:method ((type (eql :txt)) data)
+    (cons "~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]"
+	  (mapcar #'stringify (listify data)))))
 
 ;;;----- That's all, folks --------------------------------------------------