Ignore duplicate requests while still processing an earlier repeat
This commit is contained in:
parent
1d110a1845
commit
7217768b9a
26
proxy.rkt
26
proxy.rkt
|
@ -22,6 +22,9 @@
|
||||||
;; searches from. Performs recursive queries. Doesn't yet cache
|
;; searches from. Performs recursive queries. Doesn't yet cache
|
||||||
;; responses, but will do so in future.
|
;; responses, but will do so in future.
|
||||||
|
|
||||||
|
;; For discarding retransmitted requests that we're still working on.
|
||||||
|
(struct active-request (source id) #:transparent)
|
||||||
|
|
||||||
;; start-proxy : UInt16 ListOf<RR> -> Void
|
;; start-proxy : UInt16 ListOf<RR> -> Void
|
||||||
(require racket/pretty)
|
(require racket/pretty)
|
||||||
(define (start-proxy port-number rrs)
|
(define (start-proxy port-number rrs)
|
||||||
|
@ -30,7 +33,7 @@
|
||||||
(pretty-print zone)
|
(pretty-print zone)
|
||||||
|
|
||||||
(define boot-server
|
(define boot-server
|
||||||
(os-big-bang 'no-state
|
(os-big-bang (set) ;; SetOf<ActiveRequest>
|
||||||
;;(spawn dns-spy)
|
;;(spawn dns-spy)
|
||||||
(spawn (timer-relay))
|
(spawn (timer-relay))
|
||||||
(send-meta-message `(request create-server-socket (udp new ,port-number 512)))
|
(send-meta-message `(request create-server-socket (udp new ,port-number 512)))
|
||||||
|
@ -39,8 +42,6 @@
|
||||||
[`(reply create-server-socket ,s)
|
[`(reply create-server-socket ,s)
|
||||||
(transition w
|
(transition w
|
||||||
(unsubscribe 'wait-for-server-socket)
|
(unsubscribe 'wait-for-server-socket)
|
||||||
(spawn (dns-read-driver s))
|
|
||||||
(spawn (dns-write-driver s))
|
|
||||||
(send-meta-message
|
(send-meta-message
|
||||||
`(request create-client-socket (udp new 0 512)))
|
`(request create-client-socket (udp new 0 512)))
|
||||||
(client-socket-waiter s))]))))
|
(client-socket-waiter s))]))))
|
||||||
|
@ -51,17 +52,28 @@
|
||||||
[`(reply create-client-socket ,c)
|
[`(reply create-client-socket ,c)
|
||||||
(transition w
|
(transition w
|
||||||
(unsubscribe 'wait-for-client-socket)
|
(unsubscribe 'wait-for-client-socket)
|
||||||
|
(spawn (dns-read-driver s))
|
||||||
|
(spawn (dns-write-driver s))
|
||||||
(spawn (dns-read-driver c))
|
(spawn (dns-read-driver c))
|
||||||
(spawn (dns-write-driver c))
|
(spawn (dns-write-driver c))
|
||||||
(subscribe 'packet-handler (packet-handler s c)))])))
|
(subscribe 'packet-handler (packet-handler s c)))])))
|
||||||
|
|
||||||
(define (packet-handler s c)
|
(define (packet-handler s c)
|
||||||
(message-handlers old-state
|
(message-handlers old-active-requests
|
||||||
[(? bad-dns-packet? p)
|
[(? bad-dns-packet? p)
|
||||||
(pretty-print p) ;; TODO: perhaps use metalevel events? perhaps don't bother though
|
(pretty-print p) ;; TODO: perhaps use metalevel events? perhaps don't bother though
|
||||||
old-state]
|
old-active-requests]
|
||||||
[(and r (dns-request _ _ (== s))) ;; We only listen for requests on our server socket
|
[(and r (dns-request m source (== s))) ;; We only listen for requests on our server socket
|
||||||
(transition old-state (spawn (request-handler zone r c)))]))
|
(define req-id (active-request source (dns-message-id m)))
|
||||||
|
;; TODO: when we have presence/error-handling, remove req-id
|
||||||
|
;; from active requests once request-handler pseudothread exits.
|
||||||
|
(if (set-member? old-active-requests req-id)
|
||||||
|
old-active-requests ;; ignore retransmitted duplicates
|
||||||
|
(transition (set-add old-active-requests req-id)
|
||||||
|
(spawn (request-handler zone r c))))]
|
||||||
|
[(and r (dns-reply m (== s) sink))
|
||||||
|
(define req-id (active-request sink (dns-message-id m)))
|
||||||
|
(set-remove old-active-requests req-id)]))
|
||||||
|
|
||||||
(ground-vm (os-big-bang (void)
|
(ground-vm (os-big-bang (void)
|
||||||
;;(spawn udp-spy)
|
;;(spawn udp-spy)
|
||||||
|
|
Loading…
Reference in New Issue