Fix parsing when CNAME is provided for MX query

The code was assuming that the record type was
MX even though this could be false. Also adjusted
some code to also make it easier to test.

Note: the behavior when MX records are missing
is probably still not right.

Closes PR 13654

original commit: c7d878c009

collects/net/dns.rkt

@@ -214,6 +214,11 @@
                                           timeout))
                             (lambda (v) (retry (* timeout 2)))))))
       (lambda () (udp-close udp))))
+
+  (parse-reply query reply))
+
+;; Parse a DNS query reply
+(define (parse-reply query reply)
   ;; First two bytes must match sent message id:
   (unless (and (= (car reply)  (car query))
                (= (cadr reply) (cadr query)))
@@ -361,24 +366,31 @@
   (or (try-forwarding
        (lambda (nameserver)
          (let-values ([(auth? qds ans nss ars reply) (dns-query/cache nameserver addr 'mx 'in)])
-           (values (let loop ([ans ans][best-pref +inf.0][exchanger #f])
+           (values (parse-mx-response ans nss reply addr) ars auth?)))
+       nameserver)
+      (error 'dns-get-mail-exchanger "bad address")))
+
+;; helper that parses a response for MX queries
+(define (parse-mx-response ans nss reply addr)
+  (let loop ([ans ans] [best-pref +inf.0] [exchanger #f])
     (cond
      [(null? ans)
       (or (and exchanger (bytes->string/latin-1 exchanger))
-                            ;; Does 'soa mean that the input address is fine?
+          ;; FIXME: Does 'soa mean that the input address is fine?
           (and (ormap (lambda (ns) (eq? (rr-type ns) 'soa))
                       nss)
                addr))]
      [else
+      (define type (rr-type (car ans)))
       (define d (rr-data (car ans)))
+      (cond [(not (eq? type 'mx)) ; not MX record, keep going
+             (loop (cdr ans) best-pref exchanger)]
+            [else
              (define pref (octet-pair->number (car d) (cadr d)))
              (if (< pref best-pref)
                  (let-values ([(name start) (parse-name (cddr d) reply)])
                    (loop (cdr ans) pref name))
-                            (loop (cdr ans) best-pref exchanger))]))
+                 (loop (cdr ans) best-pref exchanger))])])))
-                   ars auth?)))
-       nameserver)
-      (error 'dns-get-mail-exchanger "bad address")))
 
 (define (dns-find-nameserver)
   (case (system-type)

collects/tests/net/dns.rkt

@@ -3,8 +3,66 @@
 (require net/dns tests/eli-tester)
 
 ;; internal tests
+
+(define mx-response-with-cname
+  '(;; random ID
+    0 187
+    ;; QR Opcode  AA TC RD RA Z     RCODE
+    ;; 1  0 0 0 0 0  0  1  1  0 0 0 0 0 0 0
+    129 128
+    ;; QDCOUNT
+    0 1
+    ;; ANSCOUNT
+    0 1
+    ;; NSCOUNT
+    0 1
+    ;; ARCOUNT
+    0 0
+    ;; QNAME (stat.ethz.ch)
+    4 115 116 97 116
+    4 101 116 104 122
+    2 99 104 0
+    ;; QTYPE (MX)
+    0 15
+    ;; QCLASS (IN)
+    0 1
+    ;; NAME (pointer)
+    ;; 1100000000001100
+    192 12
+    ;; TYPE: CNAME
+    0 5
+    ;; CLASS
+    0 1
+    ;; TTL
+    0 0
+    4 79
+    ;; RDLENGTH
+    0 19
+    ;; RDATA
+    11 109 97 103 101 108 108 97 110 45 48 54
+    4 109 97 116 104
+    192 17
+    ;; NAME (pointer)
+    192 17
+    ;; TYPE: SOA
+    0 6
+    ;; CLASS
+    0 1
+    ;; TTL
+    0 0 1 90
+    ;; RDLENGTH & DATA
+    0 44 8 100 117 109 109 121 45
+    110 115 192 17 10 104 111 115 116 109
+    97 115 116 101 114 192 17 119 168 176
+    33 0 0 42 48 0 0 14 16 0 27 175 128 0 0 2 88))
+
 (require (only-in rackunit require/expose) net/private/ip)
-(require/expose net/dns (ip->in-addr.arpa ip->ip6.arpa))
+(require/expose net/dns (ip->in-addr.arpa ip->ip6.arpa
+                         parse-reply parse-mx-response))
+
+(define-values (_1 _2 mx-ans mx-nss _3 _4)
+  (parse-reply '(0 187 129 128) mx-response-with-cname))
+
 (define (internal-tests)
   (test (ip->in-addr.arpa (ipv4 (bytes 8 8 8 8)))
         => "8.8.8.8.in-addr.arpa"
@@ -15,7 +73,11 @@
                           ".2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa")
         (ip->ip6.arpa (make-ip-address "2001:db8::567:89ab"))
         => (string-append "b.a.9.8.7.6.5.0.0.0.0.0.0.0.0.0"
-                          ".0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.ip6.arpa")))
+                          ".0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.ip6.arpa")
+        ;; FIXME: may need to change if SOA handling in net/dns
+        ;;        changes (see FIXME there)
+        (parse-mx-response mx-ans mx-nss mx-response-with-cname "stat.ethz.ch")
+        => "stat.ethz.ch"))
 
 ;; Constants for testing. These can go out of sync
 ;; when server setups change, so keep them up-to-date.