Age and expire cached RRs properly
This commit is contained in:
parent
570f6fb915
commit
969bc2646e
|
@ -7,7 +7,9 @@
|
|||
(struct-out dns-message)
|
||||
|
||||
packet->dns-message
|
||||
dns-message->packet)
|
||||
dns-message->packet
|
||||
|
||||
max-ttl)
|
||||
|
||||
(require "api.rkt")
|
||||
(require "mapping.rkt")
|
||||
|
@ -464,3 +466,6 @@
|
|||
((srv-port rdata) :: bits 16)
|
||||
((srv-target rdata) :: (t:domain-name))))
|
||||
(else rdata)))
|
||||
|
||||
;; UInt32
|
||||
(define max-ttl #xffffffff)
|
||||
|
|
15
proxy.rkt
15
proxy.rkt
|
@ -142,20 +142,20 @@
|
|||
(send-message (answer->reply original-question answer)))])))]))
|
||||
|
||||
(define (question-dispatcher zone0 client-sock)
|
||||
(define cache-clear-interval (* 60 1000))
|
||||
(os-big-bang zone0
|
||||
;; TODO: consider deduping questions here too?
|
||||
(send-message (set-timer 'clear-dns-cache cache-clear-interval #t))
|
||||
(subscribe 'question-handler-factory
|
||||
(message-handlers zone
|
||||
[(? question? q)
|
||||
(transition zone
|
||||
(spawn (question-handler zone q client-sock)))]
|
||||
[(network-reply _ answer)
|
||||
(incorporate-complete-answer answer zone)]
|
||||
[(timer-expired 'clear-dns-cache _)
|
||||
(transition zone0
|
||||
(send-message (set-timer 'clear-dns-cache cache-clear-interval #t)))]))))
|
||||
(define-values (new-zone timers) (incorporate-complete-answer answer zone))
|
||||
(transition new-zone
|
||||
(for/list ([(name ttl) timers])
|
||||
(send-message (set-timer (list 'check-dns-expiry name) (* ttl 1000) #t))))]
|
||||
[(timer-expired (list 'check-dns-expiry name) _)
|
||||
(zone-expire-name zone name)]))))
|
||||
|
||||
(struct question-state (zone q client-sock nameservers-tried retry-count) #:transparent)
|
||||
(struct expanding-cnames (q accumulator remaining-count) #:transparent)
|
||||
|
@ -190,11 +190,12 @@
|
|||
[(network-reply (== referral-id) #f) ;; name-error/NXDOMAIN
|
||||
(transition w (send-message (answered-question q #f)))]
|
||||
[(network-reply (== referral-id) ans)
|
||||
(define-values (new-zone ignored-timers) (incorporate-complete-answer ans zone))
|
||||
(extend-transition
|
||||
(retry-question (struct-copy question-state w
|
||||
[nameservers-tried (set-union nameservers-tried
|
||||
nameserver-rrs)]
|
||||
[zone (incorporate-complete-answer ans zone)]
|
||||
[zone new-zone]
|
||||
[retry-count (+ old-retry-count 1)]))
|
||||
(unsubscribe referral-id))])))]
|
||||
[(? complete-answer? ans)
|
||||
|
|
79
zonedb.rkt
79
zonedb.rkt
|
@ -9,8 +9,8 @@
|
|||
|
||||
(provide zone-ref
|
||||
zone-includes-name?
|
||||
incorporate-rr
|
||||
incorporate-complete-answer
|
||||
zone-expire-name
|
||||
empty-zone-db
|
||||
compile-zone-db
|
||||
compiled-zone?
|
||||
|
@ -20,31 +20,84 @@
|
|||
filter-rrs
|
||||
rr-set->list)
|
||||
|
||||
;; A CompiledZone is a Hash<DomainName,SetOf<RR>>, representing a
|
||||
;; collection of DNS RRSets indexed by DomainName.
|
||||
;; An InfiniteLifetime is an (infinite-lifetime RelativeSeconds), a
|
||||
;; specification of the TTL to use when sending a non-expiring RR to a
|
||||
;; peer.
|
||||
(struct infinite-lifetime (ttl) #:transparent)
|
||||
|
||||
;; A CompiledZone is a Hash<DomainName,Hash<RR,(or AbsoluteSeconds
|
||||
;; InfiniteLifetime)>>, representing a collection of DNS RRSets
|
||||
;; indexed by DomainName. Each RR in an RRSet either has an expiry
|
||||
;; time associated with it or has an InfiniteLifetime associated with
|
||||
;; it, in which case it should not expire.
|
||||
|
||||
;; TODO: maybe store domain names big-end first? It'd make bailiwick
|
||||
;; and subzone checks into prefix rather than suffix checks. It makes
|
||||
;; domain names into paths through the DNS DB tree.
|
||||
|
||||
(define (current-inexact-seconds)
|
||||
(/ (current-inexact-milliseconds) 1000.0))
|
||||
|
||||
(define (still-valid? expiry now)
|
||||
(or (infinite-lifetime? expiry)
|
||||
(>= expiry now)))
|
||||
|
||||
;; CompiledZone DomainName -> Maybe<Set<RR>>
|
||||
(define (zone-ref db name)
|
||||
(hash-ref db name #f))
|
||||
(cond
|
||||
[(hash-ref db name #f) =>
|
||||
(lambda (expirymap)
|
||||
(define now (current-inexact-seconds))
|
||||
(for/set ([(resource expiry) expirymap] #:when (still-valid? expiry now))
|
||||
(struct-copy rr resource [ttl (if (infinite-lifetime? expiry)
|
||||
(infinite-lifetime-ttl expiry)
|
||||
(inexact->exact (floor (- expiry now))))])))]
|
||||
[else #f]))
|
||||
|
||||
(define (zone-includes-name? db name)
|
||||
(hash-has-key? db name))
|
||||
|
||||
;; RR CompiledZone -> CompiledZone
|
||||
(define (incorporate-rr rr db)
|
||||
(hash-set db (rr-name rr) (set-add (hash-ref db (rr-name rr) set) rr)))
|
||||
;; incorporate-rr : Maybe<AbsoluteSeconds> -> (RR CompiledZone -> CompiledZone)
|
||||
;;
|
||||
;; Incorporates the given RR into our database. If base-time is a
|
||||
;; number of seconds, we treat the RR as having a TTL that decreases
|
||||
;; as time goes by; otherwise base-time is #f, and we treat the RR as
|
||||
;; being non-expiring with an InfiniteLifetime.
|
||||
(define ((incorporate-rr base-time) resource0 db)
|
||||
(define expiry (if base-time
|
||||
(+ base-time (rr-ttl resource0))
|
||||
(infinite-lifetime (rr-ttl resource0))))
|
||||
(define resource (struct-copy rr resource0 [ttl 0]))
|
||||
(hash-set db (rr-name resource)
|
||||
(hash-set (hash-ref db (rr-name resource) hash) resource expiry)))
|
||||
|
||||
;; Maybe<CompleteAnswer> CompiledZone -> CompiledZone
|
||||
;; Maybe<CompleteAnswer> CompiledZone -> (values CompiledZone Hash<Name,AbsoluteSeconds>)
|
||||
(define (incorporate-complete-answer ans db)
|
||||
(match ans
|
||||
[#f db]
|
||||
[(complete-answer ns us ds) (foldl incorporate-rr db (append (set->list ns)
|
||||
(set->list us)
|
||||
(set->list ds)))]))
|
||||
[#f
|
||||
(values db (hash))]
|
||||
[(complete-answer ns us ds)
|
||||
(define now (current-inexact-seconds))
|
||||
(for/fold ([db db] [timers (hash)])
|
||||
([rr (in-sequences ns us ds)])
|
||||
(values ((incorporate-rr now) rr db)
|
||||
(hash-update timers (rr-name rr)
|
||||
(lambda (old-ttl) (min old-ttl (rr-ttl rr)))
|
||||
max-ttl)))]))
|
||||
|
||||
;; CompiledZone DomainName -> CompiledZone
|
||||
;; Checks the given name to see if there are any expiring records, and
|
||||
;; if so, removes them.
|
||||
(define (zone-expire-name db name)
|
||||
(define now (current-inexact-seconds))
|
||||
(define new-expirymap
|
||||
(if (zone-includes-name? db name)
|
||||
(for/hash ([(resource expiry) (hash-ref db name)] #:when (still-valid? expiry now))
|
||||
(values resource expiry))
|
||||
(hash)))
|
||||
(if (zero? (hash-count new-expirymap))
|
||||
(hash-remove db name)
|
||||
(hash-set db name new-expirymap)))
|
||||
|
||||
;; empty-zone-db : -> CompiledZone
|
||||
(define (empty-zone-db)
|
||||
|
@ -54,7 +107,7 @@
|
|||
;; Builds an immutable hash table from the given RRs, suitable for
|
||||
;; quickly looking up answers to queries.
|
||||
(define (compile-zone-db rrs)
|
||||
(foldl incorporate-rr (make-immutable-hash) rrs))
|
||||
(foldl (incorporate-rr #f) (empty-zone-db) rrs))
|
||||
|
||||
(define (compiled-zone? z)
|
||||
(hash? z)) ;; hm
|
||||
|
|
Loading…
Reference in New Issue