zone.lisp: Memoize the conversion of TLSA association-data files.

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 841d62a..a90490a 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -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)*)"