zone.lisp (:dkim): Replace a loop with `format' trickery.

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index a80428fa6882404964f63faf0563d26616e324d8..b1e3050bb148d9a31cd3931095080f89fcdb76f7 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -26,7 +26,7 @@
 
 (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))
 
@@ -776,7 +776,7 @@ (defun rec-u32 (value)
 
 (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."
@@ -868,9 +868,36 @@ (defmethod zone-record-rrdata ((type (eql :cname)) zr)
   (rec-name (zr-data zr))
   5)
 
+(defun split-txt-data (data)
+  (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*)"
-  (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))
@@ -885,47 +912,24 @@ (pushnew '*dkim-pathname-defaults* *zone-config*)
 (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))))))))))
 
 (defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3) (:ed25519 4))
 (defenum sshfp-type () (:sha-1 1) (:sha-256 2))