(let ((buf (make-dns-encode-state)))
(encode-dns-packet buf packet)
(slot-value buf 'packet-buf)))
+
+;;; DN format
+
+(defun parse-domain-name (name)
+ (declare (type string name))
+ (let ((l '())
+ (p 0))
+ (loop (let ((p2 (position #\. name :start p)))
+ (if p2
+ (if (= p2 (1- (length name)))
+ (return (values l t))
+ (setf l (append l (list (subseq name p p2)))
+ p (1+ p2)))
+ (return (values (append l (list (subseq name p))) nil)))))))
+
+(defun unparse-domain-name (name)
+ (declare (type list name))
+ (let ((buf nil))
+ (dolist (label name buf)
+ (setf buf (if buf
+ (concatenate 'string buf "." label)
+ label)))))
+
+;;; Basic communication
+
+(defun dns-do-request (server packet)
+ (declare (type address server)
+ (type dns-packet packet))
+ (with-connection (sk server)
+ (socket-send sk (dns-encode packet))
+ (loop
+ (let ((resp (dns-decode (socket-recv sk))))
+ (when (= (dns-packet-txid resp)
+ (dns-packet-txid packet))
+ (return resp))))))
+
+(defun dns-std-request (queries &key (txid (random 65536)) (recurse t))
+ (let ((qlist (map 'list #'(lambda (o)
+ (let ((name (first o))
+ (type (second o)))
+ (make-instance 'resource-query
+ :name (etypecase name
+ (string (parse-domain-name name))
+ (list name))
+ :type type)))
+ queries)))
+ (make-dns-packet :txid txid
+ :recurse recurse
+ :queries qlist)))
+
+;;; Misc.
+
+(defmethod print-object ((q resource-query) stream)
+ (with-slots (name type) q
+ (if *print-readably*
+ (format stream "~A: ~A" type (unparse-domain-name name))
+ (format stream "#<~S ~S ~S>" 'resource-query type (unparse-domain-name name)))))
+