Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add SRV record support

  • Loading branch information...
commit b3358f46976ed067e01431733e75a43c4d167548 1 parent 4d1c573
authored August 24, 2012 sionescu committed August 25, 2012
2  src/sockets/dns/common.lisp
@@ -14,7 +14,7 @@
14 14
 (defconstant (+query-type-map+ :test 'equal)
15 15
   '((:a . 1) (:ns . 2) (:cname . 5) (:soa . 6)
16 16
     (:wks . 11) (:ptr . 12) (:hinfo . 13) (:mx . 15)
17  
-    (:txt . 16) (:aaaa . 28) (:any . 255)))
  17
+    (:txt . 16) (:aaaa . 28) (:srv . 33) (:any . 255)))
18 18
 
19 19
 (defun query-type-number (id)
20 20
   (cdr (assoc id +query-type-map+)))
9  src/sockets/dns/message.lisp
@@ -379,6 +379,15 @@
379 379
         (read-ub32 buffer)))            ; MINIMUM
380 380
 
381 381
 (defmethod read-rr-data ((buffer dynamic-buffer)
  382
+                         (type (eql :srv)) (class (eql :in))
  383
+                         resource-length)
  384
+  (declare (ignore resource-length))
  385
+  (list (read-ub16 buffer)              ; PRIORITY
  386
+        (read-ub16 buffer)              ; WEIGHT
  387
+        (read-ub16 buffer)              ; PORT
  388
+        (read-domain-name buffer)))     ; TARGET
  389
+
  390
+(defmethod read-rr-data ((buffer dynamic-buffer)
382 391
                          (type (eql :txt)) (class (eql :in))
383 392
                          resource-length)
384 393
   (declare (ignore type class))
15  src/sockets/dns/query.lisp
@@ -106,6 +106,15 @@
106 106
           (cons preference
107 107
                 (subseq name 0 (1- (length name)))))))
108 108
 
  109
+(defmethod %decode-rr ((rr dns-rr) (type (eql :srv)) class)
  110
+  (declare (ignore class))
  111
+  (destructuring-bind (priority weight port target) (dns-rr-data rr)
  112
+    (list* (dns-rr-ttl rr)
  113
+           priority
  114
+           weight
  115
+           port
  116
+           (subseq target 0 (1- (length target))))))
  117
+
109 118
 (defun decode-rr (rr)
110 119
   (%decode-rr rr (dns-record-type rr) (dns-record-class rr)))
111 120
 
@@ -186,6 +195,12 @@
186 195
   (let ((rr (aref (dns-message-answer msg) 0)))
187 196
     (decode-rr rr)))
188 197
 
  198
+;; TODO: randomly choose between same priority by weight
  199
+(defmethod %decode-response ((msg dns-message) (question-type (eql :srv)))
  200
+  (declare (ignore question-type))
  201
+  (let* ((decoded-rrs (map 'vector #'decode-rr (dns-message-answer msg))))
  202
+    (aref (sort decoded-rrs #'< :key #'second) 0)))
  203
+
189 204
 (defmethod %decode-response ((msg dns-message) (question-type (eql :txt)))
190 205
   (declare (ignore question-type))
191 206
   (decode-rr (aref (dns-message-answer msg) 0)))

0 notes on commit b3358f4

Please sign in to comment.
Something went wrong with that request. Please try again.