+(defzoneparse :txt (name data rec)
+ ":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)
+ (let ((things nil) (out nil))
+ (labels ((flush ()
+ (when out
+ (push (get-output-stream-string out) things)
+ (setf out nil)))
+ (emit (text)
+ (let ((len (length text)))
+ (when (and out (> (+ (file-position out)
+ (length text))
+ 64))
+ (flush))
+ (when (plusp len)
+ (cond ((< len 64)
+ (unless out (setf out (make-string-output-stream)))
+ (write-string text out))
+ (t
+ (do ((i 0 j)
+ (j 64 (+ j 64)))
+ ((>= i len))
+ (push (subseq text i (min j len)) things))))))))
+ (do ((p plist (cddr p)))
+ ((endp p))
+ (emit (format nil "~(~A~)=~A;" (car p) (cadr p))))
+ (emit (with-output-to-string (out)
+ (write-string "p=" out)
+ (when file
+ (with-open-file
+ (in (merge-pathnames file *dkim-pathname-defaults*))
+ (loop
+ (when (string= (read-line in)
+ "-----BEGIN PUBLIC KEY-----")
+ (return)))
+ (loop
+ (let ((line (read-line in)))
+ (if (string= line "-----END PUBLIC KEY-----")
+ (return)
+ (write-string line out)))))))))
+ (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)))))))
+