From 345965e4734564f62bed13630603c145cde256a6 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 23 Jul 2012 17:21:31 -0400 Subject: [PATCH] Make handlers etc *required* to return a transition structure. --- network-query.rkt | 2 +- os2-dns.rkt | 28 ++++++++++++---------------- proxy.rkt | 10 +++++----- 3 files changed, 18 insertions(+), 22 deletions(-) diff --git a/network-query.rkt b/network-query.rkt index 216157a..c3c99b2 100644 --- a/network-query.rkt +++ b/network-query.rkt @@ -333,7 +333,7 @@ (dns-message-authorities reply-message) (dns-message-additional reply-message))) (if (not (= (dns-message-id reply-message) (dns-message-id query))) - w + (transition w) (sequence-actions (on-answer w (filter-dns-reply q reply-message zone-origin) server-ip) diff --git a/os2-dns.rkt b/os2-dns.rkt index ab748b6..a92a204 100644 --- a/os2-dns.rkt +++ b/os2-dns.rkt @@ -22,18 +22,16 @@ (transition 'no-state (at-meta-level (role (topic-subscriber (udp-packet (wild) s (wild))) - #:state w [(udp-packet source (== s) #"") (log-info "Debug dump packet received") - (transition w (send-message `(debug-dump)))] + (send-message `(debug-dump))] [(udp-packet source (== s) body) - (transition w - (send-message - (with-handlers ((exn:fail? (lambda (e) (bad-dns-packet body source s 'unparseable)))) - (define message (packet->dns-message body)) - (case (dns-message-direction message) - ((request) (dns-request message source s)) - ((response) (dns-reply message source s))))))])))) + (send-message + (with-handlers ((exn:fail? (lambda (e) (bad-dns-packet body source s 'unparseable)))) + (define message (packet->dns-message body)) + (case (dns-message-direction message) + ((request) (dns-request message source s)) + ((response) (dns-reply message source s)))))])))) (define (dns-write-driver s) (define (translate message sink) @@ -44,24 +42,22 @@ (transition 'no-state (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))]))) + [(dns-request message (== s) sink) (translate message sink)] + [(dns-reply message (== s) sink) (translate message sink)]))) (define dns-spy (transition 'none (role (topic-subscriber (wild) #:monitor? #t) - #:state w [(dns-request message source sink) (log-info (format "DNS: ~v asks ~v ~v~n : ~v" source sink (dns-message-id message) (dns-message-questions message))) - w] + (void)] [(dns-reply message source sink) (log-info (format "DNS: ~v answers ~v~n : ~v" source sink message)) - w] + (void)] [x (log-info (format "DNS: ~v" x)) - w]))) + (void)]))) diff --git a/proxy.rkt b/proxy.rkt index 73658c6..844df25 100644 --- a/proxy.rkt +++ b/proxy.rkt @@ -75,7 +75,7 @@ [p (log-error (pretty-format p)) ;; TODO: ^ perhaps use metalevel events? perhaps don't bother though - old-active-requests]) + (transition old-active-requests)]) (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 @@ -83,14 +83,14 @@ ;; 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 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 (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))) - (set-remove old-active-requests req-id)]))) + (transition (set-remove old-active-requests req-id))]))) (define (packet-relay req-id request) (match-define (dns-request request-message request-source request-sink) request) @@ -190,7 +190,7 @@ (pretty-write current-ground-transition)) #:mode 'text #:exists 'append) - zone]) + (transition zone)]) (role (topic-subscriber (question (wild) (wild) (wild) (wild))) #:state zone [(? question? q) @@ -214,7 +214,7 @@ (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))]))) + (transition (zone-expire-name zone name (/ now-msec 1000.0)))]))) (struct question-state (zone q client-sock nameservers-tried retry-count) #:prefab) (struct expanding-cnames (q accumulator remaining-count) #:prefab)