From f1d7d492baa865026add48fa604328c87ac7042e Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Thu, 3 Apr 2014 18:44:26 +0100 Subject: [PATCH] zone.lisp: Support for SSHFP records. Organization: Straylight/Edgeware From: Mark Wooding Fingerprints can be supplied explicitly or read from files in the format written by ssh-keygen(1). --- zone.lisp | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/zone.lisp b/zone.lisp index 762c6e2..8d35c09 100644 --- a/zone.lisp +++ b/zone.lisp @@ -664,6 +664,45 @@ (defzoneparse :dkim (name data rec) (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)))) + +(defzoneparse :sshfp (name data rec) + ":sshfp { FILENAME | ((FPR :alg ALG :type HASH)*) }" + (if (stringp data) + (with-open-file (in data) + (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 +976,8 @@ (defgeneric bind-record-format-args (type data) (: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))))) -- [mdw]