zone.lisp: Abstract out Bind hex output from `zone-write-raw-rrdata'.

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index c5a55b7..5e0b0a9 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -832,13 +832,15 @@
                     (flush))
                   (when (plusp len)
                     (cond ((< len 64)
-                           (unless out (setf out (make-string-output-stream)))
+                           (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))))))))
+                             (push (subseq text i (min j len))
+                                   things))))))))
        (do ((p plist (cddr p)))
            ((endp p))
          (emit (format nil "~(~A~)=~A;" (car p) (cadr p))))
@@ -859,8 +861,8 @@
       (rec :type :txt
           :data (nreverse things)))))
 
-(defenum sshfp-algorithm (rsa 1) (dsa 2) (ecdsa 3))
-(defenum sshfp-type (sha-1 1) (sha-256 2))
+(defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3))
+(defenum sshfp-type () (:sha-1 1) (:sha-256 2))
 
 (export '*sshfp-pathname-defaults*)
 (defvar *sshfp-pathname-defaults*
@@ -1243,7 +1245,7 @@ $TTL ~2@*~D~2%"
 (export 'bind-format-record)
 (defun bind-format-record (zr format &rest args)
   (format *zone-output-stream*
-         "~A~20T~@[~8D~]~30TIN ~A~40T~?~%"
+         "~A~20T~@[~8D~]~30TIN ~A~40T~?"
          (bind-output-hostname (zr-name zr))
          (let ((ttl (zr-ttl zr)))
            (and (/= ttl (zone-default-ttl *writing-zone*))
@@ -1251,61 +1253,73 @@ $TTL ~2@*~D~2%"
          (string-upcase (symbol-name (zr-type zr)))
          format args))
 
+(export 'bind-write-hex)
+(defun bind-write-hex (vector remain)
+  "Output the VECTOR as hex, in Bind format.
+
+   If the length (in bytes) is less than REMAIN then it's placed on the
+   current line; otherwise the Bind line-continuation syntax is used."
+  (flet ((output-octet (octet)
+          (format *zone-output-stream* "~(~2,'0X~)" octet)))
+    (let ((len (length vector)))
+      (cond ((< len remain)
+            (dotimes (i len) (output-octet (aref vector i)))
+            (terpri *zone-output-stream*))
+           (t
+            (format *zone-output-stream* "(")
+            (let ((i 0))
+            (loop
+              (when (>= i len) (return))
+              (let ((limit (min len (+ i 64))))
+                (format *zone-output-stream* "~%~8T")
+                (loop
+                  (when (>= i limit) (return))
+                  (output-octet (aref vector i))
+                  (incf i)))))
+            (format *zone-output-stream* " )~%"))))))
+
 (defmethod zone-write-raw-rrdata ((format (eql :bind)) zr type data)
   (format *zone-output-stream*
-         "~A~20T~@[~8D~]~30TIN TYPE~A~40T\\# ~A"
+         "~A~20T~@[~8D~]~30TIN TYPE~A~40T\\# ~A "
          (bind-output-hostname (zr-name zr))
          (let ((ttl (zr-ttl zr)))
            (and (/= ttl (zone-default-ttl *writing-zone*))
                 ttl))
          type
          (length data))
-  (let* ((hex (with-output-to-string (out)
-              (dotimes (i (length data))
-                (format out "~(~2,'0X~)" (aref data i)))))
-        (len (length hex)))
-    (cond ((< len 24)
-          (format *zone-output-stream* " ~A~%" hex))
-         (t
-          (format *zone-output-stream* " (")
-          (let ((i 0))
-            (loop
-              (when (>= i len) (return))
-              (let ((j (min (+ i 64) len)))
-                (format *zone-output-stream* "~%~8T~A" (subseq hex i j))
-                (setf i j))))
-          (format *zone-output-stream* " )~%")))))
+  (bind-write-hex data 12))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :a)) zr)
-  (bind-format-record zr "~A" (ipaddr-string (zr-data zr))))
+  (bind-format-record zr "~A~%" (ipaddr-string (zr-data zr))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :aaaa)) zr)
-  (bind-format-record zr "~A" (ipaddr-string (zr-data zr))))
+  (bind-format-record zr "~A~%" (ipaddr-string (zr-data zr))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :ptr)) zr)
-  (bind-format-record zr "~A" (bind-hostname (zr-data 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))))
+  (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))))
+  (bind-format-record zr "~A~%" (bind-hostname (zr-data zr))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :mx)) zr)
-  (bind-format-record zr "~2D ~A"
+  (bind-format-record zr "~2D ~A~%"
                      (cdr (zr-data zr))
                      (bind-hostname (car (zr-data zr)))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :srv)) zr)
   (destructuring-bind (prio weight port host) (zr-data zr)
-    (bind-format-record zr "~2D ~5D ~5D ~A"
+    (bind-format-record zr "~2D ~5D ~5D ~A~%"
                        prio weight port (bind-hostname host))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :sshfp)) zr)
-  (bind-format-record zr "~{~2D ~2D ~A~}" (zr-data zr)))
+  (bind-format-record zr "~{~2D ~2D ~A~}~%" (zr-data zr)))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :txt)) zr)
-  (bind-format-record zr "~{~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]~}" (zr-data zr)))
+  (bind-format-record zr "~{~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]~}~%"
+                     (zr-data zr)))
 
 ;;;--------------------------------------------------------------------------
 ;;; tinydns-data output format.
@@ -1320,7 +1334,7 @@ $TTL ~2@*~D~2%"
                    (dotimes (i (length data))
                      (let ((byte (aref data i)))
                        (if (or (<= byte 32)
-                               (>= byte 128)
+                               (>= byte 127)
                                (member byte '(#\: #\\) :key #'char-code))
                            (format out "\\~3,'0O" byte)
                            (write-char (code-char byte) out)))))