zone.lisp: Split a single `:txt' string into small enough pieces.

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 031a15dbaa57a598f84571ea22732233cd304d16..5589361a4e48b96db81af533d80bf1b941a54967 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -26,7 +26,7 @@
 
 (defpackage #:zone
   (:use #:common-lisp
 
 (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))
 
        #:net #:services)
   (:import-from #:net #:round-down #:round-up))
 


@@ -868,9 +868,36 @@ (defmethod zone-record-rrdata ((type (eql :cname)) zr)
   (rec-name (zr-data zr))
   5)
 
   (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*)"
 (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))
 
 (defmethod zone-record-rrdata ((type (eql :txt)) zr)
   (mapc #'rec-string (zr-data zr))