net.lisp (ipmask-cidr-slash): Rename from `ipmask-cidl-slash'. master
authorMark Wooding <mdw@distorted.org.uk>
Wed, 8 May 2024 12:51:49 +0000 (13:51 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Wed, 8 May 2024 12:51:49 +0000 (13:51 +0100)
I can only plead incompetence.

frontend.lisp
net.lisp
zone.lisp

index e170731..1c1a442 100644 (file)
@@ -22,7 +22,7 @@
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (defpackage #:zone.frontend
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (defpackage #:zone.frontend
-  (:use #:common-lisp #:mdw.sys-base #:optparse #:net #:zone
+  (:use #:common-lisp #:mdw.base #:mdw.sys-base #:optparse #:net #:zone
        #+(or cmu clisp) #:mop
        #+sbcl #:sb-mop)
   (:export #:main))
        #+(or cmu clisp) #:mop
        #+sbcl #:sb-mop)
   (:export #:main))
       (if (and path
               (not (pathname-name path)))
          (setf var path)
       (if (and path
               (not (pathname-name path)))
          (setf var path)
-         (option-parse-error "path `~A' doesn't name a directory." arg)))))
+         (option-parse-error "path `~A' doesn't name a directory." arg))))
+  (let ((duration-units (make-hash-table :test #'equal)))
+    (dolist (item '((("Gs") #.(* 1000 1000 1000))
+                   (("Ms") #.(* 1000 1000))
+                   (("ks") 1000)
+                   (("hs") 100)
+                   (("das") 10)
+                   (("yr" "year" "years" "y") #.(* 365 24 60 60))
+                   (("wk" "week" "weeks" "w") #.(* 7 24 60 60))
+                   (("day" "days" "dy" "d") #.(* 24 60 60))
+                   (("hr" "hour" "hours" "h") #.(* 60 60))
+                   (("min" "minute" "minutes" "m") 60)
+                   (("s" "second" "seconds" "sec" "") 1)))
+      (dolist (name (car item))
+       (setf (gethash name duration-units) (cadr item))))
+    (defopthandler dur (var arg) ()
+      (let ((len (length arg)))
+         (multiple-value-bind (n i) (parse-integer arg :junk-allowed t)
+           (unless n
+             (option-parse-error "invalid duration `~A': ~
+                                  integer expected" arg))
+           (loop (cond ((or (>= i len)
+                            (not (whitespace-char-p (char arg i))))
+                        (return))
+                       (t
+                        (incf i))))
+           (let ((u0 i))
+             (loop (cond ((or (>= i len)
+                              (whitespace-char-p (char arg i)))
+                          (return))
+                         (t
+                          (incf i))))
+             (let* ((u1 i)
+                    (unit (subseq arg u0 u1))
+                    (scale (gethash unit duration-units)))
+               (unless scale
+                 (option-parse-error "invalid duration `~A': ~
+                                      unknown unit `~A'"
+                                     arg unit))
+               (setf var (* n scale)))))))))
 
 (define-program
     :version "1.0.0" :usage "ZONEDEF..."
 
 (define-program
     :version "1.0.0" :usage "ZONEDEF..."
                           "Designate NET as a preferred subnet.")
                      (#\D "debug" (set opt-debug)
                           "Produce stack backtrace on error.")
                           "Designate NET as a preferred subnet.")
                      (#\D "debug" (set opt-debug)
                           "Produce stack backtrace on error.")
+                     "Timeout options"
+                     (#\E "expire" (:arg "DURATION")
+                          (dur *default-zone-expire*)
+                          "Set default zone expiry period.")
+                     (#\N "min-ttl" (:arg "DURATION")
+                          (dur *default-zone-min-ttl*)
+                          "Set default zone minimum/negative time-to-live.")
+                     (#\R "refresh" (:arg "DURATION")
+                          (dur *default-zone-refresh*)
+                          "Set default zone refresh period.")
+                     (#\T "ttl" (:arg "DURATION")
+                          (dur *default-zone-ttl*)
+                          "Set default zone time-to-live.")
+                     (#\Y "retry" (:arg "DURATION")
+                          (dur *default-zone-retry*)
+                          "Set default zone retry period.")
                      "Output options"
                      (#\d "directory" (:arg "DIRECTORY")
                           (dir *zone-output-path*)
                      "Output options"
                      (#\d "directory" (:arg "DIRECTORY")
                           (dir *zone-output-path*)
                 (progv *zone-config* (mapcar #'symbol-value *zone-config*)
                   (load f :verbose nil :print nil :if-does-not-exist :error)
                   (delete-package *package*))))
                 (progv *zone-config* (mapcar #'symbol-value *zone-config*)
                   (load f :verbose nil :print nil :if-does-not-exist :error)
                   (delete-package *package*))))
-            (zone-save opt-zones :format opt-format)))
+            (zone-save opt-zones :format opt-format)
+            t))
       (with-unix-error-reporting ()
        (unless (option-parse-try
                  (do-options ()
       (with-unix-error-reporting ()
        (unless (option-parse-try
                  (do-options ()
index aa7e395..13f390c 100644 (file)
--- a/net.lisp
+++ b/net.lisp
   (:documentation "Transform the address IP into a numeric textual form."))
 
 (defmethod print-object ((addr ipaddr) stream)
   (:documentation "Transform the address IP into a numeric textual form."))
 
 (defmethod print-object ((addr ipaddr) stream)
-  (print-unreadable-object (addr stream :type t)
-    (write-string (ipaddr-string addr) stream)))
+  (if *print-escape*
+      (print-unreadable-object (addr stream :type t)
+       (write-string (ipaddr-string addr) stream))
+      (write-string (ipaddr-string addr) stream)))
 
 (export 'ipaddrp)
 (defun ipaddrp (ip)
 
 (export 'ipaddrp)
 (defun ipaddrp (ip)
   "Given an integer I, return an N-bit netmask with its I top bits set."
   (- (ash 1 n) (ash 1 (- n i))))
 
   "Given an integer I, return an N-bit netmask with its I top bits set."
   (- (ash 1 n) (ash 1 (- n i))))
 
-(export 'ipmask-cidl-slash)
-(defun ipmask-cidl-slash (width mask)
+(export 'ipmask-cidr-slash)
+(defun ipmask-cidr-slash (width mask)
   "Given a netmask MASK, try to compute a prefix length.
 
    Return an integer N such that (integer-netmask WIDTH N) = MASK, or nil if
   "Given a netmask MASK, try to compute a prefix length.
 
    Return an integer N such that (integer-netmask WIDTH N) = MASK, or nil if
   (with-ipnet (net nil mask) ipn
     (format nil "~A/~A"
            (ipaddr-string net)
   (with-ipnet (net nil mask) ipn
     (format nil "~A/~A"
            (ipaddr-string net)
-           (or (ipmask-cidl-slash (ipnet-width ipn) mask)
+           (or (ipmask-cidr-slash (ipnet-width ipn) mask)
                (ipaddr-string (make-instance (class-of net) :addr mask))))))
 
 (defmethod print-object ((ipn ipnet) stream)
                (ipaddr-string (make-instance (class-of net) :addr mask))))))
 
 (defmethod print-object ((ipn ipnet) stream)
-  (print-unreadable-object (ipn stream :type t)
-    (write-string (ipnet-string ipn) stream)))
+  (if *print-escape*
+      (print-unreadable-object (ipn stream :type t)
+       (write-string (ipnet-string ipn) stream))
+      (write-string (ipnet-string ipn) stream)))
 
 (defun parse-subnet (class width max str &key (start 0) (end nil) (slashp t))
   "Parse a subnet description from (a substring of) STR.
 
 (defun parse-subnet (class width max str &key (start 0) (end nil) (slashp t))
   "Parse a subnet description from (a substring of) STR.
   (let* ((addr-class (extract-class-name (ipnet-net ipn)))
         (width (ipaddr-width addr-class))
         (max (- width
   (let* ((addr-class (extract-class-name (ipnet-net ipn)))
         (width (ipaddr-width addr-class))
         (max (- width
-                (or (ipmask-cidl-slash width (ipnet-mask ipn))
+                (or (ipmask-cidr-slash width (ipnet-mask ipn))
                     (error "Base network has complex netmask")))))
     (multiple-value-bind (addr mask)
        (parse-subnet addr-class width max (stringify str)
                     (error "Base network has complex netmask")))))
     (multiple-value-bind (addr mask)
        (parse-subnet addr-class width max (stringify str)
index f7717ff..7649f54 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -26,7 +26,7 @@
 
 (defpackage #:zone
   (:use #:common-lisp
 
 (defpackage #:zone
   (:use #:common-lisp
-       #:mdw.base #:mdw.str #:collect #:safely
+       #:mdw.base #:mdw.str #:anaphora #:collect #:safely
        #:net #:services)
   (:import-from #:net #:round-down #:round-up))
 
        #:net #:services)
   (:import-from #:net #:round-down #:round-up))
 
        (push r a)
        (setf val q)))))
 
        (push r a)
        (setf val q)))))
 
-(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."
-  (cond ((null ts) 0)
-       ((realp ts) (floor ts))
-       ((atom ts)
-        (error "Unknown timespec format ~A" ts))
-       ((null (cdr ts))
-        (timespec-seconds (car ts)))
-       (t (+ (to-integer (* (car ts)
-                            (case (intern (string-upcase
-                                           (stringify (cadr ts)))
-                                          '#:zone)
-                              ((s sec secs second seconds) 1)
-                              ((m min mins minute minutes) 60)
-                              ((h hr hrs hour hours) #.(* 60 60))
-                              ((d dy dys day days) #.(* 24 60 60))
-                              ((w wk wks week weeks) #.(* 7 24 60 60))
-                              ((y yr yrs year years) #.(* 365 24 60 60))
-                              (t (error "Unknown time unit ~A"
-                                        (cadr ts))))))
-             (timespec-seconds (cddr ts))))))
+(let ((unit-scale (make-hash-table))
+      (scales nil))
+
+  (dolist (item `(((:second :seconds :sec :secs :s) ,1)
+                 ((:minute :minutes :min :mins :m) ,60)
+                 ((:hour :hours :hr :hrs :h) ,(* 60 60))
+                 ((:day :days :dy :dys :d) ,(* 24 60 60))
+                 ((:week :weeks :wk :wks :w) ,(* 7 24 60 60))))
+    (destructuring-bind
+       ((&whole units singular plural &rest hunoz) scale) item
+      (declare (ignore hunoz))
+      (dolist (unit units) (setf (gethash unit unit-scale) scale))
+      (push (cons scale (cons singular plural)) scales)))
+  (setf scales (sort scales #'> :key #'car))
+
+  (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."
+    (labels ((convert (acc ts)
+              (cond ((null ts) acc)
+                    ((realp ts) (+ acc (floor ts)))
+                    ((atom ts) (error "Unknown timespec format ~A" ts))
+                    (t
+                     (destructuring-bind
+                         (count &optional unit &rest tail) ts
+                       (let ((scale
+                               (acond ((null unit) 1)
+                                      ((gethash (intern (string-upcase
+                                                         (stringify unit))
+                                                        :keyword)
+                                                unit-scale)
+                                       it)
+                                      (t
+                                       (error "Unknown time unit ~S"
+                                              unit)))))
+                         (convert (+ acc (to-integer (* count scale)))
+                                  tail)))))))
+      (convert 0 ts)))
+
+  (export 'seconds-timespec)
+  (defun seconds-timespec (secs)
+    "Convert a count of seconds to a time specification."
+    (let ((sign (if (minusp secs) -1 +1)) (secs (abs secs)))
+    (collecting ()
+      (loop (cond ((zerop secs)
+                  (unless (collected) (collect-append '(0 :seconds)))
+                  (return))
+                 ((< secs 60)
+                  (collect (* secs sign))
+                  (collect (if (= secs 1) :second :seconds))
+                  (return))
+                 (t
+                  (let ((match (find secs scales :test #'>= :key #'car)))
+                    (multiple-value-bind (quot rem) (floor secs (car match))
+                      (collect (* quot sign))
+                      (collect (if (= quot 1) (cadr match) (cddr match)))
+                      (setf secs rem))))))))))
 
 (defun hash-table-keys (ht)
   "Return a list of the keys in hashtable HT."
 
 (defun hash-table-keys (ht)
   "Return a list of the keys in hashtable HT."
   "The default zone source: the current host's name.")
 
 (export '*default-zone-refresh*)
   "The default zone source: the current host's name.")
 
 (export '*default-zone-refresh*)
-(defvar *default-zone-refresh* (* 24 60 60)
-  "Default zone refresh interval: one day.")
+(defvar *default-zone-refresh* '(8 :hours)
+  "Default zone refresh interval: eight hours.")
 
 (export '*default-zone-admin*)
 (defvar *default-zone-admin* nil
   "Default zone administrator's email address.")
 
 (export '*default-zone-retry*)
 
 (export '*default-zone-admin*)
 (defvar *default-zone-admin* nil
   "Default zone administrator's email address.")
 
 (export '*default-zone-retry*)
-(defvar *default-zone-retry* (* 60 60)
-  "Default znoe retry interval: one hour.")
+(defvar *default-zone-retry* '(20 :minutes)
+  "Default zone retry interval: twenty minutes.")
 
 (export '*default-zone-expire*)
 
 (export '*default-zone-expire*)
-(defvar *default-zone-expire* (* 14 24 60 60)
-  "Default zone expiry time: two weeks.")
+(defvar *default-zone-expire* '(3 :days)
+  "Default zone expiry time: three days.")
 
 (export '*default-zone-min-ttl*)
 
 (export '*default-zone-min-ttl*)
-(defvar *default-zone-min-ttl* (* 4 60 60)
-  "Default zone minimum TTL/negative TTL: four hours.")
+(defvar *default-zone-min-ttl* '(4 :hours)
+  "Default zone minimum/negative TTL: four hours.")
 
 (export '*default-zone-ttl*)
 
 (export '*default-zone-ttl*)
-(defvar *default-zone-ttl* (* 8 60 60)
-  "Default zone TTL (for records without explicit TTLs): 8 hours.")
+(defvar *default-zone-ttl* '(4 :hours)
+  "Default zone TTL (for records without explicit TTLs): four hours.")
 
 (export '*default-mx-priority*)
 (defvar *default-mx-priority* 50
 
 (export '*default-mx-priority*)
 (defvar *default-mx-priority* 50
 
 (export 'rec-raw-string)
 (defun rec-raw-string (s &key (start 0) end)
 
 (export 'rec-raw-string)
 (defun rec-raw-string (s &key (start 0) end)
-  "Append (a (substring of) a raw string S to the current record.
+  "Append (a substring of) a raw string S to the current record.
 
    No arrangement is made for reporting the length of the string.  That must
    be done by the caller, if necessary."
 
    No arrangement is made for reporting the length of the string.  That must
    be done by the caller, if necessary."
   ":cname HOST"
   (rec :data (zone-parse-host data zname)))
 
   ":cname HOST"
   (rec :data (zone-parse-host data zname)))
 
+(defzoneparse :dname (name data rec :zname zname)
+  ":dname HOST"
+  (rec :data (zone-parse-host data zname)))
+
 (defmethod zone-record-rrdata ((type (eql :cname)) zr)
   (rec-name (zr-data zr))
   5)
 
 (defmethod zone-record-rrdata ((type (eql :cname)) zr)
   (rec-name (zr-data zr))
   5)
 
+(defun split-txt-data (data)
+  "Split the string DATA into pieces small enough to fit in a TXT record.
+
+   Return a list of strings L such that (a) (apply #'concatenate 'string L)
+   is equal to the original string DATA, and (b) (every (lambda (s) (<=
+   (length s) 255)) L) is true."
+  (collecting ()
+    (let ((i 0) (n (length data)))
+      (loop
+       (let ((end (+ i 255)))
+         (when (<= n end) (return))
+         (let ((split (acond ((position #\; data :from-end t
+                                        :start i :end end)
+                              (+ it 1))
+                             ((position #\space data :from-end t
+                                        :start i :end end)
+                              (+ it 1))
+                             (t end))))
+           (loop
+             (when (or (>= split end)
+                       (char/= (char data split) #\space))
+               (return))
+             (incf split))
+           (collect (subseq data i split))
+           (setf i split))))
+      (collect (subseq data i)))))
+
 (defzoneparse :txt (name data rec)
   ":txt (TEXT*)"
 (defzoneparse :txt (name data rec)
   ":txt (TEXT*)"
-  (rec :data (listify data)))
+  (rec :data (cond ((stringp data) (split-txt-data data))
+                  (t
+                   (dolist (piece data)
+                     (unless (<= (length piece) 255)
+                       (error "`:txt' record piece `~A' too long" piece)))
+                   data))))
 
 (defmethod zone-record-rrdata ((type (eql :txt)) zr)
   (mapc #'rec-string (zr-data zr))
   16)
 
 
 (defmethod zone-record-rrdata ((type (eql :txt)) zr)
   (mapc #'rec-string (zr-data zr))
   16)
 
+(defzoneparse :spf (name data rec :zname zname)
+  ":spf ([[ (:version STRING) |
+           ({:pass | :fail | :soft | :shrug}
+            {:all |
+             :include LABEL |
+             :a [[ :label LABEL | :v4mask MASK | :v6mask MASK ]] |
+             :ptr [LABEL] |
+             {:ip | :ip4 | :ip6} {STRING | NET | HOST}}) |
+           (:redirect LABEL) |
+           (:exp LABEL) ]])"
+  (rec :type :txt
+       :data
+       (split-txt-data
+       (with-output-to-string (out)
+         (let ((firstp t))
+           (dolist (item data)
+             (if firstp (setf firstp nil)
+                 (write-char #\space out))
+             (let ((head (car item))
+                   (tail (cdr item)))
+             (ecase head
+               (:version (destructuring-bind (ver) tail
+                           (format out "v=~A" ver)))
+               ((:pass :fail :soft :shrug)
+                (let ((qual (ecase head
+                              (:pass #\+)
+                              (:fail #\-)
+                              (:soft #\~)
+                              (:shrug #\?))))
+                  (setf head (pop tail))
+                  (ecase head
+                    (:all
+                     (destructuring-bind () tail
+                       (format out "~Aall" qual)))
+                    ((:include :exists)
+                     (destructuring-bind (label) tail
+                       (format out "~A~(~A~):~A"
+                               qual head
+                               (if (stringp label) label
+                                   (zone-parse-host label zname)))))
+                    ((:a :mx)
+                     (destructuring-bind (&key label v4mask v6mask) tail
+                       (format out "~A~(~A~)~@[:~A~]~@[/~D~]~@[//~D~]"
+                               qual head
+                               (cond ((null label) nil)
+                                     ((stringp label) label)
+                                     (t (zone-parse-host label zname)))
+                               v4mask
+                               v6mask)))
+                    (:ptr
+                     (destructuring-bind (&optional label) tail
+                       (format out "~Aptr~@[:~A~]"
+                               qual
+                               (cond ((null label) nil)
+                                     ((stringp label) label)
+                                     (t (zone-parse-host label zname))))))
+                    ((:ip :ip4 :ip6)
+                     (let* ((family (ecase head
+                                      (:ip t)
+                                      (:ip4 :ipv4)
+                                      (:ip6 :ipv6)))
+                            (nets
+                             (collecting ()
+                               (dolist (net tail)
+                                 (acond
+                                   ((host-find net)
+                                    (let ((any nil))
+                                      (dolist (addr (host-addrs it))
+                                        (when (or (eq family t)
+                                                  (eq family
+                                                      (ipaddr-family addr)))
+                                          (setf any t)
+                                          (collect (make-ipnet
+                                                    addr
+                                                    (ipaddr-width addr)))))
+                                      (unless any
+                                        (error
+                                         "No matching addresses for `~A'"
+                                         net))))
+                                   (t
+                                    (collect-append
+                                     (net-parse-to-ipnets net family))))))))
+                       (setf firstp t)
+                       (dolist (net nets)
+                         (if firstp (setf firstp nil)
+                             (write-char #\space out))
+                         (let* ((width (ipnet-width net))
+                                (mask (ipnet-mask net))
+                                (plen (ipmask-cidr-slash width mask)))
+                           (unless plen
+                             (error "invalid netmask in network ~A" net))
+                           (format out "~A~A:~A~@[/~D~]"
+                                   qual
+                                   (ecase (ipnet-family net)
+                                     (:ipv4 "ip4")
+                                     (:ipv6 "ip6"))
+                                   (ipnet-net net)
+                                   (and (/= plen width) plen)))))))))
+               ((:redirect :exp)
+                (destructuring-bind (label) tail
+                  (format out "~(~A~)=~A"
+                          head
+                          (if (stringp label) label
+                              (zone-parse-host label zname)))))))))))))
+
+
 (export '*dkim-pathname-defaults*)
 (defvar *dkim-pathname-defaults*
   (make-pathname :directory '(:relative "keys")
 (export '*dkim-pathname-defaults*)
 (defvar *dkim-pathname-defaults*
   (make-pathname :directory '(:relative "keys")
 (defzoneparse :dkim (name data rec)
   ":dkim (KEYFILE {:TAG VALUE}*)"
   (destructuring-bind (file &rest plist) (listify 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 (merge-pathnames file *dkim-pathname-defaults*))
-                   (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)))))
+    (rec :type :txt
+        :data
+        (split-txt-data
+         (with-output-to-string (out)
+           (format out "~{~(~A~)=~A; ~}" plist)
+           (write-string "p=" out)
+           (when file
+             (with-open-file
+                 (in (merge-pathnames file *dkim-pathname-defaults*))
+               (loop
+                 (when (string= (read-line in)
+                                "-----BEGIN PUBLIC KEY-----")
+                   (return)))
+               (loop
+                 (let ((line (read-line in)))
+                   (when (string= line "-----END PUBLIC KEY-----")
+                     (return))
+                   (write-string line out))))))))))
+
+(defzoneparse :dmarc (name data rec)
+  ":dmarc ({:TAG VALUE}*)"
+  (rec :type :txt
+       :data (split-txt-data (format nil "~{~(~A~)=~A~^; ~}" data))))
 
 (defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3) (:ed25519 4))
 (defenum sshfp-type () (:sha-1 1) (:sha-256 2))
 
 (defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3) (:ed25519 4))
 (defenum sshfp-type () (:sha-1 1) (:sha-256 2))
@@ -1541,20 +1700,20 @@ $TTL ~2@*~D~2%"
                  copy)))
       (format *zone-output-stream* "~
 ~A~30TIN SOA~40T~A (
                  copy)))
       (format *zone-output-stream* "~
 ~A~30TIN SOA~40T~A (
-~55@A~60T ;administrator
-~45T~10D~60T ;serial
-~45T~10D~60T ;refresh
-~45T~10D~60T ;retry
-~45T~10D~60T ;expire
-~45T~10D )~60T ;min-ttl~2%"
+~55@A~58T; administrator
+~45T~10D~58T; serial
+~45T~10D~58T; refresh: ~{~D ~(~A~)~^ ~}
+~45T~10D~58T; retry: ~{~D ~(~A~)~^ ~}
+~45T~10D~58T; expire: ~{~D ~(~A~)~^ ~}
+~45T~10D )~58T; min-ttl: ~{~D ~(~A~)~^ ~}~2%"
              (bind-output-hostname (zone-name zone))
              (bind-hostname (soa-source soa))
              admin
              (soa-serial soa)
              (bind-output-hostname (zone-name zone))
              (bind-hostname (soa-source soa))
              admin
              (soa-serial soa)
-             (soa-refresh soa)
-             (soa-retry soa)
-             (soa-expire soa)
-             (soa-min-ttl soa))))
+             (soa-refresh soa) (seconds-timespec (soa-refresh soa))
+             (soa-retry soa) (seconds-timespec (soa-retry soa))
+             (soa-expire soa) (seconds-timespec (soa-expire soa))
+             (soa-min-ttl soa) (seconds-timespec (soa-min-ttl soa)))))
 
 (export 'bind-format-record)
 (defun bind-format-record (zr format &rest args)
 
 (export 'bind-format-record)
 (defun bind-format-record (zr format &rest args)
@@ -1615,6 +1774,9 @@ $TTL ~2@*~D~2%"
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :cname)) zr)
   (bind-format-record zr "~A~%" (bind-hostname (zr-data zr))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :cname)) zr)
   (bind-format-record zr "~A~%" (bind-hostname (zr-data zr))))
 
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :dname)) zr)
+  (bind-format-record zr "~A~%" (bind-hostname (zr-data zr))))
+
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :ns)) zr)
   (bind-format-record zr "~A~%" (bind-hostname (zr-data zr))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :ns)) zr)
   (bind-format-record zr "~A~%" (bind-hostname (zr-data zr))))