diff --git a/net-doc/net/scribblings/dns.scrbl b/net-doc/net/scribblings/dns.scrbl
index bdc5a72f94..d83b495c31 100644
--- a/net-doc/net/scribblings/dns.scrbl
+++ b/net-doc/net/scribblings/dns.scrbl
@@ -1,5 +1,8 @@
 #lang scribble/doc
-@(require "common.rkt" (for-label net/dns net/dns-unit net/dns-sig))
+@(require "common.rkt" scribble/eval (for-label net/dns net/dns-unit net/dns-sig))
+
+@(define dns-evaluator (make-base-eval))
+@(dns-evaluator '(require net/dns))
 
 @title[#:tag "dns"]{DNS: Domain Name Service Queries}
 
@@ -32,6 +35,51 @@ an error will be raised.
 }
 
 
+@deftogether[(
+@defproc[(dns-get-srv [nameserver string?]
+		      [name string?]
+		      [service string?]
+		      [proto string? "tcp"])
+         (listof srv-rr?)]
+@defstruct*[srv-rr ([priority (integer-in 0 65535)]
+		    [weight (integer-in 0 65535)]
+		    [port (integer-in 0 65535)]
+		    [target string?]) #:prefab]
+)]{
+
+@margin-note{An SRV record is a particular kind of DNS resource record
+that maps an abstract service name onto a hostname and port
+combination. For more information, see
+@hyperlink["https://en.wikipedia.org/wiki/SRV_record"]{the Wikipedia
+page on SRV records}.}
+
+Consults the specified nameserver (normally a numerical address like
+@racket["128.42.1.30"]) to retrieve the SRV records corresponding to
+the given name, service, and protocol. Returns a list of
+@racket[srv-rr] structs if any corresponding SRV records are found;
+otherwise, returns @racket['()].
+
+If @racket[service] is @racket["X"], @racket[proto] is @racket["Y"],
+and @racket[name] is @racket["example.com"], then this will retrieve
+any SRV records at the domain name @tt{_X._Y.example.com}.
+
+The query record sent to the DNS server includes the "recursive" bit,
+but @racket[dns-get-srv] also implements a recursive search itself
+in case the server does not provide this optional feature.
+
+@examples[#:eval dns-evaluator
+	  (eval:alts (dns-get-srv (dns-find-nameserver) "racket-lang.org" "xmpp-client")
+		     (list (srv-rr 0 0 5222 "xmpp.racket-lang.org")))
+	  (eval:alts (dns-get-srv (dns-find-nameserver) "racket-lang.org" "nonexistent-protocol")
+		     (list))
+	  (eval:alts (dns-get-srv (dns-find-nameserver) "racket-lang.org" "xmpp-client" "tcp")
+		     (list (srv-rr 0 0 5222 "xmpp.racket-lang.org")))
+	  (eval:alts (dns-get-srv (dns-find-nameserver) "racket-lang.org" "xmpp-client" "udp")
+		     (list))
+	  ]
+}
+
+
 @defproc[(dns-get-name [nameserver string?]
                        [address string?])
          string?]{
@@ -80,4 +128,5 @@ Imports nothing, exports @racket[dns^].}
 
 @defsignature[dns^ ()]{}
 
-Includes everything exported by the @racketmodname[net/dns] module.
+Includes @racket[dns-get-address], @racket[dns-get-name],
+@racket[dns-get-mail-exchanger] and @racket[dns-find-nameserver].
diff --git a/net-lib/net/dns.rkt b/net-lib/net/dns.rkt
index 729a1d0623..96036beada 100644
--- a/net-lib/net/dns.rkt
+++ b/net-lib/net/dns.rkt
@@ -3,17 +3,57 @@
 ;; DNS query library for Racket
 
 (require "private/ip.rkt"
+         "private/rr-generic.rkt"
+         "private/rr-srv.rkt"
          racket/contract
          racket/format
          racket/string
          racket/system
          racket/udp)
 
-(provide (contract-out
+(provide (struct-out srv-rr)
+         (contract-out
           [dns-get-address
            (->* ((or/c ip-address? ip-address-string?) string?)
                 (#:ipv6? any/c)
                 ip-address-string?)]
+          [dns-get-srv
+           (->* ((or/c ip-address? ip-address-string?)
+                 string?
+                 string?)
+                (string?)
+                (listof (struct/c srv-rr
+                                  (integer-in 0 65535)
+                                  (integer-in 0 65535)
+                                  (integer-in 0 65535)
+                                  string?)))]
+          ;; N.B. We should eventually expose this *kind* of
+          ;; functionality, but this interface is very unfriendly. We
+          ;; should make the interface less unfriendly before we
+          ;; expose this function. It should also be documented when
+          ;; it is exposed.
+          ;;
+          ;; A second option, suitable for use in the interim, would
+          ;; be to move dns-lookup to be a provided identifier (with
+          ;; this contract) from some module in `private/`, but this
+          ;; would involve moving most of the code in this file into
+          ;; `private/`, which... ehhh. Could do I suppose. At least
+          ;; that way people would be able to use dns-lookup in
+          ;; extremis, even though it has an ugly API and no
+          ;; documentation.
+          ;;
+          ;; [dns-lookup
+          ;;  (-> (or/c ip-address? ip-address-string?)
+          ;;      string?
+          ;;      #:rr-type symbol?
+          ;;      #:rr-parser (-> (listof (list/c bytes? ;; name
+          ;;                                      symbol? ;; type
+          ;;                                      symbol? ;; class
+          ;;                                      integer? ;; ttl
+          ;;                                      (listof byte?))) ;; rdata
+          ;;                      (listof byte?) ;; the whole packet
+          ;;                      any/c)
+          ;;      any/c)]
           [dns-get-name
            (-> (or/c ip-address? ip-address-string?)
                (or/c ip-address? ip-address-string?)
@@ -49,7 +89,8 @@
     (minfo 14)
     (mx    15)
     (txt   16)
-    (aaaa  28)))
+    (aaaa  28)
+    (srv   33)))
 
 ;; A Class is one of the following
 (define classes
@@ -65,31 +106,6 @@
         [(equal? (cadar l) i) (car l)]
         [else                 (cossa i (cdr l))]))
 
-(define (number->octet-pair n)
-  (list (arithmetic-shift n -8)
-        (modulo n 256)))
-
-(define (octet-pair->number a b)
-  (+ (arithmetic-shift a 8) b))
-
-(define (octet-quad->number a b c d)
-  (+ (arithmetic-shift a 24)
-     (arithmetic-shift b 16)
-     (arithmetic-shift c 8)
-     d))
-
-;; Bytes -> LB
-;; Convert the domain name into a sequence of labels, where each
-;; label is a length octet and then that many octets
-(define (name->octets s)
-  (define (do-one s) (cons (bytes-length s) (bytes->list s)))
-  (let loop ([s s])
-    (define m (regexp-match #rx#"^([^.]*)[.](.*)" s))
-    (if m
-        (append (do-one (cadr m)) (loop (caddr m)))
-        ;; terminate with zero length octet
-        (append (do-one s) (list 0)))))
-
 ;; The query header. See RFC1035 4.1.1 for details
 ;;
 ;; The opcode & flags are set as:
@@ -118,37 +134,6 @@
 (define (add-size-tag m)
   (append (number->octet-pair (length m)) m))
 
-(define (rr-data rr)
-  (cadddr (cdr rr)))
-
-(define (rr-type rr)
-  (cadr rr))
-
-(define (rr-name rr)
-  (car rr))
-
-(define (parse-name start reply)
-  (define v (car start))
-  (cond
-    [(zero? v)
-     ;; End of name
-     (values #f (cdr start))]
-    [(zero? (bitwise-and #xc0 v))
-     ;; Normal label
-     (let loop ([len v] [start (cdr start)] [accum null])
-       (if (zero? len)
-         (let-values ([(s start) (parse-name start reply)])
-           (define s0 (list->bytes (reverse accum)))
-           (values (if s (bytes-append s0 #"." s) s0)
-                   start))
-         (loop (sub1 len) (cdr start) (cons (car start) accum))))]
-    [else
-     ;; Compression offset
-     (define offset (+ (arithmetic-shift (bitwise-and #x3f v) 8)
-                       (cadr start)))
-     (define-values [s ignore-start] (parse-name (list-tail reply offset) reply))
-     (values s (cddr start))]))
-
 (define (parse-rr start reply)
   (let-values ([(name start) (parse-name start reply)])
     (let* ([type (car (cossa (octet-pair->number (car start) (cadr start))
@@ -341,23 +326,33 @@
     ans-entry))
 
 (define (dns-get-address nameserver-ip-or-string addr #:ipv6? [ipv6? #f])
+  (or (dns-lookup nameserver-ip-or-string addr
+                  #:rr-type (if ipv6? 'aaaa 'a)
+                  #:rr-parser (lambda (answer-records reply)
+                                (and (positive? (length answer-records))
+                                     ((if ipv6? ipv6->string ip->string)
+                                      (rr-data (car answer-records))))))
+      (error 'dns-lookup "bad address")))
+
+(define (dns-get-srv nameserver-ip-or-string name service [proto "tcp"])
+  (dns-lookup nameserver-ip-or-string
+              (format "_~a._~a.~a" service proto name)
+              #:rr-type 'srv
+              #:rr-parser parse-srv-rr))
+
+(define (dns-lookup nameserver-ip-or-string addr
+                    #:rr-type type
+                    #:rr-parser rr-parser)
   (define nameserver (if (ip-address? nameserver-ip-or-string)
                          nameserver-ip-or-string
                          (make-ip-address nameserver-ip-or-string)))
-  (define type (if ipv6? 'aaaa 'a))
   (define (get-address nameserver)
     (define-values (auth? qds ans nss ars reply)
       (dns-query/cache nameserver addr type 'in))
     (define answer-records (get-records-from-ans ans type))
-    (define address
-      (and (positive? (length answer-records))
-           (let ([data (rr-data (car answer-records))])
-             (if ipv6?
-                 (ipv6->string data)
-                 (ip->string data)))))
-    (values address ars auth?))
-  (or (try-forwarding get-address nameserver)
-      (error 'dns-get-address "bad address")))
+    (define result (rr-parser answer-records reply))
+    (values result ars auth?))
+  (try-forwarding get-address nameserver))
 
 (define (dns-get-mail-exchanger nameserver-ip-or-string addr)
   (define nameserver (if (ip-address? nameserver-ip-or-string)
diff --git a/net-lib/net/private/rr-generic.rkt b/net-lib/net/private/rr-generic.rkt
new file mode 100644
index 0000000000..1a7b42a0de
--- /dev/null
+++ b/net-lib/net/private/rr-generic.rkt
@@ -0,0 +1,67 @@
+#lang racket/base
+;; Utilities for parsing and unparsing various pieces of DNS wire formats.
+
+(provide number->octet-pair
+         octet-pair->number
+         octet-quad->number
+         parse-name
+         name->octets
+         rr-data
+         rr-type
+         rr-name)
+
+(define (number->octet-pair n)
+  (list (arithmetic-shift n -8)
+        (modulo n 256)))
+
+(define (octet-pair->number a b)
+  (+ (arithmetic-shift a 8) b))
+
+(define (octet-quad->number a b c d)
+  (+ (arithmetic-shift a 24)
+     (arithmetic-shift b 16)
+     (arithmetic-shift c 8)
+     d))
+
+(define (parse-name start reply)
+  (define v (car start))
+  (cond
+    [(zero? v)
+     ;; End of name
+     (values #f (cdr start))]
+    [(zero? (bitwise-and #xc0 v))
+     ;; Normal label
+     (let loop ([len v] [start (cdr start)] [accum null])
+       (if (zero? len)
+         (let-values ([(s start) (parse-name start reply)])
+           (define s0 (list->bytes (reverse accum)))
+           (values (if s (bytes-append s0 #"." s) s0)
+                   start))
+         (loop (sub1 len) (cdr start) (cons (car start) accum))))]
+    [else
+     ;; Compression offset
+     (define offset (+ (arithmetic-shift (bitwise-and #x3f v) 8)
+                       (cadr start)))
+     (define-values [s ignore-start] (parse-name (list-tail reply offset) reply))
+     (values s (cddr start))]))
+
+;; Bytes -> LB
+;; Convert the domain name into a sequence of labels, where each
+;; label is a length octet and then that many octets
+(define (name->octets s)
+  (define (do-one s) (cons (bytes-length s) (bytes->list s)))
+  (let loop ([s s])
+    (define m (regexp-match #rx#"^([^.]*)[.](.*)" s))
+    (if m
+        (append (do-one (cadr m)) (loop (caddr m)))
+        ;; terminate with zero length octet
+        (append (do-one s) (list 0)))))
+
+(define (rr-data rr)
+  (cadddr (cdr rr)))
+
+(define (rr-type rr)
+  (cadr rr))
+
+(define (rr-name rr)
+  (car rr))
diff --git a/net-lib/net/private/rr-srv.rkt b/net-lib/net/private/rr-srv.rkt
new file mode 100644
index 0000000000..4d99a3b04e
--- /dev/null
+++ b/net-lib/net/private/rr-srv.rkt
@@ -0,0 +1,35 @@
+#lang racket/base
+;; Parser and representation for SRV RRs.
+
+(require racket/contract)
+
+(provide parse-srv-rr
+         (contract-out
+          (struct srv-rr ((priority (integer-in 0 65535))
+                          (weight (integer-in 0 65535))
+                          (port (integer-in 0 65535))
+                          (target string?)))))
+
+(require racket/match)
+(require "rr-generic.rkt")
+
+(struct srv-rr (priority
+                weight
+                port
+                target)
+  #:prefab)
+
+(define (parse-srv-rr answer-records reply)
+  (let loop ((rrs answer-records))
+    (match rrs
+      ['() '()]
+      [(cons rr rest)
+       (match (rr-data rr)
+         [(list* prio1 prio2 weight1 weight2 port1 port2 target-bytes)
+          (define-values (target-name _rest) (parse-name target-bytes reply))
+          (cons (srv-rr (octet-pair->number prio1 prio2)
+                        (octet-pair->number weight1 weight2)
+                        (octet-pair->number port1 port2)
+                        (bytes->string/latin-1 target-name))
+                (loop rest))]
+         [_ (loop rest)])])))
diff --git a/net-test/tests/net/dns.rkt b/net-test/tests/net/dns.rkt
index 53ffcc6845..d3e4df0e92 100644
--- a/net-test/tests/net/dns.rkt
+++ b/net-test/tests/net/dns.rkt
@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require net/dns rackunit)
+(require net/private/rr-srv)
 
 ;; internal tests
 
@@ -90,13 +91,39 @@
 (define *nwu-mx*       '("cuda.eecs.northwestern.edu" "barra.eecs.northwestern.edu"))
 (define *kame-url*     "www.kame.net")
 (define *kame-ip*      "2001:200:dff:fff1:216:3eff:feb1:44d7")
+(define *xmpp-client*  (srv-rr 0 0 5222 "xmpp.racket-lang.org"))
 
 (define (nameserver-tests nameserver)
   (check member (dns-get-address nameserver *nwu-url*) *nwu-ips*)
   (check-equal? (dns-get-address nameserver *racket-host*) *racket-ip*)
   (check-equal? (dns-get-address nameserver *kame-url* #:ipv6? #t) *kame-ip*)
   (check-equal? (dns-get-name nameserver *racket-ip*) *racket-host*)
-  (check member (dns-get-mail-exchanger nameserver *nwu-url*) *nwu-mx*))
+  (check member (dns-get-mail-exchanger nameserver *nwu-url*) *nwu-mx*)
+  (check-equal? (dns-get-srv nameserver "racket-lang.org" "xmpp-client") (list *xmpp-client*))
+  (check-equal? (dns-get-srv nameserver "nonexistent-srv-record.racket-lang.org" "xmpp-client")
+                '()))
+
+(define (srv-tests)
+  (define srv-xmpp-8020-srv-rr
+    '((#"_xmpp-client._tcp.leastfixedpoint.com" srv in 62917
+       (0 0
+        0 0
+        20 102
+        4 120 109 112 112 13 101 105 103 104 116 121 45 116 119 101 110 116 121 3 111 114 103 0))))
+  (define srv-xmpp-8020-reply
+    '(0 185 129 128
+      0 1
+      0 1
+      0 3
+      0 0
+      12 95 120 109 112 112 45 99 108 105 101 110 116 4 95 116 99 112 15 108
+      101 97 115 116 102 105 120 101 100 112 111 105 110 116 3 99 111 109 0 0
+      33 0 1 192 12 0 33 0 1 0 1 7 160 0 30 0 0 0 0 20 102 4 120 109 112 112
+      13 101 105 103 104 116 121 45 116 119 101 110 116 121 3 111 114 103 0 192
+      30 0 2 0 1 0 1 51 30 0 13 1 98 2 110 115 5 106 111 107 101 114 192 46 192
+      30 0 2 0 1 0 1 51 30 0 4 1 99 192 111 192 30 0 2 0 1 0 1 51 30 0 4 1 97 192 111))
+  (check-equal? (parse-srv-rr srv-xmpp-8020-srv-rr srv-xmpp-8020-reply)
+                (list (srv-rr 0 0 5222 "xmpp.eighty-twenty.org"))))
 
 (provide tests)
 (module+ main (tests))
@@ -104,6 +131,7 @@
   (internal-tests)
   (nameserver-tests *google-dns*)
   (nameserver-tests *google-dns-2*)
+  (srv-tests)
   (let ([ns (dns-find-nameserver)]) (when ns (nameserver-tests ns))))
 
 (module+ test (require (submod ".." main))) ; for raco test & drdr