refactor(lisp/dns): Introduce structured QNAME representation

Adds a struct that represents QNAMEs, tracks the stream offset at
which the QNAME parsing began and makes it possible to resolve
pointers inside of the QNAME.

Note that resolving pointers needs to happen *after* the call to
lisp-binary currently. It might be possible to implement this inside
of lisp-binary in the future by switching on the top two bits of the
qname field, but since this is happening *inside* of a reader function
I'm not currently sure how to implement it.
This commit is contained in:
Vincent Ambo 2020-01-26 01:36:40 +00:00
parent 7ef14db936
commit cefb60f20c

View file

@ -706,6 +706,24 @@
;; resource records in the additional records section. ;; resource records in the additional records section.
(arcount 0 :type 16)) (arcount 0 :type 16))
;; Representation of DNS QNAMEs.
;;
;; A QNAME can be either made up entirely of labels, which is
;; basically a list of strings, or be terminated with a pointer to an
;; offset within the original message.
(deftype qname-field ()
'(or
;; pointer
(unsigned-byte 14)
;; label
string))
(defstruct qname
(start-at 0 :type (unsigned-byte 14))
(names #() :type (vector qname-field)))
;; Domain names in questions and resource records are represented as a ;; Domain names in questions and resource records are represented as a
;; sequence of labels, where each label consists of a length octet ;; sequence of labels, where each label consists of a length octet
;; followed by that number of octets. ;; followed by that number of octets.
@ -713,10 +731,10 @@
;; The domain name terminates with the zero length octet for the null ;; The domain name terminates with the zero length octet for the null
;; label of the root. Note that this field may be an odd number of ;; label of the root. Note that this field may be an odd number of
;; octets; no padding is used. ;; octets; no padding is used.
(declaim (ftype (function (stream) (values (vector string) integer)) read-qname)) (declaim (ftype (function (stream) (values qname integer)) read-qname))
(defun read-qname (stream) (defun read-qname (stream)
"Reads a DNS QNAME from STREAM." "Reads a DNS QNAME from STREAM."
(format t "reading qname at ~A" (file-position stream)) (let ((start-at (+ 1 (file-position stream))))
(iter (for byte in-stream stream using #'read-byte) (iter (for byte in-stream stream using #'read-byte)
;; Total size is needed, count for each iteration byte, plus its ;; Total size is needed, count for each iteration byte, plus its
;; own value. ;; own value.
@ -740,15 +758,17 @@
into fragments result-type vector)) into fragments result-type vector))
(vector-push (read-byte stream) fragment)) (vector-push (read-byte stream) fragment))
(finally (return (values fragments size))))) (finally (return (values (make-qname :start-at start-at
:names fragments)
size))))))
(declaim (ftype (function (stream (vector string))) write-qname)) (declaim (ftype (function (stream qname)) write-qname))
(defun write-qname (stream qname) (defun write-qname (stream qname)
"Write a DNS qname to STREAM." "Write a DNS qname to STREAM."
;; Write each fragment starting with its (byte-) length, followed by ;; Write each fragment starting with its (byte-) length, followed by
;; the bytes. ;; the bytes.
(iter (for fragment in-vector qname) (iter (for fragment in-vector (qname-names qname))
(for bytes = (babel:string-to-octets fragment)) (for bytes = (babel:string-to-octets fragment))
(write-byte (length bytes) stream) (write-byte (length bytes) stream)
(iter (for byte in-vector bytes) (iter (for byte in-vector bytes)
@ -760,7 +780,7 @@
;; 4.1.2. Question section format ;; 4.1.2. Question section format
(defbinary dns-question (:byte-order :big-endian) (defbinary dns-question (:byte-order :big-endian)
;; a domain name represented ;; a domain name represented
(qname "" :type (custom :lisp-type (vector string) (qname "" :type (custom :lisp-type qname
:reader #'read-qname :reader #'read-qname
:writer #'write-qname)) :writer #'write-qname))
@ -785,7 +805,7 @@
(magic 3 :type (magic :value 3 :actual-type (unsigned-byte 2))) (magic 3 :type (magic :value 3 :actual-type (unsigned-byte 2)))
;; a domain name to which this resource record pertains. ;; a domain name to which this resource record pertains.
(name nil :type (pointer :data-type (custom :lisp-type (vector string) (name nil :type (pointer :data-type (custom :lisp-type qname
:reader #'read-qname :reader #'read-qname
:writer #'write-qname) :writer #'write-qname)
:pointer-type (unsigned-byte 14))) :pointer-type (unsigned-byte 14)))