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:
parent
7ef14db936
commit
cefb60f20c
1 changed files with 46 additions and 26 deletions
|
@ -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)))
|
||||||
|
|
Loading…
Reference in a new issue