More debug output
This commit is contained in:
parent
d2af6bf52e
commit
79254cc7f4
|
@ -216,6 +216,8 @@
|
||||||
(define query (make-dns-query-message q query-id))
|
(define query (make-dns-query-message q query-id))
|
||||||
(define subscription-id (list s query-id))
|
(define subscription-id (list s query-id))
|
||||||
(define start-time (current-inexact-milliseconds))
|
(define start-time (current-inexact-milliseconds))
|
||||||
|
(begin (write `(Sending ,q ,query-id to ,zone-origin ,server-ip with ,timeout second timeout))
|
||||||
|
(newline))
|
||||||
(transition w
|
(transition w
|
||||||
(send-message (dns-request query s server-ip))
|
(send-message (dns-request query s server-ip))
|
||||||
(send-message (set-timer subscription-id (* timeout 1000) #t))
|
(send-message (set-timer subscription-id (* timeout 1000) #t))
|
||||||
|
@ -229,9 +231,14 @@
|
||||||
(send-message (list 'release-query-id query-id)))]
|
(send-message (list 'release-query-id query-id)))]
|
||||||
[(dns-reply reply-message source (== s))
|
[(dns-reply reply-message source (== s))
|
||||||
;; TODO: maybe receive only specifically from the queried IP address?
|
;; TODO: maybe receive only specifically from the queried IP address?
|
||||||
(write `(,q --> ,(dns-message-answers reply-message) from ,server-ip in
|
(begin
|
||||||
,(inexact->exact (round (- (current-inexact-milliseconds) start-time)))
|
(write `(Answer to ,q from ,zone-origin ,server-ip in
|
||||||
ms)) (newline)
|
,(inexact->exact (round (- (current-inexact-milliseconds) start-time)))
|
||||||
|
ms))
|
||||||
|
(newline)
|
||||||
|
(write `(-- answers ,(dns-message-answers reply-message))) (newline)
|
||||||
|
(write `(-- authorities ,(dns-message-authorities reply-message))) (newline)
|
||||||
|
(write `(-- additional ,(dns-message-additional reply-message))) (newline))
|
||||||
(if (not (= (dns-message-id reply-message) (dns-message-id query)))
|
(if (not (= (dns-message-id reply-message) (dns-message-id query)))
|
||||||
w
|
w
|
||||||
(extend-transition (on-answer w (filter-dns-reply reply-message zone-origin))
|
(extend-transition (on-answer w (filter-dns-reply reply-message zone-origin))
|
||||||
|
|
|
@ -136,6 +136,10 @@
|
||||||
(subscribe/fresh wait-id
|
(subscribe/fresh wait-id
|
||||||
(message-handlers w
|
(message-handlers w
|
||||||
[(answered-question (== original-question) answer)
|
[(answered-question (== original-question) answer)
|
||||||
|
(begin (write `(Final answer to ,original-question
|
||||||
|
with query id ,(dns-message-id request-message)
|
||||||
|
is ,answer))
|
||||||
|
(newline))
|
||||||
(transition w
|
(transition w
|
||||||
(unsubscribe wait-id)
|
(unsubscribe wait-id)
|
||||||
(send-message (answer->reply original-question answer)))])))]))
|
(send-message (answer->reply original-question answer)))])))]))
|
||||||
|
@ -200,6 +204,11 @@
|
||||||
[#f ;; We're not authoritative so this is just a signal that we can't answer usefully
|
[#f ;; We're not authoritative so this is just a signal that we can't answer usefully
|
||||||
(send-empty-reply w q)]
|
(send-empty-reply w q)]
|
||||||
[(referral zone-origin nameserver-rrs _)
|
[(referral zone-origin nameserver-rrs _)
|
||||||
|
(begin
|
||||||
|
(write `(Referral for ,q
|
||||||
|
to ,(domain-labels zone-origin)
|
||||||
|
servers ,(map domain-labels (set-map nameserver-rrs rr-rdata))))
|
||||||
|
(newline))
|
||||||
(define referral-id (gensym 'referral))
|
(define referral-id (gensym 'referral))
|
||||||
(transition w
|
(transition w
|
||||||
(spawn (network-query client-sock
|
(spawn (network-query client-sock
|
||||||
|
|
Loading…
Reference in New Issue