syndicate-lang
/
racket-dns-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Track current-name, which we need to know to remove lame servers.

This commit is contained in:
Tony Garnock-Jones 2012-04-04 17:55:33 -04:00
parent 18facb4c9e
commit 6c8c6c5201
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
network-query.rkt
View File

@ -86,11 +86,13 @@
;; A NetworkQueryState is a (network-query-state NetworkRequest
;; Integer Map<DomainName,ListOf<UdpAddress>> ListOf<UdpAddress>
;; ListOf<DomainName>), representing an in-progress DNS network query.
;; Maybe<DomainName> ListOf<DomainName>), representing an in-progress
;; DNS network query.
(struct network-query-state (request
timeout
known-addresses
remaining-addresses
current-name
remaining-names)
#:transparent)
@ -154,29 +156,34 @@
first-timeout
(hash)
'()
#f
server-names))))
(define (try-next-server w)
(match w
[(network-query-state _ #f _ _ _)
[(network-query-state _ #f _ _ _ _)
;; No more timeouts to try, so give up.
(on-answer w (empty-complete-answer))]
[(network-query-state req timeout _ '() '())
[(network-query-state req timeout _ '() _ '())
;; No more addresses to try with this timeout. Refill the list
;; and bump the timeout and retry.
;; TODO: randomize ordering of servers in list. (Don't forget the initial fill.)
(try-next-server (struct-copy network-query-state w
[timeout (next-timeout timeout)]
[remaining-addresses '()]
[current-name #f]
[remaining-names (network-request-server-names req)]))]
[(network-query-state req _ known-addresses '() (cons current-name remaining-names))
[(network-query-state req _ known-addresses '() _ (cons current-name remaining-names))
(if (hash-has-key? known-addresses current-name)
(try-next-server (struct-copy network-query-state w
[remaining-addresses (hash-ref known-addresses
current-name)]
[current-name current-name]
[remaining-names remaining-names]))
(let ((subq (ns-question current-name (network-request-question req))))
(transition (struct-copy network-query-state w [remaining-names remaining-names])
(transition (struct-copy network-query-state w
[current-name current-name]
[remaining-names remaining-names])
(send-message subq)
(subscribe/fresh subscription-id
(message-handlers w
@ -190,7 +197,7 @@
ips)]
[remaining-addresses ips]))
(unsubscribe subscription-id))])))))]
[(network-query-state req timeout _ (cons current-ip remaining-ips) _)
[(network-query-state req timeout _ (cons current-ip remaining-ips) _ _)
(define rpc-id (gensym 'network-query/allocate-query-id))
(transition w
(send-message `(request ,rpc-id allocate-query-id))