zone.lisp: Add support for CAA records (RFC 6844).

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index a1e74b70c11448eb7823019863c0cffa96648256..22670261ab5a6040a3bdc7636c0d001f900081f8 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -1273,6 +1273,29 @@ (defmethod zone-record-rrdata ((type (eql :srv)) zr)
     (rec-name host))
   33)
 
+(defenum caa-flag () (:critical 128))
+
+(defzoneparse :caa (name data rec)
+  ":caa ((TAG VALUE FLAG*)*)"
+  (dolist (prop data)
+    (destructuring-bind (tag value &rest flags) prop
+      (setf flags (reduce #'logior
+                         (mapcar (lambda (item)
+                                   (lookup-enum 'caa-flag item
+                                                :min 0 :max 255))
+                                 flags)))
+      (ecase tag
+       ((:issue :issuewild :iodef)
+        (rec :name name
+             :data (list flags tag value)))))))
+
+(defmethod zone-record-rrdata ((type (eql :caa)) zr)
+  (destructuring-bind (flags tag value) (zr-data zr)
+    (rec-u8 flags)
+    (rec-string (string-downcase tag))
+    (rec-raw-string value))
+  257)
+
 (defzoneparse :net (name data rec)
   ":net (NETWORK*)"
   (dolist (net (listify data))
@@ -1616,6 +1639,10 @@ (defmethod zone-write-record ((format (eql :bind)) (type (eql :tlsa)) zr)
     (bind-format-record zr "~2D ~2D ~2D " usage selector match)
     (bind-write-hex data 12)))
 
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :caa)) zr)
+  (destructuring-bind (flags tag value) (zr-data zr)
+    (bind-format-record zr "~3D ~(~A~) ~S~%" flags tag value)))
+
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :ds)) zr)
   (destructuring-bind (tag alg hashtype hash) (zr-data zr)
     (bind-format-record zr "~5D ~2D ~2D " tag alg hashtype)