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

Make role names optional, and remove role/anon. Remove inessential 

role names from apps. Make nested-vm a macro.
This commit is contained in:
Tony Garnock-Jones 2012-07-23 15:22:18 -04:00
parent 291ec07404
commit bfab626708
4 changed files with 26 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
driver.rkt
View File

@ -43,19 +43,16 @@
(transition 'no-state
;; (spawn udp-spy #:debug-name 'udp-spy)
(spawn udp-driver #:debug-name 'udp-driver)
(spawn (nested-vm
'dns-vm
(spawn (nested-vm #:debug-name 'dns-vm
(transition 'no-state
(spawn dns-spy #:debug-name 'dns-spy)
(spawn (dns-read-driver local-addr) #:debug-name 'dns-read-driver)
(spawn (dns-write-driver local-addr) #:debug-name 'dns-write-driver)
(role 'error-logger (topic-subscriber (bad-dns-packet (wild) (wild) (wild) (wild)))
#:state w
(role (topic-subscriber (bad-dns-packet (wild) (wild) (wild) (wild)))
[p (begin (log-error (pretty-format p))
w)])
(role 'request-booter (topic-subscriber (dns-request (wild) (wild) (wild)))
#:state w
[r (transition w (map send-message (handle-request soa-rr zone r)))])))
'())])
(role (topic-subscriber (dns-request (wild) (wild) (wild)))
[r (map send-message (handle-request soa-rr zone r))])))
#:debug-name 'dns-vm))))
(define (handle-request soa-rr zone request)

9
network-query.rkt
View File

@ -264,7 +264,8 @@
(define rpc-id (gensym 'network-query/allocate-query-id))
(transition w
(send-message `(request ,rpc-id allocate-query-id))
(role rpc-id (topic-subscriber `(reply ,rpc-id ,(wild)))
(role (topic-subscriber `(reply ,rpc-id ,(wild)))
#:name rpc-id
#:state w
[`(reply ,(== rpc-id) ,id)
(sequence-actions (send-request (struct-copy network-query-state w
@ -309,9 +310,9 @@
(transition w
(send-message (dns-request query s server-ip))
(send-message (set-timer subscription-id (* timeout 1000) 'relative))
(role subscription-id
(set (topic-subscriber (timer-expired subscription-id (wild)))
(topic-subscriber (dns-reply (wild) (wild) s)))
(role (set (topic-subscriber (timer-expired subscription-id (wild)))
(topic-subscriber (dns-reply (wild) (wild) s)))
#:name subscription-id
#:state w
[(timer-expired (== subscription-id) _)
(log-debug (format "Timed out ~v ~v to ~v ~v after ~v seconds"

10
os2-dns.rkt
View File

@ -21,8 +21,7 @@
(define (dns-read-driver s)
(transition 'no-state
(at-meta-level
(role 'packet-reader
(topic-subscriber (udp-packet (wild) s (wild)))
(role (topic-subscriber (udp-packet (wild) s (wild)))
#:state w
[(udp-packet source (== s) #"")
(log-info "Debug dump packet received")
@ -43,16 +42,15 @@
(at-meta-level
(send-message (udp-packet s sink (dns-message->packet message))))))
(transition 'no-state
(role 'packet-writer
(set (topic-subscriber (dns-request (wild) s (wild)))
(topic-subscriber (dns-reply (wild) s (wild))))
(role (set (topic-subscriber (dns-request (wild) s (wild)))
(topic-subscriber (dns-reply (wild) s (wild))))
#:state w
[(dns-request message (== s) sink) (transition w (translate message sink))]
[(dns-reply message (== s) sink) (transition w (translate message sink))])))
(define dns-spy
(transition 'none
(role 'spy (topic-subscriber (wild) #:monitor? #t)
(role (topic-subscriber (wild) #:monitor? #t)
#:state w
[(dns-request message source sink)
(log-info (format "DNS: ~v asks ~v ~v~n : ~v"

25
proxy.rkt
View File

@ -36,8 +36,7 @@
;;(spawn udp-spy)
(spawn udp-driver #:debug-name 'udp-driver)
(spawn (timer-driver 'timer-driver) #:debug-name 'timer-driver)
(spawn (nested-vm
'dns-vm
(spawn (nested-vm #:debug-name 'dns-vm
(transition 'no-state
(spawn dns-spy #:debug-name 'dns-spy)
(spawn (timer-relay 'timer-relay:dns) #:debug-name 'timer-relay)
@ -55,7 +54,7 @@
;; TODO: track how many are allocated and throttle requests if too
;; many are in flight
(transition (set) ;; SetOf<UInt16>, all active query IDs
(role 'query-id-request-handler (topic-subscriber `(request ,(wild) allocate-query-id))
(role (topic-subscriber `(request ,(wild) allocate-query-id))
#:state allocated
[`(request ,reply-addr allocate-query-id)
(let recheck ()
@ -64,20 +63,20 @@
(recheck)
(transition (set-add allocated n)
(send-message `(reply ,reply-addr ,n)))))])
(role 'query-id-release-handler (topic-subscriber `(release-query-id ,(wild)))
(role (topic-subscriber `(release-query-id ,(wild)))
#:state allocated
[`(release-query-id ,n)
(transition (set-remove allocated n))])))
(define (packet-dispatcher s)
(transition (set) ;; SetOf<ActiveRequest>
(role 'error-logger (topic-subscriber (bad-dns-packet (wild) (wild) (wild) (wild)))
(role (topic-subscriber (bad-dns-packet (wild) (wild) (wild) (wild)))
#:state old-active-requests
[p
(log-error (pretty-format p))
;; TODO: ^ perhaps use metalevel events? perhaps don't bother though
old-active-requests])
(role 'request-booter (topic-subscriber (dns-request (wild) (wild) s))
(role (topic-subscriber (dns-request (wild) (wild) s))
#:state old-active-requests
[(and r (dns-request m source (== s))) ;; We only listen for requests on our server socket
(define req-id (active-request source (dns-message-id m)))
@ -87,7 +86,7 @@
old-active-requests ;; ignore retransmitted duplicates
(transition (set-add old-active-requests req-id)
(spawn (packet-relay req-id r) #:debug-name (list 'packet-relay req-id))))])
(role 'reply-cleanup (topic-subscriber (dns-reply (wild) s (wild)))
(role (topic-subscriber (dns-reply (wild) s (wild)))
#:state old-active-requests
[(and r (dns-reply m (== s) sink))
(define req-id (active-request sink (dns-message-id m)))
@ -164,7 +163,7 @@
(define-values (cleaned-seed-zone initial-timers) (zone-expire seed-zone))
(sequence-actions (transition-and-set-timers cleaned-seed-zone initial-timers)
;; TODO: consider deduping questions here too?
(role 'debug-dumper (topic-subscriber `(debug-dump))
(role (topic-subscriber `(debug-dump))
#:state zone
[`(debug-dump)
(with-output-to-file "zone-proxy.zone"
@ -192,7 +191,7 @@
#:mode 'text
#:exists 'append)
zone])
(role 'question-handler-factory (topic-subscriber (question (wild) (wild) (wild) (wild)))
(role (topic-subscriber (question (wild) (wild) (wild) (wild)))
#:state zone
[(? question? q)
(transition zone
@ -207,13 +206,12 @@
[else
(spawn (question-handler zone q client-sock)
#:debug-name (list 'question-handler q))]))])
(role 'network-reply-snoop (topic-subscriber (network-reply (wild) (wild)))
(role (topic-subscriber (network-reply (wild) (wild)))
#:state zone
[(network-reply _ answer)
(define-values (new-zone timers) (incorporate-complete-answer answer zone))
(transition-and-set-timers new-zone timers)])
(role 'timer-expiry-handler
(topic-subscriber (timer-expired (list 'check-dns-expiry (wild)) (wild)))
(role (topic-subscriber (timer-expired (list 'check-dns-expiry (wild)) (wild)))
#:state zone
[(timer-expired (list 'check-dns-expiry name) now-msec)
(zone-expire-name zone name (/ now-msec 1000.0))])))
@ -252,7 +250,8 @@
(map rr-rdata (set->list nameserver-rrs))
referral-id)
#:debug-name (list 'network-query q))
(role referral-id (topic-subscriber (network-reply referral-id (wild)))
(role (topic-subscriber (network-reply referral-id (wild)))
#:name referral-id
#:state w
[(network-reply (== referral-id) #f) ;; name-error/NXDOMAIN
(transition w