From 6226ed01d5cb9347eb79e68559805a366890c939 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 21 Feb 2012 15:31:33 -0500 Subject: [PATCH] Switch to using the racket logger instead of the equivalent of printf. --- driver.rkt | 3 ++- network-query.rkt | 34 +++++++++++++++------------- os-dns.rkt | 15 +++++++------ proxy.rkt | 57 +++++++++++++++++++++++------------------------ 4 files changed, 57 insertions(+), 52 deletions(-) diff --git a/driver.rkt b/driver.rkt index d9f5f52..27498e7 100644 --- a/driver.rkt +++ b/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 diff --git a/network-query.rkt b/network-query.rkt index c7244b4..514d891 100644 --- a/network-query.rkt +++ b/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)) diff --git a/os-dns.rkt b/os-dns.rkt index e190c9a..522748b 100644 --- a/os-dns.rkt +++ b/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))])))) diff --git a/proxy.rkt b/proxy.rkt index 18873f2..278abb0 100644 --- a/proxy.rkt +++ b/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