X-Git-Url: https://git.distorted.org.uk/~mdw/zone/blobdiff_plain/ec2fff38d12f7e6ab1070d131cbac8764850f8ea..7cf6460add07baab255155f105f3a37aa71a0f69:/zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 9e52569..96cddfb 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -497,7 +497,7 @@
 				      :ttl ttl :records (cdr r))
 				     sub)))
 			 (t
-			  (error "Unexpected record form ~A" (car r))))))))
+			  (error "Unexpected record form ~A" r)))))))
 
 	   (process (rec dom ttl)
 	     ;; Recursirvely process the record list REC, with a list DOM of
@@ -687,9 +687,9 @@
 (defmacro defrevzone (head &body zf)
   "Define a reverse zone, with the correct name."
   (destructuring-bind (nets &rest args
-			    &key &allow-other-keys
-				 (family '*address-family*)
-				 prefix-bits)
+			    &key (family '*address-family*)
+				 prefix-bits
+				 &allow-other-keys)
       (listify head)
     (with-gensyms (ipn)
       `(dolist (,ipn (net-parse-to-ipnets ',nets ,family))
@@ -946,26 +946,23 @@
 			      (= (length words) 4))
 		   (error "Invalid SSHFP record."))
 		 (pop words)
-		 (destructuring-bind (alg type fpr) words
+		 (destructuring-bind (alg type fprhex) words
 		   (rec :data (list (parse-integer alg)
 				    (parse-integer type)
-				    fpr))))))))
+				    (decode-hex fprhex)))))))))
     (t
      (dolist (item (listify data))
-       (destructuring-bind (fpr &key (alg 'rsa) (type 'sha-1))
+       (destructuring-bind (fprhex &key (alg 'rsa) (type 'sha-1))
 	   (listify item)
 	 (rec :data (list (lookup-enum alg 'sshfp-algorithm :min 0 :max 255)
 			  (lookup-enum type 'sshfp-type :min 0 :max 255)
-			  fpr)))))))
+			  (decode-hex fprhex))))))))
 
 (defmethod zone-record-rrdata ((type (eql :sshfp)) zr)
   (destructuring-bind (alg type fpr) (zr-data zr)
     (rec-u8 alg)
     (rec-u8 type)
-    (do ((i 0 (+ i 2))
-	 (n (length fpr)))
-	((>= i n))
-      (rec-u8 (parse-integer fpr :start i :end (+ i 2) :radix 16))))
+    (rec-octet-vector fpr))
   44)
 
 (defenum tlsa-usage ()
@@ -1273,6 +1270,29 @@
     (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))
@@ -1609,13 +1629,19 @@ $TTL ~2@*~D~2%"
 			prio weight port (bind-hostname host))))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :sshfp)) zr)
-  (bind-format-record zr "~{~2D ~2D ~A~}~%" (zr-data zr)))
+  (destructuring-bind (alg type fpr) (zr-data zr)
+    (bind-format-record zr "~2D ~2D " alg type)
+    (bind-write-hex fpr 12)))
 
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :tlsa)) zr)
   (destructuring-bind (usage selector match data) (zr-data 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)