zone.lisp: Abstract out Bind hex output from `zone-write-raw-rrdata'.
authorMark Wooding <mdw@distorted.org.uk>
Mon, 22 Dec 2014 20:40:11 +0000 (20:40 +0000)
committerMark Wooding <mdw@distorted.org.uk>
Mon, 22 Dec 2014 22:23:05 +0000 (22:23 +0000)
It's had a bit of a rewrite (to do less consing) during the move.

zone.lisp

index e819cd1..5e0b0a9 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -1253,30 +1253,41 @@ $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))))