172 lines
5.5 KiB
Racket
172 lines
5.5 KiB
Racket
#lang racket/base
|
|
;; Definitions for use in the API to the functionality of the library.
|
|
|
|
(provide (struct-out question)
|
|
(struct-out answered-question)
|
|
(struct-out rr)
|
|
|
|
(struct-out complete-answer)
|
|
empty-complete-answer
|
|
merge-answers
|
|
extract-addresses
|
|
|
|
(struct-out hinfo)
|
|
(struct-out minfo)
|
|
(struct-out mx)
|
|
(struct-out soa)
|
|
(struct-out wks)
|
|
(struct-out srv)
|
|
|
|
type->value value->type
|
|
qtype->value value->qtype
|
|
class->value value->class
|
|
qclass->value value->qclass)
|
|
|
|
(require "mapping.rkt")
|
|
(require racket/set)
|
|
(require racket/match)
|
|
|
|
;; A DomainName is a ListOf<Bytes>, representing a domain name. The
|
|
;; head of the list is the leftmost label; for example, www.google.com
|
|
;; is represented as '(#"www" #"google" #"com").
|
|
|
|
;; A ShortString is a String with length 255 or shorter.
|
|
|
|
;; An IPv4 is a (vector Byte Byte Byte Byte), representing an IPv4
|
|
;; address. For example, 127.0.0.1 is represented as (vector 127 0 0
|
|
;; 1).
|
|
|
|
;; An IPv6 is a Vector of length 16 containing Bytes, representing an
|
|
;; IPv6 address. For example, 2001:0db8:85a3:0000:0000:8a2e:0370:7334
|
|
;; 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),
|
|
;; representing a DNS question: "What are the RRs for the given name,
|
|
;; type and class?"
|
|
(struct question (name type class) #:transparent)
|
|
|
|
;; An AnsweredQuestion is an (answered-question Question
|
|
;; CompleteAnswer).
|
|
(struct answered-question (q a) #:transparent)
|
|
|
|
;; A CompleteAnswer is a (complete-answer Set<RR> Set<RR> Set<RR>)
|
|
(struct complete-answer (rrs authorities additional) #:transparent)
|
|
|
|
;; An RR is a (rr DomainName RRType RRClass Uint32 RData),
|
|
;; representing a resource record.
|
|
(struct rr (name type class ttl rdata) #:transparent)
|
|
|
|
;; An RData is one of
|
|
;; - a DomainName, for CNAME, MB, MD, MF, MG, MR, NS and PTR records
|
|
;; - an IPv4, an "A" record
|
|
;; - an IPv6, an "AAAA" record
|
|
;; - (hinfo ShortString ShortString), a host information record [O]
|
|
;; - (minfo DomainName DomainName), a mailbox information record [O]
|
|
;; - (mx Uint16 DomainName), a mail exchanger record
|
|
;; - (soa DomainName DomainName Uint32 Uint32 Uint32 Uint32 Uint32), a
|
|
;; start-of-authority record
|
|
;; - (wks IPv4 Byte Bytes), a Well-Known Service [O]
|
|
;; - (srv Uint16 Uint16 Uint16 DomainName), an "SRV" record
|
|
;; - a Bytes, either a 'null type RR or any unrecognised RR type.
|
|
;;
|
|
;; In each case, the RData's variant MUST line up correctly with the
|
|
;; type field of any RR containing it.
|
|
;;
|
|
;; Many of these variants are obsolete in today's DNS database (marked
|
|
;; [O] above).
|
|
(struct hinfo (cpu os) #:transparent)
|
|
(struct minfo (rmailbx emailbx) #:transparent)
|
|
(struct mx (preference exchange) #:transparent)
|
|
(struct soa (mname rname serial refresh retry expire minimum) #:transparent)
|
|
(struct wks (address protocol bitmap) #:transparent)
|
|
(struct srv (priority weight port target) #:transparent)
|
|
|
|
;; An RRType is a Symbol or a Number, one of the possibilities given
|
|
;; in the following define-mapping. It represents the type of an
|
|
;; RR. When used in an RR with an RData, the RRType and the RData
|
|
;; variant must correspond.
|
|
(define-mapping type->value value->type
|
|
#:forward-default values
|
|
#:backward-default values
|
|
(a 1)
|
|
(ns 2)
|
|
(md 3)
|
|
(mf 4)
|
|
(cname 5)
|
|
(soa 6)
|
|
(mb 7)
|
|
(mg 8)
|
|
(mr 9)
|
|
(null 10)
|
|
(wks 11)
|
|
(ptr 12)
|
|
(hinfo 13)
|
|
(minfo 14)
|
|
(mx 15)
|
|
(txt 16)
|
|
(aaaa 28)
|
|
(srv 33))
|
|
|
|
;; A QueryType is a Symbol or Number (as given in the following
|
|
;; define-mapping) or an RRType. It specifies the kinds of records
|
|
;; being sought after in a DNS query.
|
|
(define-mapping qtype->value value->qtype
|
|
#:forward-default type->value
|
|
#:backward-default value->type
|
|
(axfr 252)
|
|
(mailb 253)
|
|
(maila 254)
|
|
(* 255))
|
|
|
|
;; An RRClass is a Symbol or a Number, one of the possibilities given
|
|
;; in the following define-mapping. It represents the "class" of DNS
|
|
;; records being discussed. All classes except 'in are obsolete in
|
|
;; today's DNS databases.
|
|
(define-mapping class->value value->class
|
|
#:forward-default values
|
|
#:backward-default values
|
|
(in 1)
|
|
(cs 2)
|
|
(ch 3)
|
|
(hs 4))
|
|
|
|
;; A QueryClass is a Symbol or Number (as given in the following
|
|
;; define-mapping) or an RRClass. It specifies the "class" of records
|
|
;; being sought after in a DNS query.
|
|
(define-mapping qclass->value value->qclass
|
|
#:forward-default class->value
|
|
#:backward-default value->class
|
|
(* 255))
|
|
|
|
;; -> CompleteAnswer
|
|
(define (empty-complete-answer)
|
|
(complete-answer (set) (set) (set)))
|
|
|
|
;; CompleteAnswer CompleteAnswer -> CompleteAnswer
|
|
(define (merge-answers a1 a2)
|
|
(match-define (complete-answer n1 u1 d1) a1)
|
|
(match-define (complete-answer n2 u2 d2) a2)
|
|
(complete-answer (set-union n1 n2)
|
|
(set-union u1 u2)
|
|
(set-union d1 d2)))
|
|
|
|
;; DomainName CompleteAnswer -> ListOf<IPv4>
|
|
(define (extract-addresses name ans)
|
|
(match-define (complete-answer ns us ds) ans)
|
|
(define rrs (set->list (set-union ns us ds)))
|
|
(let loop ((names (list name))
|
|
(ips (set))
|
|
(seen (set)))
|
|
(if (null? names)
|
|
ips
|
|
(let* ((name (car names))
|
|
(records (filter (lambda (rr) (equal? name (rr-name rr))) rrs)))
|
|
(if (set-member? seen name)
|
|
(loop (cdr names) ips seen)
|
|
(let ((a-records (filter (lambda (rr) (equal? 'a (rr-type rr))) records))
|
|
(cname-records (filter (lambda (rr) (equal? 'cname (rr-type rr))) records)))
|
|
(loop (append (map rr-rdata cname-records) (cdr names))
|
|
(set-union ips (list->set (map rr-rdata a-records)))
|
|
(set-add seen name))))))))
|