min-ttl
serial)
-(export 'zone-text-name)
-(defun zone-text-name (zone)
- (princ-to-string (zone-name zone)))
-
(export 'mx)
(defstruct (mx (:predicate mxp))
"Mail-exchange record information."
name
records)
+(export 'zone-text-name)
+(defun zone-text-name (zone)
+ (princ-to-string (zone-name zone)))
+
;;;--------------------------------------------------------------------------
;;; Zone defaults. It is intended that scripts override these.
:ttl ttl :records (cdr r))
sub)))
(t
- (error "Unexpected record form ~A" (car r))))))))
+ (error "Unexpected record form ~A" r)))))))
(process (rec dom ttl)
;; Recursirvely process the record list REC, with a list DOM of
(defmacro defrevzone (head &body zf)
"Define a reverse zone, with the correct name."
(destructuring-bind (nets &rest args
- &key &allow-other-keys
- (family '*address-family*)
- prefix-bits)
+ &key (family '*address-family*)
+ prefix-bits
+ &allow-other-keys)
(listify head)
(with-gensyms (ipn)
`(dolist (,ipn (net-parse-to-ipnets ',nets ,family))
(let ((*address-family* (ipnet-family ,ipn)))
- (zone-create `((,(format nil "~A." (reverse-domain ,ipn
- ,prefix-bits))
+ (zone-create `((,(format nil "~A" (reverse-domain ,ipn
+ ,prefix-bits))
,@',(loop for (k v) on args by #'cddr
unless (member k
'(:family :prefix-bits))
(rec :type :txt
:data (nreverse things)))))
-(defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3))
+(defenum sshfp-algorithm () (:rsa 1) (:dsa 2) (:ecdsa 3) (:ed25519 4))
(defenum sshfp-type () (:sha-1 1) (:sha-256 2))
(export '*sshfp-pathname-defaults*)
"Default pathname components for TLSA records.")
(pushnew '*tlsa-pathname-defaults* *zone-config*)
+(defparameter *tlsa-data-cache* (make-hash-table :test #'equal)
+ "Cache for TLSA association data; keys are (DATA SELECTOR MATCH).")
+
(defun convert-tlsa-selector-data (data selector match)
"Convert certificate association DATA as required by SELECTOR and MATCH.
(reverse-enum 'tlsa-match match)))
bin))
(pathname
- (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))))))
+ (let ((key (list data selector match)))
+ (or (gethash key *tlsa-data-cache*)
+ (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))
+ (binary (read-tlsa-match-data match raw context)))
+ (setf (gethash key *tlsa-data-cache*) binary))))))))
(defzoneparse :tlsa (name data rec)
":tlsa (((SERVICE|PORT &key :protocol)*) (USAGE SELECTOR MATCH DATA)*)"
(rec-octet-vector data))
52)
+(defenum dnssec-algorithm ()
+ (:rsamd5 1)
+ (:dh 2)
+ (:dsa 3)
+ (:rsasha1 5)
+ (:dsa-nsec3-sha1 6)
+ (:rsasha1-nsec3-sha1 7)
+ (:rsasha256 8)
+ (:rsasha512 10)
+ (:ecc-gost 12)
+ (:ecdsap256sha256 13)
+ (:ecdsap384sha384 14))
+
+(defenum dnssec-digest ()
+ (:sha1 1)
+ (:sha256 2))
+
+(defzoneparse :ds (name data rec)
+ ":ds ((TAG ALGORITHM DIGEST-TYPE DIGEST)*)"
+ (dolist (ds data)
+ (destructuring-bind (tag alg hashtype hash) ds
+ (rec :data (list tag
+ (lookup-enum 'dnssec-algorithm alg :min 0 :max 255)
+ (lookup-enum 'dnssec-digest hashtype :min 0 :max 255)
+ (decode-hex hash))))))
+
+(defmethod zone-record-rrdata ((type (eql :ds)) zr)
+ (destructuring-bind (tag alg hashtype hash) zr
+ (rec-u16 tag)
+ (rec-u8 alg)
+ (rec-u8 hashtype)
+ (rec-octet-vector hash)))
+
(defzoneparse :mx (name data rec :zname zname)
":mx ((HOST :prio INT :ip IPADDR)*)"
(dolist (mx (listify data))
(rec-name host))
33)
+(defenum caa-flag () (:critical 128))
+
+(defzoneparse :caa (name data rec)
+ ":caa ((TAG VALUE FLAG*)*)"
+ (dolist (prop data)
+ (destructuring-bind (tag value &rest flags) prop
+ (setf flags (reduce #'logior
+ (mapcar (lambda (item)
+ (lookup-enum 'caa-flag item
+ :min 0 :max 255))
+ flags)))
+ (ecase tag
+ ((:issue :issuewild :iodef)
+ (rec :name name
+ :data (list flags tag value)))))))
+
+(defmethod zone-record-rrdata ((type (eql :caa)) zr)
+ (destructuring-bind (flags tag value) (zr-data zr)
+ (rec-u8 flags)
+ (rec-string (string-downcase tag))
+ (rec-raw-string value))
+ 257)
+
(defzoneparse :net (name data rec)
":net (NETWORK*)"
(dolist (net (listify data))
(bind-format-record zr "~2D ~2D ~2D " usage selector match)
(bind-write-hex data 12)))
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :caa)) zr)
+ (destructuring-bind (flags tag value) (zr-data zr)
+ (bind-format-record zr "~3D ~(~A~) ~S~%" flags tag value)))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :ds)) zr)
+ (destructuring-bind (tag alg hashtype hash) (zr-data zr)
+ (bind-format-record zr "~5D ~2D ~2D " tag alg hashtype)
+ (bind-write-hex hash 12)))
+
(defmethod zone-write-record ((format (eql :bind)) (type (eql :txt)) zr)
(bind-format-record zr "~{~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]~}~%"
(zr-data zr)))