zone.lisp: For BIND output, omit record names where possible.

This makes the output easier to read, especially now the records are
sorted.

diff --git a/zone.lisp b/zone.lisp
index ec081ef..b9c8fa1 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -1017,20 +1017,33 @@
 ;;;--------------------------------------------------------------------------
 ;;; Bind format output.
 
 ;;;--------------------------------------------------------------------------
 ;;; Bind format output.
 

+(defvar *bind-last-record-name* nil
+  "The previously emitted record name.
+
+   Used for eliding record names on output.")
+

 (export 'bind-hostname)
 (defun bind-hostname (hostname)
 (export 'bind-hostname)
 (defun bind-hostname (hostname)

-  (if (not hostname)
-      "@"
-      (let* ((h (string-downcase (stringify hostname)))
-            (hl (length h))
-            (r (string-downcase (zone-name *writing-zone*)))
-            (rl (length r)))
-       (cond ((string= r h) "@")
-             ((and (> hl rl)
-                   (char= (char h (- hl rl 1)) #\.)
-                   (string= h r :start1 (- hl rl)))
-              (subseq h 0 (- hl rl 1)))
-             (t (concatenate 'string h "."))))))
+  (let* ((h (string-downcase (stringify hostname)))
+        (hl (length h))
+        (r (string-downcase (zone-name *writing-zone*)))
+        (rl (length r)))
+    (cond ((string= r h) "@")
+         ((and (> hl rl)
+               (char= (char h (- hl rl 1)) #\.)
+               (string= h r :start1 (- hl rl)))
+          (subseq h 0 (- hl rl 1)))
+         (t (concatenate 'string h ".")))))
+
+(export 'bind-output-hostname)
+(defun bind-output-hostname (hostname)
+  (let ((name (bind-hostname hostname)))
+    (cond ((and *bind-last-record-name*
+               (string= name *bind-last-record-name*))
+          "")
+         (t
+          (setf *bind-last-record-name* name)
+          name))))

 
 (export 'bind-record)
 (defgeneric bind-record (type zr))
 
 (export 'bind-record)
 (defgeneric bind-record (type zr))


@@ -1045,7 +1058,8 @@ $TTL ~2@*~D~2%"
            (zone-name zone)
            (iso-date :now :datep t :timep t)
            (zone-default-ttl zone))
            (zone-name zone)
            (iso-date :now :datep t :timep t)
            (zone-default-ttl zone))

-  (let* ((soa (zone-soa zone))
+  (let* ((*bind-last-record-name* nil)
+        (soa (zone-soa zone))

         (admin (let* ((name (soa-admin soa))
                       (at (position #\@ name))
                       (copy (format nil "~(~A~)." name)))
         (admin (let* ((name (soa-admin soa))
                       (at (position #\@ name))
                       (copy (format nil "~(~A~)." name)))


@@ -1060,22 +1074,22 @@ $TTL ~2@*~D~2%"
 ~45T~10D~60T ;retry
 ~45T~10D~60T ;expire
 ~45T~10D )~60T ;min-ttl~2%"
 ~45T~10D~60T ;retry
 ~45T~10D~60T ;expire
 ~45T~10D )~60T ;min-ttl~2%"

-             (bind-hostname (zone-name zone))
+             (bind-output-hostname (zone-name zone))

              (bind-hostname (soa-source soa))
              admin
              (soa-serial soa)
              (soa-refresh soa)
              (soa-retry soa)
              (soa-expire soa)
              (bind-hostname (soa-source soa))
              admin
              (soa-serial soa)
              (soa-refresh soa)
              (soa-retry soa)
              (soa-expire soa)

-             (soa-min-ttl soa)))
-  (dolist (zr (zone-records-sorted zone))
-    (bind-record (zr-type zr) zr)))
+             (soa-min-ttl soa))
+      (dolist (zr (zone-records-sorted zone))
+       (bind-record (zr-type zr) zr))))

 
 (export 'bind-format-record)
 (defun bind-format-record (name ttl type format args)
   (format *zone-output-stream*
          "~A~20T~@[~8D~]~30TIN ~A~40T~?~%"
 
 (export 'bind-format-record)
 (defun bind-format-record (name ttl type format args)
   (format *zone-output-stream*
          "~A~20T~@[~8D~]~30TIN ~A~40T~?~%"

-         (bind-hostname name)
+         (bind-output-hostname name)

          (and (/= ttl (zone-default-ttl *writing-zone*))
               ttl)
          (string-upcase (symbol-name type))
          (and (/= ttl (zone-default-ttl *writing-zone*))
               ttl)
          (string-upcase (symbol-name type))