Change hash-ref -> zone-ref etc. prior to improving TTL processing
This commit is contained in:
parent
a891956867
commit
570f6fb915
|
@ -60,7 +60,7 @@
|
||||||
;; caller to decide what to do about that.
|
;; caller to decide what to do about that.
|
||||||
(define (answer-from-zone q zone start-of-authority)
|
(define (answer-from-zone q zone start-of-authority)
|
||||||
(match-define (question name qtype qclass) q)
|
(match-define (question name qtype qclass) q)
|
||||||
(define rrset (hash-ref zone name set))
|
(define rrset (or (zone-ref zone name) (set)))
|
||||||
(define filtered-rrs (filter-rrs rrset qtype qclass))
|
(define filtered-rrs (filter-rrs rrset qtype qclass))
|
||||||
(define cnames (filter-by-type rrset 'cname)) ;; TODO: filter by class too??
|
(define cnames (filter-by-type rrset 'cname)) ;; TODO: filter by class too??
|
||||||
(define answer-set (set-union cnames filtered-rrs))
|
(define answer-set (set-union cnames filtered-rrs))
|
||||||
|
@ -81,7 +81,7 @@
|
||||||
(define (closest-nameservers name zone)
|
(define (closest-nameservers name zone)
|
||||||
(let search ((name name))
|
(let search ((name name))
|
||||||
(cond
|
(cond
|
||||||
((hash-ref zone name #f) =>
|
((zone-ref zone name) =>
|
||||||
;; There's an entry for this suffix of the original name. Check
|
;; There's an entry for this suffix of the original name. Check
|
||||||
;; to see if it has an NS record indicating a subzone.
|
;; to see if it has an NS record indicating a subzone.
|
||||||
(lambda (rrset)
|
(lambda (rrset)
|
||||||
|
@ -105,7 +105,7 @@
|
||||||
(define (empty-answer q zone start-of-authority)
|
(define (empty-answer q zone start-of-authority)
|
||||||
(if (and start-of-authority ;; we are authoritative for something
|
(if (and start-of-authority ;; we are authoritative for something
|
||||||
(in-bailiwick? (question-name q) (rr-name start-of-authority)) ;; for this in particular
|
(in-bailiwick? (question-name q) (rr-name start-of-authority)) ;; for this in particular
|
||||||
(not (hash-has-key? zone (question-name q)))) ;; and there are no RRs at all for this q
|
(not (zone-includes-name? zone (question-name q)))) ;; there are no RRs at all for this q
|
||||||
;; NXDOMAIN/name-error: we definitely know there are no RRs at all for this q.
|
;; NXDOMAIN/name-error: we definitely know there are no RRs at all for this q.
|
||||||
#f
|
#f
|
||||||
;; A normal no-answers packet otherwise.
|
;; A normal no-answers packet otherwise.
|
||||||
|
@ -122,7 +122,7 @@
|
||||||
(set-union section
|
(set-union section
|
||||||
(set-filter (lambda (rr) (and (memv (rr-type rr) '(a aaaa))
|
(set-filter (lambda (rr) (and (memv (rr-type rr) '(a aaaa))
|
||||||
(eqv? (rr-class rr) 'in)))
|
(eqv? (rr-class rr) 'in)))
|
||||||
(hash-ref zone name set))))
|
(or (zone-ref zone name) (set)))))
|
||||||
(set)
|
(set)
|
||||||
names))
|
names))
|
||||||
|
|
||||||
|
|
11
zonedb.rkt
11
zonedb.rkt
|
@ -7,7 +7,9 @@
|
||||||
(require "api.rkt")
|
(require "api.rkt")
|
||||||
(require "codec.rkt")
|
(require "codec.rkt")
|
||||||
|
|
||||||
(provide incorporate-rr
|
(provide zone-ref
|
||||||
|
zone-includes-name?
|
||||||
|
incorporate-rr
|
||||||
incorporate-complete-answer
|
incorporate-complete-answer
|
||||||
empty-zone-db
|
empty-zone-db
|
||||||
compile-zone-db
|
compile-zone-db
|
||||||
|
@ -25,6 +27,13 @@
|
||||||
;; and subzone checks into prefix rather than suffix checks. It makes
|
;; and subzone checks into prefix rather than suffix checks. It makes
|
||||||
;; domain names into paths through the DNS DB tree.
|
;; domain names into paths through the DNS DB tree.
|
||||||
|
|
||||||
|
;; CompiledZone DomainName -> Maybe<Set<RR>>
|
||||||
|
(define (zone-ref db name)
|
||||||
|
(hash-ref db name #f))
|
||||||
|
|
||||||
|
(define (zone-includes-name? db name)
|
||||||
|
(hash-has-key? db name))
|
||||||
|
|
||||||
;; RR CompiledZone -> CompiledZone
|
;; RR CompiledZone -> CompiledZone
|
||||||
(define (incorporate-rr rr db)
|
(define (incorporate-rr rr db)
|
||||||
(hash-set db (rr-name rr) (set-add (hash-ref db (rr-name rr) set) rr)))
|
(hash-set db (rr-name rr) (set-add (hash-ref db (rr-name rr) set) rr)))
|
||||||
|
|
Loading…
Reference in New Issue