2013-05-10 20:38:25 +00:00
|
|
|
#lang typed/racket/base
|
2013-05-21 16:14:05 +00:00
|
|
|
;;
|
|
|
|
;;; 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/>.
|
2013-05-10 20:38:25 +00:00
|
|
|
|
|
|
|
(require "api.rkt")
|
|
|
|
|
|
|
|
(provide (all-defined-out))
|
|
|
|
|
|
|
|
(define test-soa-rr
|
|
|
|
(rr (domain '(#"example")) 'in 30
|
|
|
|
(rdata-soa 'soa
|
|
|
|
(domain '(#"ns" #"example"))
|
|
|
|
(domain '(#"tonyg" #"example"))
|
|
|
|
1
|
|
|
|
24
|
|
|
|
24
|
|
|
|
30
|
|
|
|
10)))
|
|
|
|
|
|
|
|
(: A : (Listof Bytes) (Vector Integer Integer Integer Integer) -> RR)
|
|
|
|
(: A/ttl : (Listof Bytes) (Vector Integer Integer Integer Integer) Nonnegative-Integer -> RR)
|
|
|
|
(: MX : (Listof Bytes) Nonnegative-Integer (Listof Bytes) -> RR)
|
|
|
|
(: CNAME : (Listof Bytes) (Listof Bytes) -> RR)
|
|
|
|
(: NS : (Listof Bytes) (Listof Bytes) -> RR)
|
|
|
|
(: NS/ttl : (Listof Bytes) (Listof Bytes) Nonnegative-Integer -> RR)
|
|
|
|
(: TXT : (Listof Bytes) (Listof Bytes) -> RR)
|
|
|
|
|
|
|
|
(define (A n ip) (A/ttl n ip 30))
|
|
|
|
(define (A/ttl n ip ttl) (rr (domain n) 'in ttl (rdata-ipv4 'a (cast ip IPv4))))
|
|
|
|
(define (MX n p t) (rr (domain n) 'in 30 (rdata-mx 'mx p (domain t))))
|
|
|
|
(define (CNAME n1 n2) (rr (domain n1) 'in 30 (rdata-domain 'cname (domain n2))))
|
|
|
|
(define (NS n1 n2) (NS/ttl n1 n2 30))
|
|
|
|
(define (NS/ttl n1 n2 ttl) (rr (domain n1) 'in ttl (rdata-domain 'ns (domain n2))))
|
|
|
|
(define (TXT n strs) (rr (domain n) 'in 30 (rdata-txt 'txt strs)))
|
|
|
|
|
|
|
|
(define test-rrs
|
|
|
|
(list (A '(#"localhost" #"example") '#(127 0 0 1))
|
|
|
|
(MX '(#"example") 5 '(#"localhost" #"example"))
|
|
|
|
(MX '(#"example") 10 '(#"subns" #"example"))
|
|
|
|
(CNAME '(#"google" #"example")'(#"www" #"google" #"com"))
|
|
|
|
(A '(#"roar" #"example") '#(192 168 1 1))
|
|
|
|
(CNAME '(#"alias" #"example") '(#"roar" #"example"))
|
|
|
|
(A '(#"ns" #"example") '#(127 0 0 1))
|
|
|
|
(TXT '(#"hello" #"example") '(#"Hello CRASH"))
|
|
|
|
(NS '(#"subzone" #"example") '(#"subns" #"example"))
|
|
|
|
(A '(#"subns" #"example") '#(127 0 0 2))))
|
|
|
|
|
|
|
|
(define test-roots
|
|
|
|
(list (A/ttl '(#"a" #"root-servers" #"net") '#(198 41 0 4) 3600000)
|
|
|
|
(A/ttl '(#"b" #"root-servers" #"net") '#(192 228 79 201) 3600000)
|
|
|
|
(A/ttl '(#"c" #"root-servers" #"net") '#(192 33 4 12) 3600000)
|
|
|
|
(A/ttl '(#"d" #"root-servers" #"net") '#(199 7 91 13) 3600000)
|
|
|
|
(A/ttl '(#"e" #"root-servers" #"net") '#(192 203 230 10) 3600000)
|
|
|
|
(A/ttl '(#"f" #"root-servers" #"net") '#(192 5 5 241) 3600000)
|
|
|
|
(A/ttl '(#"g" #"root-servers" #"net") '#(192 112 36 4) 3600000)
|
|
|
|
(A/ttl '(#"h" #"root-servers" #"net") '#(128 63 2 53) 3600000)
|
|
|
|
(A/ttl '(#"i" #"root-servers" #"net") '#(192 36 148 17) 3600000)
|
|
|
|
(A/ttl '(#"j" #"root-servers" #"net") '#(192 58 128 30) 3600000)
|
|
|
|
(A/ttl '(#"k" #"root-servers" #"net") '#(193 0 14 129) 3600000)
|
|
|
|
(A/ttl '(#"l" #"root-servers" #"net") '#(199 7 83 42) 3600000)
|
|
|
|
(A/ttl '(#"m" #"root-servers" #"net") '#(202 12 27 33) 3600000)
|
|
|
|
(NS/ttl '() '(#"a" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"b" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"c" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"d" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"e" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"f" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"g" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"h" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"i" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"j" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"k" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"l" #"root-servers" #"net") 3600000)
|
|
|
|
(NS/ttl '() '(#"m" #"root-servers" #"net") 3600000)))
|
|
|
|
|
|
|
|
(define pathological-roots
|
|
|
|
(list (NS '(#"a") '(#"ns" #"b"))
|
|
|
|
(NS '(#"b") '(#"ns" #"a"))))
|
|
|
|
|
|
|
|
(: test-port-number : -> Nonnegative-Integer)
|
|
|
|
(define (test-port-number)
|
|
|
|
(define p
|
|
|
|
(string->number
|
|
|
|
(or (getenv "DNSPORT")
|
|
|
|
(error 'test-port-number "Please set your DNSPORT environment variable."))))
|
|
|
|
(if (or (not p) (not (exact? p)) (not (integer? p)) (negative? p))
|
|
|
|
(error 'test-port-number "Invalid DNSPORT setting.")
|
|
|
|
p))
|