From c6dc9db7153a5604817b6ed26a83303cf39fd68f Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Tue, 21 Feb 2012 12:45:36 -0500 Subject: [PATCH] Cope with excessive gluelessness. --- api.rkt | 37 +++++++++++++++++++++++++++------- proxy.rkt | 59 ++++++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 77 insertions(+), 19 deletions(-) diff --git a/api.rkt b/api.rkt index 3e4cb36..926d3cd 100644 --- a/api.rkt +++ b/api.rkt @@ -8,6 +8,8 @@ (struct-out question) question-cyclic? + question-restarted? + restart-question (struct-out answered-question) (struct-out rr) @@ -60,11 +62,15 @@ ;; is represented as (vector #x20 #x01 #x0d #xb8 #x85 #xa3 #x00 #x00 ;; #x00 #x00 #x8a #x2e #x03 #x70 #x73 #x34). -;; A Question is a (question DomainName QueryType QueryClass Maybe), -;; representing a DNS question: "What are the RRs for the given name, -;; type and class?" as well as a possible parent question that the -;; answer to this question is to contribute to the answer to. The -;; context is needed to break cycles in the DNS database. +;; A Question is a (question DomainName QueryType QueryClass (or +;; Question #f 'restart)), representing a DNS question: "What are the +;; RRs for the given name, type and class?" as well as a possible +;; parent question that the answer to this question is to contribute +;; to the answer to. The context is needed to break cycles in the DNS +;; database. If the context is 'restart, then the question results +;; from an excessively-glueless subquestion, and should *not* in turn +;; be considered for gluelessness-restarting: this is needed to avoid +;; a different kind of infinite loop. (struct question (name type class context) #:transparent) ;; An AnsweredQuestion is an (answered-question Question @@ -229,6 +235,23 @@ (match-define (question name type class parent) q) (let search ((ancestor parent)) (match ancestor - [#f #f] ;; no further parents -> definitely not cyclic [(question (== name) (== type) (== class) _) #t] ;; uh-oh! A cycle! - [(question _ _ _ ancestor-parent) (search ancestor-parent)]))) ;; recursive case + [(question _ _ _ ancestor-parent) (search ancestor-parent)] ;; recursive case + [_ #f]))) ;; no further parents -> definitely not cyclic + +;; Question -> Boolean +;; #t iff this question is being asked in the context of some +;; excessively glueless subquestion. +(define (question-restarted? q) + (match-define (question name type class parent) q) + (let search ((ancestor parent)) + (match ancestor + [(question _ _ _ ancestor-parent) (search ancestor-parent)] + ['restart #t] + [_ #f]))) + +;; Question -> Question +;; Returns a question equivalent to q, but in a 'restart context, for +;; retracing from the roots in cases of excessive gluelessness. +(define (restart-question q) + (struct-copy question q [context 'restart])) diff --git a/proxy.rkt b/proxy.rkt index 2b5a3ab..18873f2 100644 --- a/proxy.rkt +++ b/proxy.rkt @@ -23,9 +23,9 @@ ;; For discarding retransmitted requests that we're still working on. (struct active-request (source id) #:transparent) -;; start-proxy : UInt16 CompiledZone -> Void +;; start-proxy : UInt16 CompiledZone CompiledZone -> Void (require racket/pretty) -(define (start-proxy port-number zone) +(define (start-proxy port-number zone roots-only) (define boot-server (os-big-bang 'no-state/boot-server @@ -54,7 +54,7 @@ (spawn (dns-read-driver c)) (spawn (dns-write-driver c)) (spawn (packet-dispatcher s)) - (spawn (question-dispatcher zone c)))]))) + (spawn (question-dispatcher zone roots-only c)))]))) (ground-vm (os-big-bang (void) ;;(spawn udp-spy) @@ -144,15 +144,45 @@ (unsubscribe wait-id) (send-message (answer->reply original-question answer)))])))])) -(define (question-dispatcher zone0 client-sock) +(define (question-too-glueless? q) + ;; If we're looking up a nameserver's address, + ;; in order to look up a nameserver's address, + ;; in order to answer some question, + ;; that came from the outside world, then that's too glueless. + ;; See http://cr.yp.to/djbdns/notes.html in the sections + ;; "Gluelessness" and "Expiring glue". + (match q + [(question _ _ _ (question _ _ _ (question _ _ _ _))) + ;; We're (at least) at the right nesting level: now see if this + ;; question was already the result of a restart. If so, we grimly + ;; press on with it unchanged. + (not (question-restarted? q))] + [_ #f])) + +(define (glueless-question-handler roots-only-zone q client-sock) + ;; Restart q, an overly-glueless question, from the roots. + (define restarted-question (restart-question q)) + (os-big-bang 'no-state + (subscribe/fresh relay + (message-handlers w + [(answered-question (== restarted-question) ans) + ;; We got the answer to our restarted question; now transform + ;; it into an answer to the original question, to unblock the + ;; original questioner. + (transition w + (unsubscribe relay) + (send-message (answered-question q ans)))])) + (spawn (question-handler roots-only-zone restarted-question client-sock)))) + +(define (question-dispatcher seed-zone roots-only client-sock) (define (transition-and-set-timers new-zone timers) (transition new-zone (for/list ([timerspec timers]) (match-define (cons name ttl) timerspec) (send-message (set-timer (list 'check-dns-expiry name) (* ttl 1000) 'relative))))) + (define-values (cleaned-seed-zone initial-timers) (zone-expire seed-zone)) (os-big-bang/transition - (extend-transition (let-values (((expired-zone timers) (zone-expire zone0))) - (transition-and-set-timers expired-zone timers)) + (extend-transition (transition-and-set-timers cleaned-seed-zone initial-timers) ;; TODO: consider deduping questions here too? (subscribe 'question-handler-factory (message-handlers zone @@ -176,11 +206,15 @@ zone] [(? question? q) (transition zone - (if (question-cyclic? q) - (begin (begin (write `(Cyclic question ,q)) - (newline)) - (send-message (answered-question q (empty-complete-answer)))) - (spawn (question-handler zone q client-sock))))] + (cond + [(question-cyclic? q) + (begin (write `(Cyclic question ,q)) (newline)) + (send-message (answered-question q (empty-complete-answer)))] + [(question-too-glueless? q) + (begin (write `(Overly-glueless question ,q)) (newline)) + (spawn (glueless-question-handler roots-only q client-sock))] + [else + (spawn (question-handler zone q client-sock))]))] [(network-reply _ answer) (define-values (new-zone timers) (incorporate-complete-answer answer zone)) (transition-and-set-timers new-zone timers)] @@ -273,4 +307,5 @@ (start-proxy (test-port-number) (if (file-exists? "zone-proxy.zone") (bit-string->zone (file->bytes "zone-proxy.zone")) - (compile-zone-db test-roots))) + (compile-zone-db test-roots)) + (compile-zone-db test-roots))