zone.lisp: Apply pathname templates to DKIM and SSHFP files.

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 762c6e2..f03b9dd 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -207,8 +207,12 @@
   records)
 
 (export '*zone-output-path*)
-(defvar *zone-output-path* *default-pathname-defaults*
-  "Pathname defaults to merge into output files.")
+(defvar *zone-output-path* nil
+  "Pathname defaults to merge into output files.
+
+   If this is nil then use the prevailing `*default-pathname-defaults*'.
+   This is not the same as capturing the `*default-pathname-defaults*' from
+   load time.")
 
 (export '*preferred-subnets*)
 (defvar *preferred-subnets* nil
@@ -221,7 +225,7 @@
   "Choose a file name for a given ZONE and TYPE."
   (merge-pathnames (make-pathname :name (string-downcase zone)
                                  :type (string-downcase type))
-                  *zone-output-path*))
+                  (or *zone-output-path* *default-pathname-defaults*)))
 
 (export 'zone-preferred-subnet-p)
 (defun zone-preferred-subnet-p (name)
@@ -622,6 +626,11 @@
   ":txt TEXT"
   (rec :data data))
 
+(export '*dkim-pathname-defaults*)
+(defvar *dkim-pathname-defaults*
+  (make-pathname :directory '(:relative "keys")
+                :type "dkim"))
+
 (defzoneparse :dkim (name data rec)
   ":dkim (KEYFILE {:TAG VALUE}*)"
   (destructuring-bind (file &rest plist) (listify data)
@@ -651,7 +660,8 @@
        (emit (with-output-to-string (out)
                (write-string "p=" out)
                (when file
-                 (with-open-file (in file :direction :input)
+                 (with-open-file
+                     (in (merge-pathnames file *dkim-pathname-defaults*))
                    (loop
                      (when (string= (read-line in)
                                     "-----BEGIN PUBLIC KEY-----")
@@ -664,6 +674,50 @@
       (rec :type :txt
           :data (nreverse things)))))
 
+(eval-when (:load-toplevel :execute)
+  (dolist (item '((sshfp-algorithm rsa 1)
+                 (sshfp-algorithm dsa 2)
+                 (sshfp-algorithm ecdsa 3)
+                 (sshfp-type sha-1 1)
+                 (sshfp-type sha-256 2)))
+    (destructuring-bind (prop sym val) item
+      (setf (get sym prop) val)
+      (export sym))))
+
+(export '*sshfp-pathname-defaults*)
+(defvar *sshfp-pathname-defaults*
+  (make-pathname :directory '(:relative "keys")
+                :type "sshfp"))
+
+(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)))))))
+      (flet ((lookup (what prop)
+              (etypecase what
+                (fixnum what)
+                (symbol (or (get what prop)
+                            (error "~S is not a known ~A" what prop))))))
+       (dolist (item (listify data))
+         (destructuring-bind (fpr &key (alg 'rsa) (type 'sha-1))
+             (listify item)
+           (rec :data (list (lookup alg 'sshfp-algorithm)
+                            (lookup type 'sshfp-type)
+                            fpr)))))))
+
 (defzoneparse :mx (name data rec :zname zname)
   ":mx ((HOST :prio INT :ip IPADDR)*)"
   (dolist (mx (listify data))
@@ -937,6 +991,8 @@ $TTL ~2@*~D~2%"
   (:method ((type (eql :srv)) data)
     (destructuring-bind (prio weight port host) data
       (list "~2D ~5D ~5D ~A" prio weight port (bind-hostname host))))
+  (:method ((type (eql :sshfp)) data)
+    (cons "~2D ~2D ~A" data))
   (:method ((type (eql :txt)) data)
     (cons "~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]"
          (mapcar #'stringify (listify data)))))