This commit is contained in:
Tony Garnock-Jones 2012-02-17 16:09:54 -05:00
parent 87943e435b
commit d2af6bf52e
1 changed files with 18 additions and 18 deletions

View File

@ -40,29 +40,29 @@
(define boot-server (define boot-server
(os-big-bang 'no-state (os-big-bang 'no-state
(send-meta-message `(request create-server-socket (udp new ,port-number 512))) (send-meta-message `(request create-server-socket (udp new ,port-number 512)))
(subscribe/fresh wait-id (subscribe/fresh wait-id
(meta-message-handlers w (meta-message-handlers w
[`(reply create-server-socket ,s) [`(reply create-server-socket ,s)
(transition w (transition w
(unsubscribe wait-id) (unsubscribe wait-id)
(spawn (dns-read-driver s)) (spawn (dns-read-driver s))
(spawn (dns-write-driver s)) (spawn (dns-write-driver s))
(subscribe 'packet-handler (packet-handler s)))])))) (subscribe 'packet-handler (packet-handler s)))]))))
(define (packet-handler s) (define (packet-handler s)
(message-handlers old-state (message-handlers old-state
[(? 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-state]
[(? dns-request? r) [(? dns-request? r)
(transition old-state (transition old-state
(map send-message (map send-message
(handle-request soa-rr zone r)))])) (handle-request soa-rr zone r)))]))
(ground-vm (os-big-bang (void) (ground-vm (os-big-bang (void)
(spawn udp-driver) (spawn udp-driver)
(spawn (nested-vm boot-server))))) (spawn (nested-vm boot-server)))))
(define (handle-request soa-rr zone request) (define (handle-request soa-rr zone request)
(match-define (dns-request request-message request-source request-sink) request) (match-define (dns-request request-message request-source request-sink) request)