X-Git-Url: https://git.distorted.org.uk/~mdw/zone/blobdiff_plain/29d9eca406634f25c1bdae7ca659760454f1100a..b2581b11862dfe93881d9eb236b374d9a066581a:/zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 7db70b1..1557c0a 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -35,6 +35,14 @@
 ;;;--------------------------------------------------------------------------
 ;;; Various random utilities.
 
+(export '*zone-config*)
+(defparameter *zone-config* nil
+  "A list of configuration variables.
+
+   This is for the benefit of the frontend, which will dynamically bind them
+   so that input files can override them independently.  Not intended for use
+   by users.")
+
 (defun to-integer (x)
   "Convert X to an integer in the most straightforward way."
   (floor (rational x)))
@@ -868,6 +876,7 @@
 (defvar *dkim-pathname-defaults*
   (make-pathname :directory '(:relative "keys")
 		 :type "dkim"))
+(pushnew '*dkim-pathname-defaults* *zone-config*)
 
 (defzoneparse :dkim (name data rec)
   ":dkim (KEYFILE {:TAG VALUE}*)"
@@ -919,32 +928,35 @@
 
 (export '*sshfp-pathname-defaults*)
 (defvar *sshfp-pathname-defaults*
-  (make-pathname :directory '(:relative "keys")
-		 :type "sshfp"))
+  (make-pathname :directory '(:relative "keys") :type "sshfp")
+  "Default pathname components for SSHFP records.")
+(pushnew '*sshfp-pathname-defaults* *zone-config*)
 
 (defzoneparse :sshfp (name data rec)
   ":sshfp { FILENAME | ((FPR :alg ALG :type HASH)*) }"
-  (if (stringp data)
-      (with-open-file (in (merge-pathnames data *sshfp-pathname-defaults*))
-	(loop (let ((line (read-line in nil)))
-		(unless line (return))
-		(let ((words (str-split-words line)))
-		  (pop words)
-		  (when (string= (car words) "IN") (pop words))
-		  (unless (and (string= (car words) "SSHFP")
-			       (= (length words) 4))
-		    (error "Invalid SSHFP record."))
-		  (pop words)
-		  (destructuring-bind (alg type fpr) words
-		    (rec :data (list (parse-integer alg)
-				     (parse-integer type)
-				     fpr)))))))
-      (dolist (item (listify data))
-	(destructuring-bind (fpr &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))))))
+  (typecase data
+    ((or string pathname)
+     (with-open-file (in (merge-pathnames data *sshfp-pathname-defaults*))
+       (loop (let ((line (read-line in nil)))
+	       (unless line (return))
+	       (let ((words (str-split-words line)))
+		 (pop words)
+		 (when (string= (car words) "IN") (pop words))
+		 (unless (and (string= (car words) "SSHFP")
+			      (= (length words) 4))
+		   (error "Invalid SSHFP record."))
+		 (pop words)
+		 (destructuring-bind (alg type fpr) words
+		   (rec :data (list (parse-integer alg)
+				    (parse-integer type)
+				    fpr))))))))
+    (t
+     (dolist (item (listify data))
+       (destructuring-bind (fpr &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)))))))
 
 (defmethod zone-record-rrdata ((type (eql :sshfp)) zr)
   (destructuring-bind (alg type fpr) (zr-data zr)
@@ -1065,6 +1077,13 @@
 		       (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*)
+
 (defun convert-tlsa-selector-data (data selector match)
   "Convert certificate association DATA as required by SELECTOR and MATCH.
 
@@ -1085,9 +1104,14 @@
 		(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)))
+     (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)))
 	 (read-tlsa-match-data match raw context))))))
 
 (defzoneparse :tlsa (name data rec)
@@ -1396,7 +1420,8 @@
 	  (error "Unknown zone `~A'." z))
 	(let ((stream (safely-open-output-stream safe
 						 (zone-file-name z :zone))))
-	  (zone-write format zz stream))))))
+	  (zone-write format zz stream)
+	  (close stream))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Bind format output.