138 lines
5.3 KiB
Racket
138 lines
5.3 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/pretty)
|
|
|
|
(require racket/set)
|
|
(require racket/match)
|
|
(require racket/list)
|
|
(require "api.rkt")
|
|
(require "codec.rkt")
|
|
(require "zonedb.rkt")
|
|
|
|
(provide (struct-out partial-answer)
|
|
(struct-out referral)
|
|
|
|
resolve-from-zone)
|
|
|
|
;; Rules:
|
|
;;
|
|
;; - If the DB already has an answer, return it.
|
|
;;
|
|
;; - Otherwise, find the leafmost NS record in the DB for the
|
|
;; requested name.
|
|
;;
|
|
;; - Query that service. Augment the DB with the answers received, if
|
|
;; any. Loop back to the beginning, remembering that we've tried
|
|
;; the specific service we just interacted with so we don't try it
|
|
;; again.
|
|
;;
|
|
;; - Eventually, the DB will have either been augmented with an
|
|
;; answer, or we will have run out of untried nameservers to ask.
|
|
;;
|
|
;; - Authoritative NXDOMAINs ('name-error) mean we get to stop
|
|
;; looking.
|
|
;;
|
|
;; - Resolve CNAMEs on the way. Remember which names we've been
|
|
;; resolving in response to any given query, to avoid
|
|
;; loops. Perhaps limit the length of the chain to avoid
|
|
;; DoS. (TODO)
|
|
;;
|
|
;; - Only performs recursive service if so requested.
|
|
;;
|
|
;; - See RFC 1035 section 7.1.
|
|
|
|
;; An Answer is one of
|
|
;; -- a PartialAnswer (some CNAMEs need expanding),
|
|
;; -- a CompleteAnswer (a complete answer ready to send),
|
|
;; -- #f (the domain name does not exist in the CompiledZone given),
|
|
;; -- a Referral (a referral to some other nameserver).
|
|
|
|
;; A PartialAnswer is a (partial-answer CompleteAnswer ListOf<DomainName>)
|
|
;; A collection of relevant RRs together with some CNAMEs that need expanding.
|
|
(struct partial-answer (base cnames) #:prefab)
|
|
|
|
;; A Referral is a (referral DomainName Set<RR> Set<RR>)
|
|
(struct referral (zone-origin nameserver-rrs additional) #:prefab)
|
|
|
|
;; An answer of #f here does NOT indicate a missing domain-name
|
|
;; (name-error/NXDOMAIN), but instead indicates that there are no
|
|
;; records matching the query in the database given. It's up to the
|
|
;; caller to decide what to do about that.
|
|
(define (answer-from-zone q zone start-of-authority)
|
|
(match-define (question name qtype qclass _) q)
|
|
(define rrset (or (zone-ref zone name) (set)))
|
|
(define filtered-rrs (filter-rrs rrset qtype qclass))
|
|
(define cnames (filter-by-type rrset 'cname)) ;; TODO: filter by class too??
|
|
(define answer-set (set-union cnames filtered-rrs))
|
|
(define base (complete-answer answer-set
|
|
(if (and start-of-authority
|
|
(in-bailiwick? name (rr-name start-of-authority)))
|
|
(set start-of-authority)
|
|
(set))
|
|
(set)))
|
|
(cond
|
|
[(set-empty? answer-set) ;; No matching records or domain absent (deliberately ambiguous)
|
|
#f]
|
|
[(or (eq? qtype 'cname) (set-empty? cnames)) ;; Either asking for CNAMEs, or no CNAMEs to expand
|
|
base]
|
|
[else ;; Kick off the algorithm for CNAME expansion from RFC 1034 4.3.2 step 3a
|
|
(partial-answer base (set-map cnames rr-rdata))]))
|
|
|
|
(define (closest-nameservers name zone)
|
|
(let search ((name name))
|
|
(cond
|
|
((zone-ref zone name) =>
|
|
;; There's an entry for this suffix of the original name. Check
|
|
;; to see if it has an NS record indicating a subzone.
|
|
(lambda (rrset)
|
|
(define ns-rrset (filter-by-type rrset 'ns))
|
|
(if (set-empty? ns-rrset)
|
|
(search (domain-parent name)) ;; no NS records for this suffix. Keep looking.
|
|
ns-rrset)))
|
|
((domain-root? name)
|
|
;; The root, and we don't have an RRSet for it. Give up.
|
|
(set))
|
|
(else
|
|
;; Remove a label and keep looking.
|
|
(search (domain-parent name))))))
|
|
|
|
;; Returns a set of NS RRs in an arbitrary order.
|
|
(define (closest-untried-nameservers q zone nameservers-tried)
|
|
(define name (question-name q))
|
|
(define ns-rrset (closest-nameservers name zone))
|
|
(for/set ([rr ns-rrset] #:when (not (set-member? nameservers-tried (rr-rdata rr)))) rr))
|
|
|
|
(define (empty-answer q zone start-of-authority)
|
|
(if (and start-of-authority ;; we are authoritative for something
|
|
(in-bailiwick? (question-name q) (rr-name start-of-authority)) ;; for this in particular
|
|
(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.
|
|
#f
|
|
;; A normal no-answers packet otherwise.
|
|
(empty-complete-answer)))
|
|
|
|
;; additional-section/a : CompiledZone ListOf<DomainName> -> Set<RR>
|
|
;; Implements the "additional section" rules from RFC 1035 (and the
|
|
;; rules for IPv6 from RFC 3596). Provides A and AAAA records for
|
|
;; names mentioned in the "names" list that have entries in "zone".
|
|
(define (additional-section/a zone names)
|
|
;; RFC 3596 (section 3) requires that we process AAAA here as well
|
|
;; as A.
|
|
(foldl (lambda (name section)
|
|
(set-union section
|
|
(set-filter (lambda (rr) (and (memv (rr-type rr) '(a aaaa))
|
|
(eqv? (rr-class rr) 'in)))
|
|
(or (zone-ref zone name) (set)))))
|
|
(set)
|
|
names))
|
|
|
|
(define (resolve-from-zone q zone start-of-authority nameservers-tried)
|
|
(or (answer-from-zone q zone start-of-authority)
|
|
(let ((best-nameservers (closest-untried-nameservers q zone nameservers-tried)))
|
|
(if (set-empty? best-nameservers)
|
|
(empty-answer q zone start-of-authority)
|
|
(let ((zone-origin (rr-name (car (set->list best-nameservers))))) ;; any entry will do
|
|
(referral zone-origin
|
|
best-nameservers
|
|
(additional-section/a zone (set-map best-nameservers rr-rdata))))))))
|