Switch to using the racket logger instead of the equivalent of printf.

driver.rkt

@@ -53,7 +53,8 @@
   (define (packet-handler s)
     (message-handlers old-state
       [(? bad-dns-packet? p)
-       (pretty-print p) ;; TODO: perhaps use metalevel events? perhaps don't bother though
+       (log-error (pretty-format p))
+       ;; TODO: ^ perhaps use metalevel events? perhaps don't bother though
        old-state]
       [(? dns-request? r)
        (transition old-state

network-query.rkt

@@ -134,9 +134,9 @@
 		      (f (dns-message-additional message)))]
     [(name-error) #f]
     [else
-     (begin (write `(Abnormal response-code ,(dns-message-response-code message) received
-			      in response to questions ,(dns-message-questions message)))
-	    (newline))
+     (log-info (format "Abnormal response-code ~v in response to questions ~v"
+		       (dns-message-response-code message)
+		       (dns-message-questions message)))
      'bad-answer]))
 
 ;; IPv4 -> String
@@ -216,29 +216,33 @@
   (define query (make-dns-query-message q query-id))
   (define subscription-id (list s query-id))
   (define start-time (current-inexact-milliseconds))
-  (begin (write `(Sending ,q ,query-id to ,zone-origin ,server-ip with ,timeout second timeout))
-	 (newline))
+  (log-debug (format "Sending ~v ~v to ~v ~v with ~v seconds of timeout"
+		     q query-id
+		     zone-origin server-ip
+		     timeout))
   (transition w
     (send-message (dns-request query s server-ip))
     (send-message (set-timer subscription-id (* timeout 1000) 'relative))
     (subscribe subscription-id
       (message-handlers w
 	[(timer-expired (== subscription-id) _)
-	 (begin (write `(Timed out ,q ,query-id to ,zone-origin ,server-ip after ,timeout seconds))
-		(newline))
+	 (log-debug (format "Timed out ~v ~v to ~v ~v after ~v seconds"
+			    q query-id
+			    zone-origin server-ip
+			    timeout))
 	 (extend-transition (try-next-server w)
 	   (unsubscribe subscription-id)
 	   (send-message (list 'release-query-id query-id)))]
 	[(dns-reply reply-message source (== s))
 	 ;; TODO: maybe receive only specifically from the queried IP address?
-	 (begin
-	   (write `(Answer to ,q from ,zone-origin ,server-ip in
-			   ,(inexact->exact (round (- (current-inexact-milliseconds) start-time)))
-			   ms))
-	   (newline)
-	   (write `(-- answers ,(dns-message-answers reply-message))) (newline)
-	   (write `(-- authorities ,(dns-message-authorities reply-message))) (newline)
-	   (write `(-- additional ,(dns-message-additional reply-message))) (newline))
+	 (log-debug
+	  (format
+	   "Answer to ~v from ~v ~v in ~v ms~n-- Answers: ~v~n-- Authorities: ~v~n-- Additional: ~v"
+	   q zone-origin server-ip
+	   (inexact->exact (round (- (current-inexact-milliseconds) start-time)))
+	   (dns-message-answers reply-message)
+	   (dns-message-authorities reply-message)
+	   (dns-message-additional reply-message)))
 	 (if (not (= (dns-message-id reply-message) (dns-message-id query)))
 	     w
 	     (extend-transition (on-answer w (filter-dns-reply reply-message zone-origin))

os-dns.rkt

@@ -23,7 +23,7 @@
     (subscribe 'packet-reader
       (meta-message-handlers w
 	[(udp-packet source (== s) #"")
-	 (display "Debug dump packet received\n")
+	 (log-info "Debug dump packet received")
 	 (transition w
 	   (send-message `(debug-dump)))]
 	[(udp-packet source (== s) body)
@@ -46,16 +46,17 @@
 	[(dns-request message (== s) sink) (transition w (translate message sink))]
 	[(dns-reply   message (== s) sink) (transition w (translate message sink))]))))
 
-(require racket/pretty)
 (define dns-spy
   (os-big-bang 'none
     (subscribe 'spy
       (message-handlers w
 	[(dns-request message source sink)
-	 (pretty-display `(DNS (,source asks ,sink ,(dns-message-id message))
-			       ,@(dns-message-questions message)))]
+	 (log-info (format "DNS: ~v asks ~v ~v~n   : ~v"
+			   source sink (dns-message-id message)
+			   (dns-message-questions message)))]
 	[(dns-reply message source sink)
-	 (pretty-display `(DNS (,source answers ,sink) ,message))]
+	 (log-info (format "DNS: ~v answers ~v~n   : ~v"
+			   source sink
+			   message))]
 	[x
-	 (write `(DNS ,x))
-	 (newline)]))))
+	 (log-info (format "DNS: ~v" x))]))))

proxy.rkt

@@ -17,6 +17,8 @@
 (require "../racket-matrix/os-timer.rkt")
 (require "os-dns.rkt")
 
+(require racket/pretty)
+
 ;; Instantiated with a collection of trusted roots to begin its
 ;; searches from. Performs recursive queries.
 
@@ -24,7 +26,6 @@
 (struct active-request (source id) #:transparent)
 
 ;; start-proxy : UInt16 CompiledZone CompiledZone -> Void
-(require racket/pretty)
 (define (start-proxy port-number zone roots-only)
 
   (define boot-server
@@ -46,7 +47,7 @@
     (subscribe/fresh wait-id
       (meta-message-handlers w
 	[`(reply create-client-socket ,c)
-	 (display "Ready.") (newline)
+	 (log-info "Ready.")
 	 (transition w
 	   (unsubscribe wait-id)
 	   (spawn (dns-read-driver s))
@@ -83,7 +84,8 @@
     (subscribe 'packet-dispatcher
       (message-handlers old-active-requests
 	[(? bad-dns-packet? p)
-	 (pretty-print p) ;; TODO: perhaps use metalevel events? perhaps don't bother though
+	 (log-error (pretty-format p))
+	 ;; TODO: ^ perhaps use metalevel events? perhaps don't bother though
 	 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)))
@@ -128,18 +130,17 @@
        (send-message (answer->reply #f (empty-complete-answer))))]
     [(cons original-question _)
      ;; At least one question
-     (begin (write `(Looking up ,original-question
-			     with query id ,(dns-message-id request-message)))
-	    (newline))
+     (log-debug (format "Looking up ~v with query id ~v"
+			original-question (dns-message-id request-message)))
      (os-big-bang 'no-state/packet-relay
        (send-message original-question)
        (subscribe/fresh wait-id
 	 (message-handlers w
 	   [(answered-question (== original-question) answer)
-	    (begin (write `(Final answer to ,original-question
-				  with query id ,(dns-message-id request-message)
-				  is ,answer))
-		   (newline))
+	    (log-debug (format "Final answer to ~v with query id ~v is ~v"
+			       original-question
+			       (dns-message-id request-message)
+			       answer))
 	    (transition w
 	      (unsubscribe wait-id)
 	      (send-message (answer->reply original-question answer)))])))]))
@@ -208,10 +209,10 @@
 	  (transition zone
 	    (cond
 	     [(question-cyclic? q)
-	      (begin (write `(Cyclic question ,q)) (newline))
+	      (log-warning (format "Cyclic question ~v" q))
 	      (send-message (answered-question q (empty-complete-answer)))]
 	     [(question-too-glueless? q)
-	      (begin (write `(Overly-glueless question ,q)) (newline))
+	      (log-warning (format "Overly-glueless question ~v" q))
 	      (spawn (glueless-question-handler roots-only q client-sock))]
 	     [else
 	      (spawn (question-handler zone q client-sock))]))]
@@ -235,25 +236,20 @@
   (match w
     [(question-state _ q _ _ 20) ;; TODO: is this a sensible limit?
      ;; Too many retries, i.e. too many referrals.
-     (begin (write `(Too many retries ,w))
-	    (newline))
+     (log-error (format "Too many retries: ~v" w))
      (send-empty-reply w q)]
     [(question-state zone q client-sock nameservers-tried old-retry-count)
      ;; Credit remaining. Try once more (perhaps for the first time, in fact).
      (define resolution-result (resolve-from-zone q zone #f nameservers-tried))
-     (begin (write `(Resolution result ,resolution-result))
-	    (newline))
+     (log-debug (format "Resolution result: ~v" resolution-result))
      (match resolution-result
        [#f ;; We're not authoritative so this is just a signal that we can't answer usefully
 	(send-empty-reply w q)]
        [(referral zone-origin nameserver-rrs _)
 	(define referral-id (gensym 'referral))
-	(begin
-	  (write `(Referral for ,q
-			    id ,referral-id
-			    to ,(domain-labels zone-origin)
-			    servers ,(map domain-labels (set-map nameserver-rrs rr-rdata))))
-	  (newline))
+	(log-debug (format "Referral for ~v id ~v to ~v servers ~v"
+			   q referral-id (domain-labels zone-origin)
+			   (map domain-labels (set-map nameserver-rrs rr-rdata))))
 	(transition w
 	  (spawn (network-query client-sock
 				q
@@ -266,13 +262,16 @@
 	       (transition w (send-message (answered-question q #f)))]
 	      [(network-reply (== referral-id) ans)
 	       (define-values (new-zone ignored-timers) (incorporate-complete-answer ans zone))
-	       (begin (write `(Referral ,referral-id results in origin ,zone-origin)) (newline)
-		      (for ([k (set-union (list->set (hash-keys zone))
-					  (list->set (hash-keys new-zone)))]
-			    #:when (in-bailiwick? k zone-origin))
-			(write `(old ,k ,(hash-ref zone k 'missing))) (newline)
-			(write `(new ,k ,(hash-ref new-zone k 'missing))) (newline))
-		      (write `(=-=-=-=-=-=)) (newline))
+	       (when (log-level? (current-logger) 'debug)
+		 (log-debug (format "Referral ~v results in origin ~v:~n"
+				    referral-id zone-origin))
+		 (for ([k (set-union (list->set (hash-keys zone))
+				     (list->set (hash-keys new-zone)))]
+		       #:when (in-bailiwick? k zone-origin))
+		   (log-debug (format "Old ~v ~v~nNew ~v ~v"
+				      k (hash-ref zone k 'missing)
+				      k (hash-ref new-zone k 'missing))))
+		 (log-debug "=-=-=-=-=-="))
 	       (define nameserver-names (for/set ([rr nameserver-rrs]) (rr-rdata rr)))
 	       (extend-transition
 		   (retry-question (struct-copy question-state w