The Big Spawn/Actor Swap
This commit is contained in:
parent
53af1e0dd5
commit
35430ecb2e
|
@ -211,7 +211,7 @@
|
||||||
;; UdpAddress Question DomainName (Listof DomainName) Any ->
|
;; UdpAddress Question DomainName (Listof DomainName) Any ->
|
||||||
;; Void))
|
;; Void))
|
||||||
(define (network-query s q zone-origin server-names unique-id)
|
(define (network-query s q zone-origin server-names unique-id)
|
||||||
(actor*
|
(spawn*
|
||||||
#:name (list 'network-query q)
|
#:name (list 'network-query q)
|
||||||
(field [timeout first-timeout]
|
(field [timeout first-timeout]
|
||||||
[known-addresses #hash()] ;; Hash DomainName (Listof UdpAddress)
|
[known-addresses #hash()] ;; Hash DomainName (Listof UdpAddress)
|
||||||
|
|
14
proxy.rkt
14
proxy.rkt
|
@ -54,7 +54,7 @@
|
||||||
(spawn-udp-driver)
|
(spawn-udp-driver)
|
||||||
(dataspace #:name 'dns-vm
|
(dataspace #:name 'dns-vm
|
||||||
(dns-spy)
|
(dns-spy)
|
||||||
(actor #:name 'timer-relay:dns
|
(spawn #:name 'timer-relay:dns
|
||||||
(on (message (inbound ($ m (timer-expired _ _)))) (send! m))
|
(on (message (inbound ($ m (timer-expired _ _)))) (send! m))
|
||||||
(on (message ($ m (set-timer _ _ _))) (send! (outbound m))))
|
(on (message ($ m (set-timer _ _ _))) (send! (outbound m))))
|
||||||
(query-id-allocator)
|
(query-id-allocator)
|
||||||
|
@ -70,7 +70,7 @@
|
||||||
(define (query-id-allocator)
|
(define (query-id-allocator)
|
||||||
;; TODO: track how many are allocated and throttle requests if too
|
;; TODO: track how many are allocated and throttle requests if too
|
||||||
;; many are in flight
|
;; many are in flight
|
||||||
(actor #:name 'query-id-allocator
|
(spawn #:name 'query-id-allocator
|
||||||
(field [allocated (set)])
|
(field [allocated (set)])
|
||||||
(on (message `(request ,$reply-addr allocate-query-id))
|
(on (message `(request ,$reply-addr allocate-query-id))
|
||||||
(let recheck ()
|
(let recheck ()
|
||||||
|
@ -84,7 +84,7 @@
|
||||||
|
|
||||||
;; (: packet-dispatcher : UdpAddress -> Void)
|
;; (: packet-dispatcher : UdpAddress -> Void)
|
||||||
(define (packet-dispatcher s)
|
(define (packet-dispatcher s)
|
||||||
(actor #:name 'packet-dispatcher
|
(spawn #:name 'packet-dispatcher
|
||||||
(field [old-active-requests (set)])
|
(field [old-active-requests (set)])
|
||||||
(on (message ($ p (bad-dns-packet _ _ _ _)))
|
(on (message ($ p (bad-dns-packet _ _ _ _)))
|
||||||
(log-error "~a" (pretty-format p)))
|
(log-error "~a" (pretty-format p)))
|
||||||
|
@ -129,7 +129,7 @@
|
||||||
request-sink
|
request-sink
|
||||||
request-source))
|
request-source))
|
||||||
|
|
||||||
(actor*
|
(spawn*
|
||||||
#:name (list 'packet-relay req-id)
|
#:name (list 'packet-relay req-id)
|
||||||
|
|
||||||
;; TODO: pay attention to recursion-desired flag
|
;; TODO: pay attention to recursion-desired flag
|
||||||
|
@ -153,7 +153,7 @@
|
||||||
(define (glueless-question-handler roots-only-zone q client-sock)
|
(define (glueless-question-handler roots-only-zone q client-sock)
|
||||||
;; Restart q, an overly-glueless question, from the roots.
|
;; Restart q, an overly-glueless question, from the roots.
|
||||||
(define restarted-question (restart-question q))
|
(define restarted-question (restart-question q))
|
||||||
(actor #:name (list 'glueless-question-handler q)
|
(spawn #:name (list 'glueless-question-handler q)
|
||||||
(stop-when (message (answered-question restarted-question $ans))
|
(stop-when (message (answered-question restarted-question $ans))
|
||||||
;; We got the answer to our restarted question; now transform
|
;; We got the answer to our restarted question; now transform
|
||||||
;; it into an answer to the original question, to unblock the
|
;; it into an answer to the original question, to unblock the
|
||||||
|
@ -164,7 +164,7 @@
|
||||||
;; (: question-dispatcher : CompiledZone CompiledZone UdpAddress -> Void)
|
;; (: question-dispatcher : CompiledZone CompiledZone UdpAddress -> Void)
|
||||||
(define (question-dispatcher seed-zone roots-only client-sock)
|
(define (question-dispatcher seed-zone roots-only client-sock)
|
||||||
(define-values (cleaned-seed-zone initial-timers) (zone-expire seed-zone))
|
(define-values (cleaned-seed-zone initial-timers) (zone-expire seed-zone))
|
||||||
(actor #:name 'question-dispatcher
|
(spawn #:name 'question-dispatcher
|
||||||
(field [zone cleaned-seed-zone])
|
(field [zone cleaned-seed-zone])
|
||||||
(on-start (set-timers! initial-timers))
|
(on-start (set-timers! initial-timers))
|
||||||
|
|
||||||
|
@ -231,7 +231,7 @@
|
||||||
|
|
||||||
;; (: question-handler : CompiledZone Question UdpAddress -> Void)
|
;; (: question-handler : CompiledZone Question UdpAddress -> Void)
|
||||||
(define (question-handler zone0 q client-sock)
|
(define (question-handler zone0 q client-sock)
|
||||||
(actor*
|
(spawn*
|
||||||
#:name (list 'question-handler q)
|
#:name (list 'question-handler q)
|
||||||
(let retry-question ((zone zone0)
|
(let retry-question ((zone zone0)
|
||||||
(nameservers-tried (set))
|
(nameservers-tried (set))
|
||||||
|
|
|
@ -38,7 +38,7 @@
|
||||||
(struct dns-reply (message source sink) #:transparent)
|
(struct dns-reply (message source sink) #:transparent)
|
||||||
|
|
||||||
(define (dns-read-driver s)
|
(define (dns-read-driver s)
|
||||||
(actor
|
(spawn
|
||||||
#:name (list 'dns-read-driver s)
|
#:name (list 'dns-read-driver s)
|
||||||
(on (message (inbound (udp-packet $source s #"")))
|
(on (message (inbound (udp-packet $source s #"")))
|
||||||
(log-info "Debug dump packet received")
|
(log-info "Debug dump packet received")
|
||||||
|
@ -58,14 +58,14 @@
|
||||||
(outbound (udp-packet s sink (dns-message->packet message)))))
|
(outbound (udp-packet s sink (dns-message->packet message)))))
|
||||||
|
|
||||||
(define (dns-write-driver s)
|
(define (dns-write-driver s)
|
||||||
(actor #:name (list 'dns-write-driver s)
|
(spawn #:name (list 'dns-write-driver s)
|
||||||
(on (message (dns-request $message s $sink))
|
(on (message (dns-request $message s $sink))
|
||||||
(send! (translate message s sink)))
|
(send! (translate message s sink)))
|
||||||
(on (message (dns-reply $message s $sink))
|
(on (message (dns-reply $message s $sink))
|
||||||
(send! (translate message s sink)))))
|
(send! (translate message s sink)))))
|
||||||
|
|
||||||
(define (dns-spy)
|
(define (dns-spy)
|
||||||
(actor #:name 'dns-spy
|
(spawn #:name 'dns-spy
|
||||||
(on (message (dns-request $message $source $sink))
|
(on (message (dns-request $message $source $sink))
|
||||||
(log-info (format "DNS: ~v asks ~v ~v~n : ~v"
|
(log-info (format "DNS: ~v asks ~v ~v~n : ~v"
|
||||||
source sink (dns-message-id message)
|
source sink (dns-message-id message)
|
||||||
|
|
Loading…
Reference in New Issue