From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 28 Apr 2014 09:04:33 +0000 (+0100)
Subject: zone.lisp: A bunch of functions for building raw DNS records.
X-Git-Url: https://git.distorted.org.uk/~mdw/zone/commitdiff_plain/28312118d89d5a9b98e289148a99800aad9563ad

zone.lisp: A bunch of functions for building raw DNS records.

Not used yet.  Soon...
---

diff --git a/zone.lisp b/zone.lisp
index 633e0d4..ea7a2f1 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -883,6 +883,73 @@
 		       :make-ptr-p (zr-make-ptr-p zr)))))))))))
 
 ;;;--------------------------------------------------------------------------
+;;; Building raw record vectors.
+
+(defvar *record-vector* nil
+  "The record vector under construction.")
+
+(defun rec-ensure (n)
+  "Ensure that at least N octets are spare in the current record."
+  (let ((want (+ n (fill-pointer *record-vector*)))
+	(have (array-dimension *record-vector* 0)))
+    (unless (<= want have)
+      (adjust-array *record-vector*
+		    (do ((new (* 2 have) (* 2 new)))
+			((<= want new) new))))))
+
+(defun rec-byte (octets value)
+  "Append an unsigned byte, OCTETS octets wide, with VALUE, to the record."
+  (rec-ensure octets)
+  (do ((i (1- octets) (1- i)))
+      ((minusp i))
+    (vector-push (ldb (byte 8 (* 8 i)) value) *record-vector*)))
+
+(defun rec-u8 (value)
+  "Append an 8-bit VALUE to the current record."
+  (rec-byte 1 value))
+(defun rec-u16 (value)
+  "Append a 16-bit VALUE to the current record."
+  (rec-byte 2 value))
+(defun rec-u32 (value)
+  "Append a 32-bit VALUE to the current record."
+  (rec-byte 4 value))
+
+(defun rec-raw-string (s &key (start 0) end)
+  "Append (a (substring of) a raw string S to the current record.
+
+   No arrangement is made for reporting the length of the string.  That must
+   be done by the caller, if necessary."
+  (setf-default end (length s))
+  (rec-ensure (- end start))
+  (do ((i start (1+ i)))
+      ((>= i end))
+    (vector-push (char-code (char s i)) *record-vector*)))
+
+(defun rec-name (s)
+  "Append a domain name S.
+
+   No attempt is made to perform compression of the name."
+  (let ((i 0) (n (length s)))
+    (loop (let* ((dot (position #\. s :start i))
+		 (lim (or dot n)))
+	    (rec-u8 (- lim i))
+	    (rec-raw-string s :start i :end lim)
+	    (if dot
+		(setf i (1+ dot))
+		(return))))
+    (when (< i n)
+      (rec-u8 0))))
+
+(defmacro build-record (&body body)
+  "Build a raw record, and return it as a vector of octets."
+  `(let ((*record-vector* (make-array 256
+				      :element-type '(unsigned-byte 8)
+				      :fill-pointer 0
+				      :adjustable t)))
+     ,@body
+     (copy-seq *record-vector*)))
+
+;;;--------------------------------------------------------------------------
 ;;; Zone file output.
 
 (export 'zone-write)