From eb72ab5bba555d7e1aabfa2f8d8c3dd2f24c9a0f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 16 May 2005 19:34:22 +0000 Subject: [PATCH] . original commit: 574aa4f50ecbbb68aa64dffaa67adc2bb9acdd9e --- collects/net/dns-unit.ss | 44 +++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/collects/net/dns-unit.ss b/collects/net/dns-unit.ss index 6dbe506..897bba3 100644 --- a/collects/net/dns-unit.ss +++ b/collects/net/dns-unit.ss @@ -6,6 +6,9 @@ (require "dns-sig.ss") + ;; UDP retry timeout: + (define INIT-TIMEOUT 50) + (provide net:dns@) (define net:dns@ (unit/sig net:dns^ @@ -165,26 +168,29 @@ (raise-type-error 'dns-query "DNS query class" class)) (let* ([query (make-query (random 256) (string->bytes/latin-1 addr) type class)] + [udp (udp-open-socket)] [reply - (let-values ([(r w) (tcp-connect nameserver 53)]) - (dynamic-wind - void - - (lambda () - (display (list->bytes (add-size-tag query)) w) - (flush-output w) - - (let ([a (read-byte r)] - [b (read-byte r)]) - (let ([len (octet-pair->number a b)]) - (let ([s (read-bytes len r)]) - (unless (= len (bytes-length s)) - (error 'dns-query "unexpected EOF from server")) - (bytes->list s))))) - - (lambda () - (close-input-port r) - (close-output-port w))))]) + (dynamic-wind + void + + (lambda () + (let ([s (make-bytes 512)]) + (let retry ([timeout INIT-TIMEOUT]) + (udp-send-to udp nameserver 53 (list->bytes query)) + + (sync + (handle-evt + (udp-receive!-evt udp s) + (lambda (r) + (bytes->list (subbytes s 0 (car r))))) + (handle-evt + (alarm-evt (+ (current-inexact-milliseconds) + timeout)) + (lambda (v) + (retry (* timeout 2)))))))) + + (lambda () + (udp-close udp)))]) ; First two bytes must match sent message id: (unless (and (= (car reply) (car query))