From 29d9eca406634f25c1bdae7ca659760454f1100a Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Mon, 22 Dec 2014 22:20:56 +0000 Subject: [PATCH] zone.lisp: Support for TLSA records. --- zone.lisp | 181 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 181 insertions(+) diff --git a/zone.lisp b/zone.lisp index 177ded6..7db70b1 100644 --- a/zone.lisp +++ b/zone.lisp @@ -956,6 +956,182 @@ (rec-u8 (parse-integer fpr :start i :end (+ i 2) :radix 16)))) 44) +(defenum tlsa-usage () + (:ca-constraint 0) + (:service-certificate-constraint 1) + (:trust-anchor-assertion 2) + (:domain-issued-certificate 3)) + +(defenum tlsa-selector () + (:certificate 0) + (:public-key 1)) + +(defenum tlsa-match () + (:exact 0) + (:sha-256 1) + (:sha-512 2)) + +(defparameter tlsa-pem-alist + `(("CERTIFICATE" . ,tlsa-selector/certificate) + ("PUBLIC-KEY" . ,tlsa-selector/public-key))) + +(defgeneric raw-tlsa-assoc-data (have want file context) + (:documentation + "Convert FILE, and strip off PEM encoding. + + The FILE contains PEM-encoded data of type HAVE -- one of the + `tlsa-selector' codes. Return the name of a file containing binary + DER-encoded data of type WANT instead. The CONTEXT is a temporary-files + context.") + + (:method (have want file context) + (declare (ignore context)) + (error "Can't convert `~A' from selector type ~S to type ~S" file + (reverse-enum 'tlsa-selector have) + (reverse-enum 'tlsa-selector want))) + + (:method ((have (eql tlsa-selector/certificate)) + (want (eql tlsa-selector/certificate)) + file context) + (let ((temp (temporary-file context "cert"))) + (run-program (list "openssl" "x509" "-outform" "der") + :input file :output temp) + temp)) + + (:method ((have (eql tlsa-selector/public-key)) + (want (eql tlsa-selector/public-key)) + file context) + (let ((temp (temporary-file context "pubkey-der"))) + (run-program (list "openssl" "pkey" "-pubin" "-outform" "der") + :input file :output temp) + temp)) + + (:method ((have (eql tlsa-selector/certificate)) + (want (eql tlsa-selector/public-key)) + file context) + (let ((temp (temporary-file context "pubkey"))) + (run-program (list "openssl" "x509" "-noout" "-pubkey") + :input file :output temp) + (raw-tlsa-assoc-data want want temp context)))) + +(defgeneric tlsa-match-data-valid-p (match data) + (:documentation + "Check whether the DATA (an octet vector) is valid for the MATCH type.") + + (:method (match data) + (declare (ignore match data)) + ;; We don't know: assume the user knows what they're doing. + t) + + (:method ((match (eql tlsa-match/sha-256)) data) (= (length data) 32)) + (:method ((match (eql tlsa-match/sha-512)) data) (= (length data) 64))) + +(defgeneric read-tlsa-match-data (match file context) + (:documentation + "Read FILE, and return an octet vector for the correct MATCH type. + + CONTEXT is a temporary-files context.") + (:method ((match (eql tlsa-match/exact)) file context) + (declare (ignore context)) + (slurp-file file 'octet)) + (:method ((match (eql tlsa-match/sha-256)) file context) + (hash-file "sha256" file context)) + (:method ((match (eql tlsa-match/sha-512)) file context) + (hash-file "sha512" file context))) + +(defgeneric tlsa-selector-pem-boundary (selector) + (:documentation + "Return the PEM boundary string for objects of the SELECTOR type") + (:method ((selector (eql tlsa-selector/certificate))) "CERTIFICATE") + (:method ((selector (eql tlsa-selector/public-key))) "PUBLIC KEY") + (:method (selector) (declare (ignore selector)) nil)) + +(defun identify-tlsa-selector-file (file) + "Return the selector type for the data stored in a PEM-format FILE." + (with-open-file (in file) + (loop + (let* ((line (read-line in nil)) + (len (length line))) + (unless line + (error "No PEM boundary in `~A'" file)) + (when (and (>= len 11) + (string= line "-----BEGIN " :end1 11) + (string= line "-----" :start1 (- len 5))) + (mapenum (lambda (tag value) + (declare (ignore tag)) + (when (string= line + (tlsa-selector-pem-boundary value) + :start1 11 :end1 (- len 5)) + (return value))) + 'tlsa-selector)))))) + +(defun convert-tlsa-selector-data (data selector match) + "Convert certificate association DATA as required by SELECTOR and MATCH. + + If DATA is a hex string, we assume that it's already in the appropriate + form (but if MATCH specifies a hash then we check that it's the right + length). If DATA is a pathname, then it should name a PEM file: we + identify the kind of object stored in the file from the PEM header, and + convert as necessary. + + The output is an octet vector containing the raw certificate association + data to include in rrdata." + + (etypecase data + (string + (let ((bin (decode-hex data))) + (unless (tlsa-match-data-valid-p match bin) + (error "Invalid data for match type ~S" + (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)))))) + +(defzoneparse :tlsa (name data rec) + ":tlsa (((SERVICE|PORT &key :protocol)*) (USAGE SELECTOR MATCH DATA)*)" + + (destructuring-bind (services &rest certinfos) data + + ;; First pass: build the raw-format TLSA record data. + (let ((records nil)) + (dolist (certinfo certinfos) + (destructuring-bind (usage-tag selector-tag match-tag data) certinfo + (let* ((usage (lookup-enum 'tlsa-usage usage-tag :min 0 :max 255)) + (selector (lookup-enum 'tlsa-selector selector-tag + :min 0 :max 255)) + (match (lookup-enum 'tlsa-match match-tag :min 0 :max 255)) + (raw (convert-tlsa-selector-data data selector match))) + (push (list usage selector match raw) records)))) + (setf records (nreverse records)) + + ;; Second pass: attach records for the requested services. + (dolist (service (listify services)) + (destructuring-bind (svc &key (protocol :tcp)) (listify service) + (let* ((port (etypecase svc + (integer svc) + (keyword (let ((serv (serv-by-name svc protocol))) + (unless serv + (error "Unknown service `~A'" svc)) + (serv-port serv))))) + (prefixed (domain-name-concat + (make-domain-name + :labels (list (format nil "_~(~A~)" protocol) + (format nil "_~A" port))) + name))) + (dolist (record records) + (rec :name prefixed :data record)))))))) + +(defmethod zone-record-rrdata ((type (eql :tlsa)) zr) + (destructuring-bind (usage selector match data) (zr-data zr) + (rec-u8 usage) + (rec-u8 selector) + (rec-u8 match) + (rec-octet-vector data)) + 52) + (defzoneparse :mx (name data rec :zname zname) ":mx ((HOST :prio INT :ip IPADDR)*)" (dolist (mx (listify data)) @@ -1370,6 +1546,11 @@ $TTL ~2@*~D~2%" (defmethod zone-write-record ((format (eql :bind)) (type (eql :sshfp)) zr) (bind-format-record zr "~{~2D ~2D ~A~}~%" (zr-data zr))) +(defmethod zone-write-record ((format (eql :bind)) (type (eql :tlsa)) zr) + (destructuring-bind (usage selector match data) (zr-data zr) + (bind-format-record zr "~2D ~2D ~2D " usage selector match) + (bind-write-hex data 12))) + (defmethod zone-write-record ((format (eql :bind)) (type (eql :txt)) zr) (bind-format-record zr "~{~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]~}~%" (zr-data zr))) -- 2.11.0