zone.lisp: Don't try to take the `car' of something we know isn't a list.
[zone] / zone.lisp
index f3ea23c..6d6dce9 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
   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
       (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*)
     (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))
@@ -1583,6 +1616,11 @@ $TTL ~2@*~D~2%"
     (bind-format-record zr "~2D ~2D ~2D " usage selector match)
     (bind-write-hex data 12)))
 
+(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)))