X-Git-Url: https://git.distorted.org.uk/~mdw/zone/blobdiff_plain/62e6acc94115a7a1889b5ad817c30aa5d09f512c..d180e4a8771820af6aecfc5278a8b84ae2afbcac:/zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 841d62a..6d6dce9 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -237,10 +237,6 @@
   min-ttl
   serial)
 
-(export 'zone-text-name)
-(defun zone-text-name (zone)
-  (princ-to-string (zone-name zone)))
-
 (export 'mx)
 (defstruct (mx (:predicate mxp))
   "Mail-exchange record information."
@@ -255,6 +251,10 @@
   name
   records)
 
+(export 'zone-text-name)
+(defun zone-text-name (zone)
+  (princ-to-string (zone-name zone)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Zone defaults.  It is intended that scripts override these.
 
@@ -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
@@ -694,8 +694,8 @@
     (with-gensyms (ipn)
       `(dolist (,ipn (net-parse-to-ipnets ',nets ,family))
 	 (let ((*address-family* (ipnet-family ,ipn)))
-	   (zone-create `((,(format nil "~A." (reverse-domain ,ipn
-							      ,prefix-bits))
+	   (zone-create `((,(format nil "~A" (reverse-domain ,ipn
+							     ,prefix-bits))
 			    ,@',(loop for (k v) on args by #'cddr
 				      unless (member k
 						     '(:family :prefix-bits))
@@ -923,7 +923,7 @@
       (rec :type :txt
 	   :data (nreverse things)))))
 
-(defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3))
+(defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3) (:ed25519 4))
 (defenum sshfp-type () (:sha-1 1) (:sha-256 2))
 
 (export '*sshfp-pathname-defaults*)
@@ -1077,6 +1077,16 @@
 		       (return value)))
 		   'tlsa-selector))))))
 
+(export '*tlsa-pathname-defaults*)
+(defvar *tlsa-pathname-defaults*
+  (list (make-pathname :directory '(:relative "certs") :type "cert")
+	(make-pathname :directory '(:relative "keys") :type "pub"))
+  "Default pathname components for TLSA records.")
+(pushnew '*tlsa-pathname-defaults* *zone-config*)
+
+(defparameter *tlsa-data-cache* (make-hash-table :test #'equal)
+  "Cache for TLSA association data; keys are (DATA SELECTOR MATCH).")
+
 (defun convert-tlsa-selector-data (data selector match)
   "Convert certificate association DATA as required by SELECTOR and MATCH.
 
@@ -1097,10 +1107,19 @@
 		(reverse-enum 'tlsa-match match)))
        bin))
     (pathname
-     (with-temporary-files (context :base "tmpfile.tmp")
-       (let* ((kind (identify-tlsa-selector-file data))
-	      (raw (raw-tlsa-assoc-data kind selector data context)))
-	 (read-tlsa-match-data match raw context))))))
+     (let ((key (list data selector match)))
+       (or (gethash key *tlsa-data-cache*)
+	   (with-temporary-files (context :base (make-pathname :type "tmp"))
+	     (let* ((file (or (find-if #'probe-file
+				       (mapcar (lambda (template)
+						 (merge-pathnames data
+								  template))
+					       *tlsa-pathname-defaults*))
+			      (error "Couldn't find TLSA file `~A'" data)))
+		    (kind (identify-tlsa-selector-file file))
+		    (raw (raw-tlsa-assoc-data kind selector file context))
+		    (binary (read-tlsa-match-data match raw context)))
+	       (setf (gethash key *tlsa-data-cache*) binary))))))))
 
 (defzoneparse :tlsa (name data rec)
   ":tlsa (((SERVICE|PORT &key :protocol)*) (USAGE SELECTOR MATCH DATA)*)"
@@ -1144,6 +1163,39 @@
     (rec-octet-vector data))
   52)
 
+(defenum dnssec-algorithm ()
+  (:rsamd5 1)
+  (:dh 2)
+  (:dsa 3)
+  (:rsasha1 5)
+  (:dsa-nsec3-sha1 6)
+  (:rsasha1-nsec3-sha1 7)
+  (:rsasha256 8)
+  (:rsasha512 10)
+  (:ecc-gost 12)
+  (:ecdsap256sha256 13)
+  (:ecdsap384sha384 14))
+
+(defenum dnssec-digest ()
+  (:sha1 1)
+  (:sha256 2))
+
+(defzoneparse :ds (name data rec)
+  ":ds ((TAG ALGORITHM DIGEST-TYPE DIGEST)*)"
+  (dolist (ds data)
+    (destructuring-bind (tag alg hashtype hash) ds
+      (rec :data (list tag
+		       (lookup-enum 'dnssec-algorithm alg :min 0 :max 255)
+		       (lookup-enum 'dnssec-digest hashtype :min 0 :max 255)
+		       (decode-hex hash))))))
+
+(defmethod zone-record-rrdata ((type (eql :ds)) zr)
+  (destructuring-bind (tag alg hashtype hash) zr
+    (rec-u16 tag)
+    (rec-u8 alg)
+    (rec-u8 hashtype)
+    (rec-octet-vector hash)))
+
 (defzoneparse :mx (name data rec :zname zname)
   ":mx ((HOST :prio INT :ip IPADDR)*)"
   (dolist (mx (listify data))
@@ -1564,6 +1616,11 @@ $TTL ~2@*~D~2%"
     (bind-format-record zr "~2D ~2D ~2D " usage selector match)
     (bind-write-hex data 12)))
 
+(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)
+    (bind-write-hex hash 12)))
+
 (defmethod zone-write-record ((format (eql :bind)) (type (eql :txt)) zr)
   (bind-format-record zr "~{~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]~}~%"
 		      (zr-data zr)))