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.

1 files changed, 51 insertions, 31 deletions

diff --git a/lisp/dns/message.lisp b/lisp/dns/message.lisp
index 9e283ea5cc71..079e971c7e43 100644
--- a/lisp/dns/message.lisp
+++ b/lisp/dns/message.lisp
@@ -706,6 +706,24 @@
            ;; resource records in the additional records section.
            (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
 ;; sequence of labels, where each label consists of a length octet
 ;; followed by that number of octets.
@@ -713,42 +731,44 @@
 ;; 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
 ;; 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)
   "Reads a DNS QNAME from STREAM."
-  (format t "reading qname at ~A" (file-position stream))
-  (iter (for byte in-stream stream using #'read-byte)
-    ;; Total size is needed, count for each iteration byte, plus its
-    ;; own value.
-    (sum (+ 1 byte) into size)
-
-    (until (equal byte 0))
-
-    ;; Each fragment is collected into this byte vector pre-allocated
-    ;; with the correct size.
-    (for fragment = (make-array byte :element-type '(unsigned-byte 8)
-                                     :fill-pointer 0))
-
-    ;; On each iteration, this will interpret the current byte as an
-    ;; unsigned integer and read from STREAM an equivalent amount of
-    ;; times to assemble the current fragment.
-    ;;
-    ;; Advancing the stream like this also ensures that the next
-    ;; iteration occurs on either a length-byte or the final
-    ;; terminating byte.
-    (dotimes (_ byte (collect (babel:octets-to-string fragment)
-                       into fragments result-type vector))
-      (vector-push (read-byte stream) fragment))
-
-    (finally (return (values fragments size)))))
-
-(declaim (ftype (function (stream (vector string))) write-qname))
+  (let ((start-at (+ 1 (file-position stream))))
+    (iter (for byte in-stream stream using #'read-byte)
+      ;; Total size is needed, count for each iteration byte, plus its
+      ;; own value.
+      (sum (+ 1 byte) into size)
+
+      (until (equal byte 0))
+
+      ;; Each fragment is collected into this byte vector pre-allocated
+      ;; with the correct size.
+      (for fragment = (make-array byte :element-type '(unsigned-byte 8)
+                                       :fill-pointer 0))
+
+      ;; On each iteration, this will interpret the current byte as an
+      ;; unsigned integer and read from STREAM an equivalent amount of
+      ;; times to assemble the current fragment.
+      ;;
+      ;; Advancing the stream like this also ensures that the next
+      ;; iteration occurs on either a length-byte or the final
+      ;; terminating byte.
+      (dotimes (_ byte (collect (babel:octets-to-string fragment)
+                         into fragments result-type vector))
+        (vector-push (read-byte stream) fragment))
+
+      (finally (return (values (make-qname :start-at start-at
+                                           :names fragments)
+                               size))))))
+
+(declaim (ftype (function (stream qname)) write-qname))
 (defun write-qname (stream qname)
   "Write a DNS qname to STREAM."
 
   ;; Write each fragment starting with its (byte-) length, followed by
   ;; the bytes.
-  (iter (for fragment in-vector qname)
+  (iter (for fragment in-vector (qname-names qname))
     (for bytes = (babel:string-to-octets fragment))
     (write-byte (length bytes) stream)
     (iter (for byte in-vector bytes)
@@ -760,7 +780,7 @@
 ;; 4.1.2. Question section format
 (defbinary dns-question (:byte-order :big-endian)
            ;; a domain name represented
-           (qname "" :type (custom :lisp-type (vector string)
+           (qname "" :type (custom :lisp-type qname
                                    :reader #'read-qname
                                    :writer #'write-qname))
 
@@ -785,7 +805,7 @@
            (magic 3 :type (magic :value 3 :actual-type (unsigned-byte 2)))
 
            ;; 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
                                                        :writer #'write-qname)
                                     :pointer-type (unsigned-byte 14)))