Codec from prototype, refactored slightly
This commit is contained in:
Tony Garnock-Jones
parent
b98813c086
commit
70773faf33
|
|
@ -0,0 +1,2 @@
|
|||
Make RData and RRType the same thing so it becomes impossible to make
|
||||
a mistake.
|
||||
|
|
@ -0,0 +1,127 @@
|
|||
#lang racket/base
|
||||
;; Definitions for use in the API to the functionality of the library.
|
||||
|
||||
(provide (struct-out question)
|
||||
(struct-out rr)
|
||||
|
||||
(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")
|
||||
|
||||
;; A QueryResponder is a (Question -> Either<ListOf<RR>, Failure>), a
|
||||
;; function from DNS query to DNS response or failure.
|
||||
|
||||
;; 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 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
|
||||
;; - 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))
|
||||
|
|
@ -0,0 +1,462 @@
|
|||
#lang racket/base
|
||||
;; DNS wire-protocol codec.
|
||||
|
||||
(provide value->query-opcode query-opcode->value
|
||||
value->query-response-code query-response-code->value
|
||||
|
||||
(struct-out dns-message)
|
||||
|
||||
packet->dns-message
|
||||
dns-message->packet)
|
||||
|
||||
(require "api.rkt")
|
||||
(require "mapping.rkt")
|
||||
|
||||
(require racket/match)
|
||||
(require (planet tonyg/bitsyntax))
|
||||
|
||||
;; An Opcode is a Symbol or a Number, one of the possibilities given
|
||||
;; in the following define-mapping. It represents a DNS message
|
||||
;; operation; see the RFC for details.
|
||||
(define-mapping value->query-opcode query-opcode->value
|
||||
#:forward-default values
|
||||
#:backward-default values
|
||||
(0 query)
|
||||
(1 iquery)
|
||||
(2 status))
|
||||
|
||||
;; A ResponseCode is a Symbol or a Number, one of the possibilities
|
||||
;; given in the following define-mapping. It represents the outcome of
|
||||
;; a DNS query.
|
||||
(define-mapping value->query-response-code query-response-code->value
|
||||
(0 no-error)
|
||||
(1 format-error)
|
||||
(2 server-failure)
|
||||
(3 name-error)
|
||||
(4 not-implemented)
|
||||
(5 refused))
|
||||
|
||||
;; A DNSMessage is a
|
||||
;; (dns-message Uint16 Direction Opcode Authoritativeness
|
||||
;; Truncatedness RecursionDesired RecursionAvailable ResponseCode
|
||||
;; ListOf<Question> ListOf<RR> ListOf<RR> ListOf<RR>).
|
||||
;;
|
||||
;; Interpreted as either a DNS request or reply, depending on the
|
||||
;; Direction.
|
||||
(struct dns-message (id
|
||||
direction
|
||||
opcode
|
||||
authoritative
|
||||
truncated
|
||||
recursion-desired
|
||||
recursion-available
|
||||
response-code
|
||||
questions
|
||||
answers
|
||||
authorities
|
||||
additional)
|
||||
#:transparent)
|
||||
|
||||
;; Bit-syntax type for counted repeats of a value.
|
||||
;; Example: Length-prefixed list of 32-bit unsigned words:
|
||||
;; (bit-string-case input ([ len (vals :: (t:ntimes len bits 32)) ] vals))
|
||||
;; (bit-string (vals :: (t:ntimes bits 32)))
|
||||
(define-syntax t:ntimes
|
||||
(syntax-rules ()
|
||||
((_ #t times-to-repeat option ...)
|
||||
(lambda (input ks kf)
|
||||
(let loop ((count times-to-repeat)
|
||||
(acc '())
|
||||
(input input))
|
||||
(cond
|
||||
((positive? count) (bit-string-case input
|
||||
([ (v :: option ...) (rest :: binary) ]
|
||||
(loop (- count 1) (cons v acc) rest))
|
||||
(else (kf))))
|
||||
(else (ks (reverse acc) input))))))
|
||||
((_ #f option ...)
|
||||
(t:listof #f option ...))))
|
||||
|
||||
;; Bit-syntax type for repeats of a value until no more input available.
|
||||
;; Example: List of 32-bit unsigned words:
|
||||
;; (bit-string-case input ([ (vals :: (t:listof bits 32)) ] vals))
|
||||
;; (bit-string (vals :: (t:listof bits 32)))
|
||||
(define-syntax t:listof
|
||||
(syntax-rules ()
|
||||
((_ #t option ...)
|
||||
(lambda (input ks kf)
|
||||
(let loop ((acc '())
|
||||
(input input))
|
||||
(bit-string-case input
|
||||
([ (v :: option ...) (rest :: binary) ]
|
||||
(loop (cons v acc) rest))
|
||||
([]
|
||||
(ks (reverse acc) #""))
|
||||
(else
|
||||
(kf))))))
|
||||
((_ #f option ...)
|
||||
(lambda (vs)
|
||||
(let loop ((vs vs))
|
||||
(cond
|
||||
((pair? vs) (bit-string ((car vs) :: option ...)
|
||||
((loop (cdr vs)) :: binary)))
|
||||
(else (bit-string))))))))
|
||||
|
||||
;; <rfc1035>
|
||||
;; All communications inside of the domain protocol are carried in a single
|
||||
;; format called a message. The top level format of message is divided
|
||||
;; into 5 sections (some of which are empty in certain cases) shown below:
|
||||
;;
|
||||
;; +---------------------+
|
||||
;; | Header |
|
||||
;; +---------------------+
|
||||
;; | Question | the question for the name server
|
||||
;; +---------------------+
|
||||
;; | Answer | RRs answering the question
|
||||
;; +---------------------+
|
||||
;; | Authority | RRs pointing toward an authority
|
||||
;; +---------------------+
|
||||
;; | Additional | RRs holding additional information
|
||||
;; +---------------------+
|
||||
;; </rfc1035>
|
||||
|
||||
;; <rfc1035>
|
||||
;; The header contains the following fields:
|
||||
;;
|
||||
;; 1 1 1 1 1 1
|
||||
;; 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | ID |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; |QR| Opcode |AA|TC|RD|RA| Z | RCODE |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | QDCOUNT |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | ANCOUNT |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | NSCOUNT |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | ARCOUNT |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; </rfc1035>
|
||||
|
||||
;; Bytes -> DNSMessage
|
||||
;; Parse an encoded DNS message packet into the corresponding Racket
|
||||
;; structure. Raises an exception on failure.
|
||||
(define (packet->dns-message packet)
|
||||
(bit-string-case packet
|
||||
([ (id :: bits 16)
|
||||
(qr :: (t:named-bit 'request 'response))
|
||||
(opcode :: bits 4)
|
||||
(aa :: (t:named-bit 'non-authoritative 'authoritative))
|
||||
(tc :: (t:named-bit 'not-truncated 'truncated))
|
||||
(rd :: (t:named-bit 'no-recursion-desired 'recursion-desired))
|
||||
(ra :: (t:named-bit 'no-recursion-available 'recursion-available))
|
||||
(= 0 :: bits 3)
|
||||
(rcode :: bits 4)
|
||||
(qdcount :: bits 16)
|
||||
(ancount :: bits 16)
|
||||
(nscount :: bits 16)
|
||||
(arcount :: bits 16)
|
||||
(q-section :: (t:ntimes qdcount (t:question packet)))
|
||||
(a-section :: (t:ntimes ancount (t:rr packet)))
|
||||
(auth-section :: (t:ntimes nscount (t:rr packet)))
|
||||
(additional-section :: (t:ntimes arcount (t:rr packet))) ]
|
||||
(dns-message id qr (value->query-opcode opcode)
|
||||
aa tc rd ra
|
||||
(value->query-response-code rcode)
|
||||
q-section a-section auth-section additional-section))))
|
||||
|
||||
;; DNSMessage -> Bytes
|
||||
;; Render a Racket structured DNS message using the DNS binary encoding.
|
||||
(define (dns-message->packet m)
|
||||
(bit-string->bytes
|
||||
(bit-string ((dns-message-id m) :: bits 16)
|
||||
((dns-message-direction m) :: (t:named-bit 'request 'response))
|
||||
((query-opcode->value (dns-message-opcode m)) :: bits 4)
|
||||
((dns-message-authoritative m) :: (t:named-bit 'non-authoritative 'authoritative))
|
||||
((dns-message-truncated m) :: (t:named-bit 'not-truncated 'truncated))
|
||||
((dns-message-recursion-desired m)
|
||||
:: (t:named-bit 'no-recursion-desired 'recursion-desired))
|
||||
((dns-message-recursion-available m)
|
||||
:: (t:named-bit 'no-recursion-available 'recursion-available))
|
||||
(0 :: bits 3)
|
||||
((query-response-code->value (dns-message-response-code m)) :: bits 4)
|
||||
((length (dns-message-questions m)) :: bits 16)
|
||||
((length (dns-message-answers m)) :: bits 16)
|
||||
((length (dns-message-authorities m)) :: bits 16)
|
||||
((length (dns-message-additional m)) :: bits 16)
|
||||
((dns-message-questions m) :: (t:ntimes (t:question)))
|
||||
((dns-message-answers m) :: (t:ntimes (t:rr)))
|
||||
((dns-message-authorities m) :: (t:ntimes (t:rr)))
|
||||
((dns-message-additional m) :: (t:ntimes (t:rr))))))
|
||||
|
||||
;; Bit-syntax type for a single bit, represented in Racket as one of
|
||||
;; two possible symbolic values.
|
||||
;; Example: a bit represented by 'zero when it is zero, and 'one when it is one.
|
||||
;; (bit-string-case input ([ (v :: (t:named-bit 'zero 'one)) ] v))
|
||||
;; (bit-string (v :: (t:named-bit 'zero 'one)))
|
||||
(define-syntax t:named-bit
|
||||
(syntax-rules ()
|
||||
((_ #t name0 name1) (lambda (input ks kf)
|
||||
(bit-string-case input
|
||||
([ (v :: bits 1) (rest :: binary) ]
|
||||
(ks (if (zero? v) name0 name1) rest))
|
||||
(else (kf)))))
|
||||
((_ #f name0 name1) (lambda (v)
|
||||
(cond
|
||||
((eq? v name1) (bit-string (1 :: bits 1)))
|
||||
((eq? v name0) (bit-string (0 :: bits 1)))
|
||||
(else (error 't:named-bit
|
||||
"Value supplied is neither ~v nor ~v: ~v"
|
||||
name0 name1 v)))))))
|
||||
|
||||
;; Bit-syntax type for a DomainName. When decoding (but not when
|
||||
;; encoding!), we support DNS's weird compressed domain-name syntax;
|
||||
;; this requires us to pass in the *whole packet* to the decoder to
|
||||
;; let it refer to random substrings within the packet.
|
||||
(define-syntax t:domain-name
|
||||
(syntax-rules ()
|
||||
((_ #t whole-packet)
|
||||
(lambda (input ks kf)
|
||||
(let-values (((name rest) (parse-domain-name whole-packet input '())))
|
||||
(ks name rest))))
|
||||
((_ #f)
|
||||
encode-domain-name)))
|
||||
|
||||
;; DomainName -> Bitstring
|
||||
(define (encode-domain-name labels)
|
||||
(bit-string (labels :: (t:listof (t:pascal-string "Label" 64)))))
|
||||
|
||||
;; Bytes Bytes ListOf<Natural> -> DomainName
|
||||
;; PRECONDITION: input never empty
|
||||
;; INVARIANT: pointers-followed contains every "jump target" we have
|
||||
;; jumped to so far during decoding of this domain-name, in order to
|
||||
;; prevent us from getting stuck in a pointer loop. It should start as
|
||||
;; the empty list.
|
||||
(define (parse-domain-name whole-packet input pointers-followed)
|
||||
(bit-string-case input
|
||||
|
||||
([(= 3 :: bits 2) (offset :: bits 14) (rest :: binary)]
|
||||
(if (member offset pointers-followed)
|
||||
(error 'parse-domain-name "DNS compressed-pointer loop detected")
|
||||
(let-values (((lhs rhs) (bit-string-split-at whole-packet (* 8 offset))))
|
||||
(let-values (((labels ignored-tail)
|
||||
(parse-domain-name whole-packet rhs (cons offset pointers-followed))))
|
||||
(values labels rest)))))
|
||||
|
||||
([(= 0 :: bits 8) (rest :: binary)]
|
||||
(values '() rest))
|
||||
|
||||
([(= 0 :: bits 2) (len :: bits 6) (label :: binary bytes len) (rest :: binary)]
|
||||
;; TODO: validate labels: make sure they conform to the prescribed syntax
|
||||
(let-values (((labels leftover)
|
||||
(parse-domain-name whole-packet rest pointers-followed)))
|
||||
(values (cons (bit-string->bytes label) labels) leftover)))))
|
||||
|
||||
;; Bit-syntax type for single-byte-length-prefixed strings of
|
||||
;; bytes. No character codec is applied to the bytes. During encoding,
|
||||
;; expects two extra arguments: the name of the kind of value, for use
|
||||
;; in error reports, and the maximum permissible length (plus one). If
|
||||
;; the encoder is given a string of length greater than or equal to
|
||||
;; the given maximum, an error is signalled.
|
||||
(define-syntax t:pascal-string
|
||||
(syntax-rules ()
|
||||
((_ #t)
|
||||
(lambda (input ks kf)
|
||||
(bit-string-case input
|
||||
([ len (body :: binary bytes len) (rest :: binary) ]
|
||||
(ks (bit-string->bytes body) rest))
|
||||
(else (kf)))))
|
||||
((_ #f)
|
||||
(t:pascal-string #f "Character-string" 256))
|
||||
((_ #f string-kind length-limit)
|
||||
(lambda (s)
|
||||
(let ((len (bytes-length s)))
|
||||
(when (>= len length-limit)
|
||||
(error 't:pascal-string "~s too long: ~v" string-kind s))
|
||||
(bit-string len (s :: binary)))))))
|
||||
|
||||
;; <rfc1035>
|
||||
;; The question section is used to carry the "question" in most queries,
|
||||
;; i.e., the parameters that define what is being asked. The section
|
||||
;; contains QDCOUNT (usually 1) entries, each of the following format:
|
||||
;;
|
||||
;; 1 1 1 1 1 1
|
||||
;; 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | |
|
||||
;; / QNAME /
|
||||
;; / /
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | QTYPE |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | QCLASS |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; </rfc1035>
|
||||
|
||||
;; Bit-syntax type for Questions. The decoder needs to be given the
|
||||
;; whole packet because the question may contain nested domain-names.
|
||||
(define-syntax t:question
|
||||
(syntax-rules ()
|
||||
((_ #t whole-packet)
|
||||
(lambda (input ks kf)
|
||||
(bit-string-case input
|
||||
([ (qname :: (t:domain-name whole-packet))
|
||||
(qtype :: bits 16)
|
||||
(qclass :: bits 16)
|
||||
(tail :: binary) ]
|
||||
(ks (question qname
|
||||
(value->qtype qtype)
|
||||
(value->qclass qclass))
|
||||
tail)))))
|
||||
((_ #f)
|
||||
(lambda (q)
|
||||
(bit-string ((question-name q) :: (t:domain-name))
|
||||
((qtype->value (question-type q)) :: bits 16)
|
||||
((qclass->value (question-class q)) :: bits 16))))))
|
||||
|
||||
;; <rfc1035>
|
||||
;; All RRs have the same top level format shown below:
|
||||
;;
|
||||
;; 1 1 1 1 1 1
|
||||
;; 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | |
|
||||
;; / /
|
||||
;; / NAME /
|
||||
;; | |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | TYPE |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | CLASS |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | TTL |
|
||||
;; | |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; | RDLENGTH |
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--|
|
||||
;; / RDATA /
|
||||
;; / /
|
||||
;; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
|
||||
;; </rfc1035>
|
||||
|
||||
;; Bit-syntax type for RRs. The decoder needs to be given the whole
|
||||
;; packet because the RR may contain nested domain-names.
|
||||
(define-syntax t:rr
|
||||
(syntax-rules ()
|
||||
((_ #t whole-packet)
|
||||
(lambda (input ks kf)
|
||||
(decode-rr whole-packet input ks kf)))
|
||||
((_ #f)
|
||||
encode-rr)))
|
||||
|
||||
;; Bytes Bytes (RR Bytes -> A) ( -> A) -> A
|
||||
;; Helper for t:rr.
|
||||
(define (decode-rr whole-packet input ks kf)
|
||||
(bit-string-case input
|
||||
([ (name :: (t:domain-name whole-packet))
|
||||
(type-number :: bits 16)
|
||||
(class :: bits 16)
|
||||
(ttl :: bits 32)
|
||||
(rdlength :: bits 16)
|
||||
(rdata :: binary bytes rdlength)
|
||||
(tail :: binary) ]
|
||||
(let ((type (value->type type-number)))
|
||||
(ks (rr name
|
||||
type
|
||||
(value->class class)
|
||||
ttl
|
||||
(decode-rdata whole-packet type rdata))
|
||||
tail)))
|
||||
(else (kf))))
|
||||
|
||||
;; RR -> Bitstring
|
||||
;; Helper for t:rr.
|
||||
(define (encode-rr rr)
|
||||
(let ((encoded-rdata (encode-rdata (rr-type rr) (rr-rdata rr))))
|
||||
(bit-string ((rr-name rr) :: (t:domain-name))
|
||||
((type->value (rr-type rr)) :: bits 16)
|
||||
((class->value (rr-class rr)) :: bits 16)
|
||||
((rr-ttl rr) :: bits 32)
|
||||
((/ (bit-string-length encoded-rdata) 8) :: bits 16)
|
||||
(encoded-rdata :: binary))))
|
||||
|
||||
;; Bytes RRType Bytes -> RData
|
||||
;; Decode RData according to the RRType. Takes the whole packet for
|
||||
;; the same reason as t:rr does.
|
||||
(define (decode-rdata whole-packet type rdata)
|
||||
(case type
|
||||
((cname mb md mf mg mr ns ptr) (bit-string-case rdata
|
||||
([ (name :: (t:domain-name whole-packet)) ] name)))
|
||||
((hinfo) (bit-string-case rdata
|
||||
([ (cpu :: (t:pascal-string)) (os :: (t:pascal-string)) ]
|
||||
(hinfo cpu os))))
|
||||
((minfo) (bit-string-case rdata
|
||||
([ (rmailbx :: (t:domain-name whole-packet))
|
||||
(emailbx :: (t:domain-name whole-packet)) ]
|
||||
(minfo rmailbx emailbx))))
|
||||
((mx) (bit-string-case rdata
|
||||
([ (preference :: bits 16)
|
||||
(exchange :: (t:domain-name whole-packet)) ]
|
||||
(mx preference exchange))))
|
||||
((null) (bit-string->bytes rdata))
|
||||
((soa) (bit-string-case rdata
|
||||
([ (mname :: (t:domain-name whole-packet))
|
||||
(rname :: (t:domain-name whole-packet))
|
||||
(serial :: bits 32)
|
||||
(refresh :: bits 32)
|
||||
(retry :: bits 32)
|
||||
(expire :: bits 32)
|
||||
(minimum :: bits 32) ]
|
||||
(soa mname rname serial refresh retry expire minimum))))
|
||||
((txt) (bit-string-case rdata
|
||||
([ (strs :: (t:listof (t:pascal-string))) ]
|
||||
strs)))
|
||||
((a) (bit-string-case rdata
|
||||
([ a b c d ]
|
||||
(vector a b c d))))
|
||||
((aaaa) (bit-string-case rdata
|
||||
([ (ipv6-addr :: binary bits 128) ]
|
||||
(list->vector (bytes->list (bit-string->bytes ipv6-addr))))))
|
||||
((wks) (bit-string-case rdata
|
||||
([ a b c d protocol (bitmap :: binary) ]
|
||||
(wks (vector a b c d) protocol bitmap))))
|
||||
((srv) (bit-string-case rdata
|
||||
([ (priority :: bits 16)
|
||||
(weight :: bits 16)
|
||||
(port :: bits 16)
|
||||
(target :: (t:domain-name whole-packet)) ]
|
||||
(srv priority weight port target))))
|
||||
(else (bit-string->bytes rdata))))
|
||||
|
||||
;; RRType RData -> Bitstring
|
||||
;; Encode RData according to the RRType.
|
||||
(define (encode-rdata type rdata)
|
||||
(case type
|
||||
((cname mb md mf mg mr ns ptr) (encode-domain-name rdata))
|
||||
((hinfo) (bit-string ((hinfo-cpu rdata) :: (t:pascal-string))
|
||||
((hinfo-os rdata) :: (t:pascal-string))))
|
||||
((minfo) (bit-string ((minfo-rmailbx rdata) :: (t:domain-name))
|
||||
((minfo-emailbx rdata) :: (t:domain-name))))
|
||||
((mx) (bit-string ((mx-preference rdata) :: bits 16)
|
||||
((mx-exchange rdata) :: (t:domain-name))))
|
||||
((null) rdata)
|
||||
((soa) (bit-string ((soa-mname rdata) :: (t:domain-name))
|
||||
((soa-rname rdata) :: (t:domain-name))
|
||||
((soa-serial rdata) :: bits 32)
|
||||
((soa-refresh rdata) :: bits 32)
|
||||
((soa-retry rdata) :: bits 32)
|
||||
((soa-expire rdata) :: bits 32)
|
||||
((soa-minimum rdata) :: bits 32)))
|
||||
((txt) (bit-string (rdata :: (t:listof (t:pascal-string)))))
|
||||
((a) (match rdata ((vector a b c d) (bit-string a b c d))))
|
||||
((aaaa) (bit-string ((list->bytes (vector->list rdata)) :: binary bits 128)))
|
||||
((wks) (match (wks-address rdata)
|
||||
((vector a b c d)
|
||||
(bit-string a b c d (wks-protocol rdata) ((wks-bitmap rdata) :: binary)))))
|
||||
((srv) (bit-string ((srv-priority rdata) :: bits 16)
|
||||
((srv-weight rdata) :: bits 16)
|
||||
((srv-port rdata) :: bits 16)
|
||||
((srv-target rdata) :: (t:domain-name))))
|
||||
(else rdata)))
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
#lang racket/base
|
||||
;; Macros for defining weak and extensible mappings between sets of values
|
||||
|
||||
(provide define-mapping)
|
||||
|
||||
;; Internal. Extracts macro keywords from a list of arguments.
|
||||
(define-syntax check-defaults
|
||||
(syntax-rules ()
|
||||
((_ fn bn fd bd #:forward-default new-fd rest ...)
|
||||
(check-defaults fn bn new-fd bd rest ...))
|
||||
((_ fn bn fd bd #:backward-default new-bd rest ...)
|
||||
(check-defaults fn bn fd new-bd rest ...))
|
||||
((_ fn bn fd bd (lhs rhs) ...)
|
||||
(begin
|
||||
(define (fn l)
|
||||
(case l
|
||||
((lhs) 'rhs) ...
|
||||
(else (fd l))))
|
||||
(define (bn r)
|
||||
(case r
|
||||
((rhs) 'lhs) ...
|
||||
(else (bd r))))))))
|
||||
|
||||
;; Symbol -> raised exn:fail:contract
|
||||
;; Used by default to complain when no specific mapping is found.
|
||||
;; The argument indicates to the user the direction of the mapping.
|
||||
(define (die-with-mapping-name n)
|
||||
(lambda (v)
|
||||
(raise (exn:fail:contract
|
||||
(format "~v: Mapping not found for ~v" n v)
|
||||
(current-continuation-marks)))))
|
||||
|
||||
;; (define-mapping <identifier> <identifier>
|
||||
;; { #:forward-default <expr> }?
|
||||
;; { #:backward-default <expr> }?
|
||||
;; (<expr> <expr>) ...)
|
||||
;; Defines two functions, forward-name and backward-name, which take
|
||||
;; values from the left-hand-sides of the mappings given as "(<expr>
|
||||
;; <expr>)" to the right-hand-sides and vice versa, respectively.
|
||||
;;
|
||||
;; If specified, the #:forward-default and #:backward-default exprs
|
||||
;; should evaluate to a procedure of one argument which can be used
|
||||
;; for fallback computation of the mapping or for error
|
||||
;; reporting. They default to raising exn:fail:contract.
|
||||
(define-syntax define-mapping
|
||||
(syntax-rules ()
|
||||
((_ forward-name backward-name rest ...)
|
||||
(check-defaults forward-name
|
||||
backward-name
|
||||
(die-with-mapping-name 'forward-name)
|
||||
(die-with-mapping-name 'backward-name)
|
||||
rest ...))))
|
||||
|
|
@ -0,0 +1,249 @@
|
|||
#lang racket/base
|
||||
|
||||
(require "api.rkt")
|
||||
(require "codec.rkt")
|
||||
|
||||
;; Wed Jun 29 16:33:58 2011 (4e0b8c36): UDP: localhost sent 28 bytes:
|
||||
;; 00000000: 66 3A 01 00 00 01 00 00 : 00 00 00 00 06 67 6F 6F f:...........goo
|
||||
;; 00000010: 67 6C 65 03 63 6F 6D 00 : 00 FF 00 01 gle.com.....
|
||||
;; 0000001C:
|
||||
|
||||
(define (q-google-in-any)
|
||||
(bytes #x66 #x3A #x01 #x00 #x00 #x01 #x00 #x00
|
||||
#x00 #x00 #x00 #x00 #x06 #x67 #x6F #x6F
|
||||
#x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00
|
||||
#x00 #xFF #x00 #x01))
|
||||
|
||||
;; Wed Jun 29 16:33:58 2011 (4e0b8c36): UDP: dslrouter.westell.com sent 494 bytes:
|
||||
;; 00000000: 66 3A 81 80 00 01 00 0F : 00 00 00 07 06 67 6F 6F f:...........goo
|
||||
;; 00000010: 67 6C 65 03 63 6F 6D 00 : 00 FF 00 01 C0 0C 00 10 gle.com.........
|
||||
;; 00000020: 00 01 00 00 0C 2F 00 52 : 51 76 3D 73 70 66 31 20 ...../.RQv=spf1
|
||||
;; 00000030: 69 6E 63 6C 75 64 65 3A : 5F 6E 65 74 62 6C 6F 63 include:_netbloc
|
||||
;; 00000040: 6B 73 2E 67 6F 6F 67 6C : 65 2E 63 6F 6D 20 69 70 ks.google.com ip
|
||||
;; 00000050: 34 3A 32 31 36 2E 37 33 : 2E 39 33 2E 37 30 2F 33 4:216.73.93.70/3
|
||||
;; 00000060: 31 20 69 70 34 3A 32 31 : 36 2E 37 33 2E 39 33 2E 1 ip4:216.73.93.
|
||||
;; 00000070: 37 32 2F 33 31 20 7E 61 : 6C 6C C0 0C 00 01 00 01 72/31 ~all......
|
||||
;; 00000080: 00 00 01 1D 00 04 4A 7D : E2 92 C0 0C 00 01 00 01 ......J}........
|
||||
;; 00000090: 00 00 01 1D 00 04 4A 7D : E2 94 C0 0C 00 01 00 01 ......J}........
|
||||
;; 000000A0: 00 00 01 1D 00 04 4A 7D : E2 91 C0 0C 00 01 00 01 ......J}........
|
||||
;; 000000B0: 00 00 01 1D 00 04 4A 7D : E2 93 C0 0C 00 01 00 01 ......J}........
|
||||
;; 000000C0: 00 00 01 1D 00 04 4A 7D : E2 90 C0 0C 00 02 00 01 ......J}........
|
||||
;; 000000D0: 00 03 A5 1D 00 06 03 6E : 73 32 C0 0C C0 0C 00 02 .......ns2......
|
||||
;; 000000E0: 00 01 00 03 A5 1D 00 06 : 03 6E 73 33 C0 0C C0 0C .........ns3....
|
||||
;; 000000F0: 00 02 00 01 00 03 A5 1D : 00 06 03 6E 73 31 C0 0C ...........ns1..
|
||||
;; 00000100: C0 0C 00 02 00 01 00 03 : A5 1D 00 06 03 6E 73 34 .............ns4
|
||||
;; 00000110: C0 0C C0 0C 00 0F 00 01 : 00 00 00 2A 00 11 00 14 ...........*....
|
||||
;; 00000120: 04 61 6C 74 31 05 61 73 : 70 6D 78 01 6C C0 0C C0 .alt1.aspmx.l...
|
||||
;; 00000130: 0C 00 0F 00 01 00 00 00 : 2A 00 09 00 1E 04 61 6C ........*.....al
|
||||
;; 00000140: 74 32 C1 25 C0 0C 00 0F : 00 01 00 00 00 2A 00 04 t2.%.........*..
|
||||
;; 00000150: 00 0A C1 25 C0 0C 00 0F : 00 01 00 00 00 2A 00 09 ...%.........*..
|
||||
;; 00000160: 00 28 04 61 6C 74 33 C1 : 25 C0 0C 00 0F 00 01 00 .(.alt3.%.......
|
||||
;; 00000170: 00 00 2A 00 09 00 32 04 : 61 6C 74 34 C1 25 C0 E8 ..*...2.alt4.%..
|
||||
;; 00000180: 00 01 00 01 00 03 A2 CF : 00 04 D8 EF 24 0A C0 FA ............$...
|
||||
;; 00000190: 00 01 00 01 00 03 A2 CF : 00 04 D8 EF 20 0A C1 0C ............ ...
|
||||
;; 000001A0: 00 01 00 01 00 03 A2 CF : 00 04 D8 EF 26 0A C0 D6 ............&...
|
||||
;; 000001B0: 00 01 00 01 00 03 A2 CF : 00 04 D8 EF 22 0A C1 3D ............"..=
|
||||
;; 000001C0: 00 01 00 01 00 00 00 F0 : 00 04 4A 7D 27 1B C1 25 ..........J}'..%
|
||||
;; 000001D0: 00 01 00 01 00 00 00 F6 : 00 04 4A 7D 73 1B C1 20 ..........J}s..
|
||||
;; 000001E0: 00 01 00 01 00 00 00 21 : 00 04 4A 7D 4D 1B .......!..J}M.
|
||||
;; 000001EE:
|
||||
|
||||
(define (a-google-in-any)
|
||||
(bytes
|
||||
#x66 #x3A #x81 #x80 #x00 #x01 #x00 #x0F #x00 #x00 #x00 #x07 #x06 #x67 #x6F #x6F
|
||||
#x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #xFF #x00 #x01 #xC0 #x0C #x00 #x10
|
||||
#x00 #x01 #x00 #x00 #x0C #x2F #x00 #x52 #x51 #x76 #x3D #x73 #x70 #x66 #x31 #x20
|
||||
#x69 #x6E #x63 #x6C #x75 #x64 #x65 #x3A #x5F #x6E #x65 #x74 #x62 #x6C #x6F #x63
|
||||
#x6B #x73 #x2E #x67 #x6F #x6F #x67 #x6C #x65 #x2E #x63 #x6F #x6D #x20 #x69 #x70
|
||||
#x34 #x3A #x32 #x31 #x36 #x2E #x37 #x33 #x2E #x39 #x33 #x2E #x37 #x30 #x2F #x33
|
||||
#x31 #x20 #x69 #x70 #x34 #x3A #x32 #x31 #x36 #x2E #x37 #x33 #x2E #x39 #x33 #x2E
|
||||
#x37 #x32 #x2F #x33 #x31 #x20 #x7E #x61 #x6C #x6C #xC0 #x0C #x00 #x01 #x00 #x01
|
||||
#x00 #x00 #x01 #x1D #x00 #x04 #x4A #x7D #xE2 #x92 #xC0 #x0C #x00 #x01 #x00 #x01
|
||||
#x00 #x00 #x01 #x1D #x00 #x04 #x4A #x7D #xE2 #x94 #xC0 #x0C #x00 #x01 #x00 #x01
|
||||
#x00 #x00 #x01 #x1D #x00 #x04 #x4A #x7D #xE2 #x91 #xC0 #x0C #x00 #x01 #x00 #x01
|
||||
#x00 #x00 #x01 #x1D #x00 #x04 #x4A #x7D #xE2 #x93 #xC0 #x0C #x00 #x01 #x00 #x01
|
||||
#x00 #x00 #x01 #x1D #x00 #x04 #x4A #x7D #xE2 #x90 #xC0 #x0C #x00 #x02 #x00 #x01
|
||||
#x00 #x03 #xA5 #x1D #x00 #x06 #x03 #x6E #x73 #x32 #xC0 #x0C #xC0 #x0C #x00 #x02
|
||||
#x00 #x01 #x00 #x03 #xA5 #x1D #x00 #x06 #x03 #x6E #x73 #x33 #xC0 #x0C #xC0 #x0C
|
||||
#x00 #x02 #x00 #x01 #x00 #x03 #xA5 #x1D #x00 #x06 #x03 #x6E #x73 #x31 #xC0 #x0C
|
||||
#xC0 #x0C #x00 #x02 #x00 #x01 #x00 #x03 #xA5 #x1D #x00 #x06 #x03 #x6E #x73 #x34
|
||||
#xC0 #x0C #xC0 #x0C #x00 #x0F #x00 #x01 #x00 #x00 #x00 #x2A #x00 #x11 #x00 #x14
|
||||
#x04 #x61 #x6C #x74 #x31 #x05 #x61 #x73 #x70 #x6D #x78 #x01 #x6C #xC0 #x0C #xC0
|
||||
#x0C #x00 #x0F #x00 #x01 #x00 #x00 #x00 #x2A #x00 #x09 #x00 #x1E #x04 #x61 #x6C
|
||||
#x74 #x32 #xC1 #x25 #xC0 #x0C #x00 #x0F #x00 #x01 #x00 #x00 #x00 #x2A #x00 #x04
|
||||
#x00 #x0A #xC1 #x25 #xC0 #x0C #x00 #x0F #x00 #x01 #x00 #x00 #x00 #x2A #x00 #x09
|
||||
#x00 #x28 #x04 #x61 #x6C #x74 #x33 #xC1 #x25 #xC0 #x0C #x00 #x0F #x00 #x01 #x00
|
||||
#x00 #x00 #x2A #x00 #x09 #x00 #x32 #x04 #x61 #x6C #x74 #x34 #xC1 #x25 #xC0 #xE8
|
||||
#x00 #x01 #x00 #x01 #x00 #x03 #xA2 #xCF #x00 #x04 #xD8 #xEF #x24 #x0A #xC0 #xFA
|
||||
#x00 #x01 #x00 #x01 #x00 #x03 #xA2 #xCF #x00 #x04 #xD8 #xEF #x20 #x0A #xC1 #x0C
|
||||
#x00 #x01 #x00 #x01 #x00 #x03 #xA2 #xCF #x00 #x04 #xD8 #xEF #x26 #x0A #xC0 #xD6
|
||||
#x00 #x01 #x00 #x01 #x00 #x03 #xA2 #xCF #x00 #x04 #xD8 #xEF #x22 #x0A #xC1 #x3D
|
||||
#x00 #x01 #x00 #x01 #x00 #x00 #x00 #xF0 #x00 #x04 #x4A #x7D #x27 #x1B #xC1 #x25
|
||||
#x00 #x01 #x00 #x01 #x00 #x00 #x00 #xF6 #x00 #x04 #x4A #x7D #x73 #x1B #xC1 #x20
|
||||
#x00 #x01 #x00 #x01 #x00 #x00 #x00 #x21 #x00 #x04 #x4A #x7D #x4D #x1B))
|
||||
|
||||
(require racket/pretty)
|
||||
(pretty-print (packet->dns-message (q-google-in-any)))
|
||||
(pretty-print (packet->dns-message (a-google-in-any)))
|
||||
|
||||
(pretty-print (dns-message->packet (packet->dns-message (a-google-in-any))))
|
||||
|
||||
;; Wed Jun 29 20:59:17 2011 (4e0bca65): UDP: localhost sent 28 bytes:
|
||||
;; 00000000: 47 16 01 00 00 01 00 00 : 00 00 00 00 06 67 6F 6F G............goo
|
||||
;; 00000010: 67 6C 65 03 63 6F 6D 00 : 00 1C 00 01 gle.com.....
|
||||
;; 0000001C:
|
||||
;; Wed Jun 29 20:59:17 2011 (4e0bca65): UDP: pass through succeeded
|
||||
;; Wed Jun 29 20:59:17 2011 (4e0bca65): UDP: google-public-dns-a.google.com sent 78 bytes:
|
||||
;; 00000000: 47 16 81 80 00 01 00 00 : 00 01 00 00 06 67 6F 6F G............goo
|
||||
;; 00000010: 67 6C 65 03 63 6F 6D 00 : 00 1C 00 01 C0 0C 00 06 gle.com.........
|
||||
;; 00000020: 00 01 00 00 02 52 00 26 : 03 6E 73 31 C0 0C 09 64 .....R.&.ns1...d
|
||||
;; 00000030: 6E 73 2D 61 64 6D 69 6E : C0 0C 00 16 33 23 00 00 ns-admin....3#..
|
||||
;; 00000040: 1C 20 00 00 07 08 00 12 : 75 00 00 00 01 2C . ......u....,
|
||||
;; 0000004E:
|
||||
|
||||
(pretty-print
|
||||
(packet->dns-message
|
||||
(bytes
|
||||
#x47 #x16 #x01 #x00 #x00 #x01 #x00 #x00 #x00 #x00 #x00 #x00 #x06 #x67 #x6F #x6F
|
||||
#x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #x1C #x00 #x01)))
|
||||
|
||||
(pretty-print
|
||||
(packet->dns-message
|
||||
(bytes
|
||||
#x47 #x16 #x81 #x80 #x00 #x01 #x00 #x00 #x00 #x01 #x00 #x00 #x06 #x67 #x6F #x6F
|
||||
#x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #x1C #x00 #x01 #xC0 #x0C #x00 #x06
|
||||
#x00 #x01 #x00 #x00 #x02 #x52 #x00 #x26 #x03 #x6E #x73 #x31 #xC0 #x0C #x09 #x64
|
||||
#x6E #x73 #x2D #x61 #x64 #x6D #x69 #x6E #xC0 #x0C #x00 #x16 #x33 #x23 #x00 #x00
|
||||
#x1C #x20 #x00 #x00 #x07 #x08 #x00 #x12 #x75 #x00 #x00 #x00 #x01 #x2C)))
|
||||
|
||||
;; Wed Jun 29 21:05:03 2011 (4e0bcbbf): UDP: localhost sent 32 bytes:
|
||||
;; 00000000: 12 70 01 00 00 01 00 00 : 00 00 00 00 03 77 77 77 .p...........www
|
||||
;; 00000010: 06 67 6F 6F 67 6C 65 03 : 63 6F 6D 00 00 1C 00 01 .google.com.....
|
||||
;; 00000020:
|
||||
;; Wed Jun 29 21:05:03 2011 (4e0bcbbf): UDP: pass through succeeded
|
||||
;; Wed Jun 29 21:05:03 2011 (4e0bcbbf): UDP: ns1.google.com sent 52 bytes:
|
||||
;; 00000000: 12 70 85 00 00 01 00 01 : 00 00 00 00 03 77 77 77 .p...........www
|
||||
;; 00000010: 06 67 6F 6F 67 6C 65 03 : 63 6F 6D 00 00 1C 00 01 .google.com.....
|
||||
;; 00000020: C0 0C 00 05 00 01 00 09 : 3A 80 00 08 03 77 77 77 ........:....www
|
||||
;; 00000030: 01 6C C0 10 : .l..
|
||||
;; 00000034:
|
||||
|
||||
(pretty-print
|
||||
(packet->dns-message
|
||||
(bytes
|
||||
#x12 #x70 #x01 #x00 #x00 #x01 #x00 #x00 #x00 #x00 #x00 #x00 #x03 #x77 #x77 #x77
|
||||
#x06 #x67 #x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #x1C #x00 #x01)))
|
||||
|
||||
(pretty-print
|
||||
(packet->dns-message
|
||||
(bytes
|
||||
#x12 #x70 #x85 #x00 #x00 #x01 #x00 #x01 #x00 #x00 #x00 #x00 #x03 #x77 #x77 #x77
|
||||
#x06 #x67 #x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #x1C #x00 #x01
|
||||
#xC0 #x0C #x00 #x05 #x00 #x01 #x00 #x09 #x3A #x80 #x00 #x08 #x03 #x77 #x77 #x77
|
||||
#x01 #x6C #xC0 #x10)))
|
||||
|
||||
;; Wed Jun 29 21:07:46 2011 (4e0bcc62): UDP: ns1.google.com sent 82 bytes:
|
||||
;; 00000000: 23 79 85 00 00 01 00 02 : 00 00 00 00 04 69 70 76 #y...........ipv
|
||||
;; 00000010: 36 06 67 6F 6F 67 6C 65 : 03 63 6F 6D 00 00 1C 00 6.google.com....
|
||||
;; 00000020: 01 C0 0C 00 05 00 01 00 : 09 3A 80 00 09 04 69 70 .........:....ip
|
||||
;; 00000030: 76 36 01 6C C0 11 C0 2D : 00 1C 00 01 00 00 01 2C v6.l...-.......,
|
||||
;; 00000040: 00 10 20 01 48 60 80 0F : 00 00 00 00 00 00 00 00 .. .H`..........
|
||||
;; 00000050: 00 68 : .h
|
||||
;; 00000052:
|
||||
|
||||
(pretty-print
|
||||
(packet->dns-message
|
||||
(bytes
|
||||
#x23 #x79 #x85 #x00 #x00 #x01 #x00 #x02 #x00 #x00 #x00 #x00 #x04 #x69 #x70 #x76
|
||||
#x36 #x06 #x67 #x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #x1C #x00
|
||||
#x01 #xC0 #x0C #x00 #x05 #x00 #x01 #x00 #x09 #x3A #x80 #x00 #x09 #x04 #x69 #x70
|
||||
#x76 #x36 #x01 #x6C #xC0 #x11 #xC0 #x2D #x00 #x1C #x00 #x01 #x00 #x00 #x01 #x2C
|
||||
#x00 #x10 #x20 #x01 #x48 #x60 #x80 #x0F #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
|
||||
#x00 #x68)))
|
||||
|
||||
(pretty-print
|
||||
(dns-message->packet
|
||||
(packet->dns-message
|
||||
(bytes
|
||||
#x23 #x79 #x85 #x00 #x00 #x01 #x00 #x02 #x00 #x00 #x00 #x00 #x04 #x69 #x70 #x76
|
||||
#x36 #x06 #x67 #x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #x1C #x00
|
||||
#x01 #xC0 #x0C #x00 #x05 #x00 #x01 #x00 #x09 #x3A #x80 #x00 #x09 #x04 #x69 #x70
|
||||
#x76 #x36 #x01 #x6C #xC0 #x11 #xC0 #x2D #x00 #x1C #x00 #x01 #x00 #x00 #x01 #x2C
|
||||
#x00 #x10 #x20 #x01 #x48 #x60 #x80 #x0F #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00
|
||||
#x00 #x68))))
|
||||
|
||||
;; Thu Jun 30 15:12:45 2011 (4e0ccaad): UDP: asgard.ccs.neu.edu sent 486 bytes:
|
||||
;; 00000000: 13 CA 81 80 00 01 00 05 : 00 04 00 09 0C 5F 78 6D ............._xm
|
||||
;; 00000010: 70 70 2D 73 65 72 76 65 : 72 04 5F 74 63 70 06 67 pp-server._tcp.g
|
||||
;; 00000020: 6F 6F 67 6C 65 03 63 6F : 6D 00 00 21 00 01 C0 0C oogle.com..!....
|
||||
;; 00000030: 00 21 00 01 00 00 03 72 : 00 21 00 14 00 00 14 95 .!.....r.!......
|
||||
;; 00000040: 0C 78 6D 70 70 2D 73 65 : 72 76 65 72 34 01 6C 06 .xmpp-server4.l.
|
||||
;; 00000050: 67 6F 6F 67 6C 65 03 63 : 6F 6D 00 C0 0C 00 21 00 google.com....!.
|
||||
;; 00000060: 01 00 00 03 72 00 20 00 : 05 00 00 14 95 0B 78 6D ....r. .......xm
|
||||
;; 00000070: 70 70 2D 73 65 72 76 65 : 72 01 6C 06 67 6F 6F 67 pp-server.l.goog
|
||||
;; 00000080: 6C 65 03 63 6F 6D 00 C0 : 0C 00 21 00 01 00 00 03 le.com....!.....
|
||||
;; 00000090: 72 00 21 00 14 00 00 14 : 95 0C 78 6D 70 70 2D 73 r.!.......xmpp-s
|
||||
;; 000000A0: 65 72 76 65 72 31 01 6C : 06 67 6F 6F 67 6C 65 03 erver1.l.google.
|
||||
;; 000000B0: 63 6F 6D 00 C0 0C 00 21 : 00 01 00 00 03 72 00 21 com....!.....r.!
|
||||
;; 000000C0: 00 14 00 00 14 95 0C 78 : 6D 70 70 2D 73 65 72 76 .......xmpp-serv
|
||||
;; 000000D0: 65 72 32 01 6C 06 67 6F : 6F 67 6C 65 03 63 6F 6D er2.l.google.com
|
||||
;; 000000E0: 00 C0 0C 00 21 00 01 00 : 00 03 72 00 21 00 14 00 ....!.....r.!...
|
||||
;; 000000F0: 00 14 95 0C 78 6D 70 70 : 2D 73 65 72 76 65 72 33 ....xmpp-server3
|
||||
;; 00000100: 01 6C 06 67 6F 6F 67 6C : 65 03 63 6F 6D 00 C1 02 .l.google.com...
|
||||
;; 00000110: 00 02 00 01 00 01 54 24 : 00 06 03 6E 73 33 C1 02 ......T$...ns3..
|
||||
;; 00000120: C1 02 00 02 00 01 00 01 : 54 24 00 06 03 6E 73 34 ........T$...ns4
|
||||
;; 00000130: C1 02 C1 02 00 02 00 01 : 00 01 54 24 00 06 03 6E ..........T$...n
|
||||
;; 00000140: 73 32 C1 02 C1 02 00 02 : 00 01 00 01 54 24 00 06 s2..........T$..
|
||||
;; 00000150: 03 6E 73 31 C1 02 C0 6D : 00 01 00 01 00 00 01 1A .ns1...m........
|
||||
;; 00000160: 00 04 4A 7D 99 7D C0 99 : 00 01 00 01 00 00 06 F6 ..J}.}..........
|
||||
;; 00000170: 00 04 4A 7D 35 7D C0 C6 : 00 01 00 01 00 00 06 F6 ..J}5}..........
|
||||
;; 00000180: 00 04 4A 7D 2F 7D C0 F3 : 00 01 00 01 00 00 06 F6 ..J}/}..........
|
||||
;; 00000190: 00 04 4A 7D 2D 7D C0 40 : 00 01 00 01 00 00 06 F6 ..J}-}.@........
|
||||
;; 000001A0: 00 04 4A 7D 2D 7D C1 50 : 00 01 00 01 00 00 0A B1 ..J}-}.P........
|
||||
;; 000001B0: 00 04 D8 EF 20 0A C1 3E : 00 01 00 01 00 00 0A B1 .... ..>........
|
||||
;; 000001C0: 00 04 D8 EF 22 0A C1 1A : 00 01 00 01 00 00 0A B1 ...."...........
|
||||
;; 000001D0: 00 04 D8 EF 24 0A C1 2C : 00 01 00 01 00 00 0A B1 ....$..,........
|
||||
;; 000001E0: 00 04 D8 EF 26 0A : ....&.
|
||||
;; 000001E6:
|
||||
|
||||
;; ANSWER SECTION:
|
||||
;;_xmpp-server._tcp.google.com. 900 IN SRV 5 0 5269 xmpp-server.l.google.com.
|
||||
;;_xmpp-server._tcp.google.com. 900 IN SRV 20 0 5269 xmpp-server1.l.google.com.
|
||||
;;_xmpp-server._tcp.google.com. 900 IN SRV 20 0 5269 xmpp-server2.l.google.com.
|
||||
;;_xmpp-server._tcp.google.com. 900 IN SRV 20 0 5269 xmpp-server3.l.google.com.
|
||||
;;_xmpp-server._tcp.google.com. 900 IN SRV 20 0 5269 xmpp-server4.l.google.com.
|
||||
|
||||
(pretty-print
|
||||
(packet->dns-message
|
||||
(bytes
|
||||
#x13 #xCA #x81 #x80 #x00 #x01 #x00 #x05 #x00 #x04 #x00 #x09 #x0C #x5F #x78 #x6D
|
||||
#x70 #x70 #x2D #x73 #x65 #x72 #x76 #x65 #x72 #x04 #x5F #x74 #x63 #x70 #x06 #x67
|
||||
#x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #x00 #x21 #x00 #x01 #xC0 #x0C
|
||||
#x00 #x21 #x00 #x01 #x00 #x00 #x03 #x72 #x00 #x21 #x00 #x14 #x00 #x00 #x14 #x95
|
||||
#x0C #x78 #x6D #x70 #x70 #x2D #x73 #x65 #x72 #x76 #x65 #x72 #x34 #x01 #x6C #x06
|
||||
#x67 #x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #xC0 #x0C #x00 #x21 #x00
|
||||
#x01 #x00 #x00 #x03 #x72 #x00 #x20 #x00 #x05 #x00 #x00 #x14 #x95 #x0B #x78 #x6D
|
||||
#x70 #x70 #x2D #x73 #x65 #x72 #x76 #x65 #x72 #x01 #x6C #x06 #x67 #x6F #x6F #x67
|
||||
#x6C #x65 #x03 #x63 #x6F #x6D #x00 #xC0 #x0C #x00 #x21 #x00 #x01 #x00 #x00 #x03
|
||||
#x72 #x00 #x21 #x00 #x14 #x00 #x00 #x14 #x95 #x0C #x78 #x6D #x70 #x70 #x2D #x73
|
||||
#x65 #x72 #x76 #x65 #x72 #x31 #x01 #x6C #x06 #x67 #x6F #x6F #x67 #x6C #x65 #x03
|
||||
#x63 #x6F #x6D #x00 #xC0 #x0C #x00 #x21 #x00 #x01 #x00 #x00 #x03 #x72 #x00 #x21
|
||||
#x00 #x14 #x00 #x00 #x14 #x95 #x0C #x78 #x6D #x70 #x70 #x2D #x73 #x65 #x72 #x76
|
||||
#x65 #x72 #x32 #x01 #x6C #x06 #x67 #x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D
|
||||
#x00 #xC0 #x0C #x00 #x21 #x00 #x01 #x00 #x00 #x03 #x72 #x00 #x21 #x00 #x14 #x00
|
||||
#x00 #x14 #x95 #x0C #x78 #x6D #x70 #x70 #x2D #x73 #x65 #x72 #x76 #x65 #x72 #x33
|
||||
#x01 #x6C #x06 #x67 #x6F #x6F #x67 #x6C #x65 #x03 #x63 #x6F #x6D #x00 #xC1 #x02
|
||||
#x00 #x02 #x00 #x01 #x00 #x01 #x54 #x24 #x00 #x06 #x03 #x6E #x73 #x33 #xC1 #x02
|
||||
#xC1 #x02 #x00 #x02 #x00 #x01 #x00 #x01 #x54 #x24 #x00 #x06 #x03 #x6E #x73 #x34
|
||||
#xC1 #x02 #xC1 #x02 #x00 #x02 #x00 #x01 #x00 #x01 #x54 #x24 #x00 #x06 #x03 #x6E
|
||||
#x73 #x32 #xC1 #x02 #xC1 #x02 #x00 #x02 #x00 #x01 #x00 #x01 #x54 #x24 #x00 #x06
|
||||
#x03 #x6E #x73 #x31 #xC1 #x02 #xC0 #x6D #x00 #x01 #x00 #x01 #x00 #x00 #x01 #x1A
|
||||
#x00 #x04 #x4A #x7D #x99 #x7D #xC0 #x99 #x00 #x01 #x00 #x01 #x00 #x00 #x06 #xF6
|
||||
#x00 #x04 #x4A #x7D #x35 #x7D #xC0 #xC6 #x00 #x01 #x00 #x01 #x00 #x00 #x06 #xF6
|
||||
#x00 #x04 #x4A #x7D #x2F #x7D #xC0 #xF3 #x00 #x01 #x00 #x01 #x00 #x00 #x06 #xF6
|
||||
#x00 #x04 #x4A #x7D #x2D #x7D #xC0 #x40 #x00 #x01 #x00 #x01 #x00 #x00 #x06 #xF6
|
||||
#x00 #x04 #x4A #x7D #x2D #x7D #xC1 #x50 #x00 #x01 #x00 #x01 #x00 #x00 #x0A #xB1
|
||||
#x00 #x04 #xD8 #xEF #x20 #x0A #xC1 #x3E #x00 #x01 #x00 #x01 #x00 #x00 #x0A #xB1
|
||||
#x00 #x04 #xD8 #xEF #x22 #x0A #xC1 #x1A #x00 #x01 #x00 #x01 #x00 #x00 #x0A #xB1
|
||||
#x00 #x04 #xD8 #xEF #x24 #x0A #xC1 #x2C #x00 #x01 #x00 #x01 #x00 #x00 #x0A #xB1
|
||||
#x00 #x04 #xD8 #xEF #x26 #x0A)))
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
#lang racket/base
|
||||
;; Tests for mapping.rkt.
|
||||
|
||||
(require "mapping.rkt")
|
||||
(require rackunit)
|
||||
|
||||
(define-mapping a->b b->a
|
||||
(a b))
|
||||
|
||||
(check-equal? (a->b 'a) 'b)
|
||||
(check-equal? (b->a 'b) 'a)
|
||||
(check-exn exn:fail:contract? (lambda () (a->b 123)))
|
||||
(check-exn exn:fail:contract? (lambda () (a->b 'b)))
|
||||
(check-exn exn:fail:contract? (lambda () (b->a 123)))
|
||||
(check-exn exn:fail:contract? (lambda () (b->a 'a)))
|
||||
|
||||
(define-mapping c->d d->c
|
||||
#:forward-default (lambda (x) 'default-d)
|
||||
#:backward-default (lambda (x) 'default-c)
|
||||
(c 123)
|
||||
(e 234))
|
||||
|
||||
(check-equal? (c->d 'c) 123)
|
||||
(check-equal? (d->c 234) 'e)
|
||||
(check-equal? (c->d 'other) 'default-d)
|
||||
(check-equal? (d->c '235) 'default-c)
|
||||
Loading…
Reference in New Issue