From: Pixie <pix@kepibu.org>
Date: Sat, 25 Aug 2012 03:47:53 +0000 (-0500)
Subject: Add SRV record support
X-Git-Tag: v0.8.0~40
X-Git-Url: https://repo.or.cz/w/iolib.git/commitdiff_plain/b3358f46976ed067e01431733e75a43c4d167548

Add SRV record support
---

diff --git a/src/sockets/dns/common.lisp b/src/sockets/dns/common.lisp
index cfca85c..298f9fb 100644
--- a/src/sockets/dns/common.lisp
+++ b/src/sockets/dns/common.lisp
@@ -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+)))
diff --git a/src/sockets/dns/message.lisp b/src/sockets/dns/message.lisp
index 4ef1dd9..7f5dc9f 100644
--- a/src/sockets/dns/message.lisp
+++ b/src/sockets/dns/message.lisp
@@ -379,6 +379,15 @@
         (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))
diff --git a/src/sockets/dns/query.lisp b/src/sockets/dns/query.lisp
index 962b396..fb9f19b 100644
--- a/src/sockets/dns/query.lisp
+++ b/src/sockets/dns/query.lisp
@@ -106,6 +106,15 @@
           (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)))
 
@@ -186,6 +195,12 @@
   (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)))