From 7653cf545ae90e8b3779ffcfbae5ea71bb86b563 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Wed, 20 Mar 2013 11:01:03 -0400
Subject: [PATCH] WIP toward TR proxy

---
 proxy.rkt | 63 ++++++++++++++++++++++++++++---------------------------
 1 file changed, 32 insertions(+), 31 deletions(-)

diff --git a/proxy.rkt b/proxy.rkt
index 6be200e..6db1221 100644
--- a/proxy.rkt
+++ b/proxy.rkt
@@ -37,16 +37,16 @@
    (udp-driver)
    (timer-driver)
    (nested-vm #:debug-name 'dns-vm
-	      (dns-spy)
-	       (timer-relay 'timer-relay:dns)
-	       (spawn #:debug-name 'query-id-allocator #:child (query-id-allocator))
-	       (spawn #:debug-name 'server-dns-reader #:child (dns-read-driver server-addr))
-	       (spawn #:debug-name 'server-dns-writer #:child (dns-write-driver server-addr))
-	       (spawn #:debug-name 'client-dns-reader #:child (dns-read-driver client-addr))
-	       (spawn #:debug-name 'client-dns-writer #:child (dns-write-driver client-addr))
-	       (spawn #:debug-name 'packet-dispatcher #:child (packet-dispatcher server-addr))
-	       (spawn #:debug-name 'question-dispatcher
-		      #:child (question-dispatcher zone roots-only client-addr)))))
+	      (spawn #:debug-name 'dns-spy #:child (dns-spy))
+	      (timer-relay 'timer-relay:dns)
+	      (spawn #:debug-name 'query-id-allocator #:child (query-id-allocator))
+	      (spawn #:debug-name 'server-dns-reader #:child (dns-read-driver server-addr))
+	      (spawn #:debug-name 'server-dns-writer #:child (dns-write-driver server-addr))
+	      (spawn #:debug-name 'client-dns-reader #:child (dns-read-driver client-addr))
+	      (spawn #:debug-name 'client-dns-writer #:child (dns-write-driver client-addr))
+	      (spawn #:debug-name 'packet-dispatcher #:child (packet-dispatcher server-addr))
+	      (spawn #:debug-name 'question-dispatcher
+		     #:child (question-dispatcher zone roots-only client-addr)))))
 
 (define (query-id-allocator)
   ;; TODO: track how many are allocated and throttle requests if too
@@ -68,11 +68,11 @@
 
 (define (packet-dispatcher s)
   (transition (set) ;; SetOf<ActiveRequest>
-    (endpoint #:subscriber (bad-dns-packet (wild) (wild) (wild) (wild))
+    (endpoint #:subscriber (bad-dns-packet-repr (wild) (wild) (wild) (wild))
 	      [p (begin (log-error (pretty-format p)) '())])
-    (endpoint #:subscriber (dns-request (wild) (wild) s)
+    (endpoint #:subscriber (dns-request-repr (wild) (wild) s)
 	      #:state old-active-requests
-     [(and r (dns-request m source (== s))) ;; We only listen for requests on our server socket
+     [(and r (dns-request-repr m source (== s))) ;; We only listen for requests on our server socket
       (let ((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.
@@ -81,14 +81,14 @@
 	    (transition (set-add old-active-requests req-id)
 	      (spawn #:debug-name (list 'packet-relay req-id)
 		     #:child (packet-relay req-id r)))))])
-    (endpoint #:subscriber (dns-reply (wild) s (wild))
+    (endpoint #:subscriber (dns-reply-repr (wild) s (wild))
 	      #:state old-active-requests
-     [(and r (dns-reply m (== s) sink))
+     [(and r (dns-reply-repr m (== s) sink))
       (let ((req-id (active-request sink (dns-message-id m))))
 	(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)
+  (match-define (dns-request-repr request-message request-source request-sink) request)
   (define (answer->reply q a)
     (define-values (response-code ns us ds)
       (match a
@@ -96,20 +96,21 @@
 	 (values 'name-error '() '() '())]
 	[(complete-answer ns us ds)
 	 (values 'no-error (rr-set->list ns) (rr-set->list us) (rr-set->list ds))]))
-    (dns-reply (dns-message (dns-message-id request-message)
-			    'response
-			    'query
-			    'non-authoritative
-			    'not-truncated
-			    (dns-message-recursion-desired request-message)
-			    'recursion-available
-			    response-code
-			    (if q (list q) '())
-			    ns
-			    us
-			    ds)
-	       request-sink
-	       request-source))
+    (dns-reply-repr
+     (dns-message (dns-message-id request-message)
+		  'response
+		  'query
+		  'non-authoritative
+		  'not-truncated
+		  (dns-message-recursion-desired request-message)
+		  'recursion-available
+		  response-code
+		  (if q (list q) '())
+		  ns
+		  us
+		  ds)
+     request-sink
+     request-source))
   ;; TODO: pay attention to recursion-desired flag
   (match (dns-message-questions request-message)
     ['()
@@ -189,7 +190,7 @@
 	;;   #:mode 'text
 	;;   #:exists 'append)
 	'())])
-    (endpoint #:subscriber (question (wild) (wild) (wild) (wild))
+    (endpoint #:subscriber (question-repr (wild) (wild) (wild) (wild))
 	      #:state zone
      [(? question? q)
       (transition zone