chiark / gitweb /
zone.lisp: Abstract out Bind hex output from `zone-write-raw-rrdata'.
[zone] / zone.lisp
index e819cd19bd7bcdd4d518cca30733cc47da65d823..5e0b0a949d7ef2add1a74f431bca40dd45bccab6 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -1253,30 +1253,41 @@ (defun bind-format-record (zr format &rest args)
          (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))))