Add SRV record support
authorPixie <pix@kepibu.org>
Sat, 25 Aug 2012 03:47:53 +0000 (24 22:47 -0500)
committerStelian Ionescu <sionescu@cddr.org>
Sat, 25 Aug 2012 15:21:24 +0000 (25 17:21 +0200)
src/sockets/dns/common.lisp
src/sockets/dns/message.lisp
src/sockets/dns/query.lisp

index cfca85c..298f9fb 100644 (file)
@@ -14,7 +14,7 @@
 (defconstant (+query-type-map+ :test 'equal)
   '((:a . 1) (:ns . 2) (:cname . 5) (:soa . 6)
     (:wks . 11) (:ptr . 12) (:hinfo . 13) (:mx . 15)
-    (:txt . 16) (:aaaa . 28) (:any . 255)))
+    (:txt . 16) (:aaaa . 28) (:srv . 33) (:any . 255)))
 
 (defun query-type-number (id)
   (cdr (assoc id +query-type-map+)))
index 4ef1dd9..7f5dc9f 100644 (file)
         (read-ub32 buffer)))            ; MINIMUM
 
 (defmethod read-rr-data ((buffer dynamic-buffer)
+                         (type (eql :srv)) (class (eql :in))
+                         resource-length)
+  (declare (ignore resource-length))
+  (list (read-ub16 buffer)              ; PRIORITY
+        (read-ub16 buffer)              ; WEIGHT
+        (read-ub16 buffer)              ; PORT
+        (read-domain-name buffer)))     ; TARGET
+
+(defmethod read-rr-data ((buffer dynamic-buffer)
                          (type (eql :txt)) (class (eql :in))
                          resource-length)
   (declare (ignore type class))
index 962b396..fb9f19b 100644 (file)
           (cons preference
                 (subseq name 0 (1- (length name)))))))
 
+(defmethod %decode-rr ((rr dns-rr) (type (eql :srv)) class)
+  (declare (ignore class))
+  (destructuring-bind (priority weight port target) (dns-rr-data rr)
+    (list* (dns-rr-ttl rr)
+           priority
+           weight
+           port
+           (subseq target 0 (1- (length target))))))
+
 (defun decode-rr (rr)
   (%decode-rr rr (dns-record-type rr) (dns-record-class rr)))
 
   (let ((rr (aref (dns-message-answer msg) 0)))
     (decode-rr rr)))
 
+;; TODO: randomly choose between same priority by weight
+(defmethod %decode-response ((msg dns-message) (question-type (eql :srv)))
+  (declare (ignore question-type))
+  (let* ((decoded-rrs (map 'vector #'decode-rr (dns-message-answer msg))))
+    (aref (sort decoded-rrs #'< :key #'second) 0)))
+
 (defmethod %decode-response ((msg dns-message) (question-type (eql :txt)))
   (declare (ignore question-type))
   (decode-rr (aref (dns-message-answer msg) 0)))