- (dolist (net (listify nets))
- (dolist (ipn (net-parse-to-ipnets net family))
- (let* ((addr (ipnet-net ipn))
- (width (ipaddr-width addr))
- (comp-width (reverse-domain-component-width addr))
- (end (round-up (or end
- (ipnet-changeable-bits width
- (ipnet-mask ipn)))
- comp-width))
- (start (round-down (or start (- end comp-width))
- comp-width))
- (map (ipnet-host-map ipn)))
- (multiple-value-bind (host-step host-limit)
- (ipnet-index-bounds map start end)
- (do ((index 0 (+ index host-step)))
- ((> index host-limit))
- (let* ((addr (ipnet-index-host map index))
- (frag (reverse-domain-fragment addr start end))
- (target (concatenate 'string
- (zone-make-name
- (if (not suffix) frag
- (concatenate 'string
- frag "." suffix))
- zname)
- ".")))
- (dolist (zr (zone-parse-records (zone-make-name frag zname)
- ttl
- (subst target '*
- (cdr data))))
- (rec :name (zr-name zr)
- :type (zr-type zr)
- :data (zr-data zr)
- :ttl (zr-ttl zr)
- :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*)))
+ (let ((suffix (if (not raw-suffix)
+ (make-domain-name :labels nil :absolutep nil)
+ (zone-parse-host raw-suffix))))
+ (dolist (net (listify nets))
+ (dolist (ipn (net-parse-to-ipnets net family))
+ (let* ((addr (ipnet-net ipn))
+ (width (ipaddr-width addr))
+ (comp-width (reverse-domain-component-width addr))
+ (end (round-up (or end
+ (ipnet-changeable-bits width
+ (ipnet-mask ipn)))
+ comp-width))
+ (start (round-down (or start (- end comp-width))
+ comp-width))
+ (map (ipnet-host-map ipn)))
+ (multiple-value-bind (host-step host-limit)
+ (ipnet-index-bounds map start end)
+ (do ((index 0 (+ index host-step)))
+ ((> index host-limit))
+ (let* ((addr (ipnet-index-host map index))
+ (frag (reverse-domain-fragment addr start end))
+ (target (reduce #'domain-name-concat
+ (list frag suffix zname)
+ :from-end t
+ :initial-value root-domain)))
+ (dolist (zr (zone-parse-records (domain-name-concat frag
+ zname)
+ ttl
+ (subst target '*
+ (cdr data))))
+ (rec :name (zr-name zr)
+ :type (zr-type zr)
+ :data (zr-data zr)
+ :ttl (zr-ttl zr)
+ :make-ptr-p (zr-make-ptr-p zr))))))))))))