marketplace-dns-2014/resolver.rkt

166 lines
6.5 KiB
Racket

#lang racket/base
;;
;;; Copyright 2010, 2011, 2012, 2013 Tony Garnock-Jones <tonyg@ccs.neu.edu>
;;;
;;; This file is part of marketplace-dns.
;;;
;;; marketplace-dns is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; marketplace-dns is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with marketplace-dns. If not, see
;;; <http://www.gnu.org/licenses/>.
(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) #:transparent)
;; A Referral is a (referral DomainName Set<RR> Set<RR>)
(struct referral (zone-origin nameserver-rrs additional) #:transparent)
;; (: answer-from-zone : Question CompiledZone (Option RR) -> Answer)
;; 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-domain-name))]))
;; (: closest-nameservers : DomainName CompiledZone -> (Setof RR))
(define (closest-nameservers name zone)
(let search ((name name))
(cond
((not name)
;; We've walked up the tree past the root. Give up.
(set))
((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)))
(else
;; Remove a label and keep looking.
(search (domain-parent name))))))
;; (: closest-untried-nameservers : Question CompiledZone (Setof DomainName) -> (Setof RR))
;; 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))
(list->set
(for/list ([rr ns-rrset] #:when (not (set-member? nameservers-tried (rr-rdata-domain-name rr))))
rr)))
;; (: empty-answer : Question CompiledZone (Option RR) -> (Option CompleteAnswer))
(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) -> (Setof 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 (rdata-type (rr-rdata rr)) '(a aaaa))
(eqv? (rr-class rr) 'in)))
(or (zone-ref zone name) (set)))))
(set)
names))
;; (: resolve-from-zone : Question CompiledZone (Option RR) (Setof DomainName) -> Answer)
(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-domain-name))))))))