syndicate-lang
/
racket-dns-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Topologically sort CNAME chains.

This commit is contained in:
Tony Garnock-Jones 2012-02-24 17:53:53 -05:00
parent f23ad022a7
commit e7ad27f1d3
2 changed files with 52 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
test-dns.rkt
View File

@ -449,3 +449,21 @@
(check-equal? (compile-zone-db test-roots)
(bit-string->zone (zone->bit-string (compile-zone-db test-roots))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CNAME sorting
(let ()
(define rrs
(list (rr (domain '(#"a")) 'cname 'in 30 (domain '(#"b")))
(rr (domain '(#"b")) 'cname 'in 30 (domain '(#"c")))
(rr (domain '(#"c")) 'cname 'in 30 (domain '(#"d")))))
(define (check-transpose ns)
(define permuted (map (lambda (i) (list-ref rrs i)) ns))
(check-equal? (cname-sort permuted) rrs))
(check-transpose '(0 1 2))
(check-transpose '(0 2 1))
(check-transpose '(2 0 1))
(check-transpose '(2 1 0))
(check-transpose '(1 2 0))
(check-transpose '(1 0 2)))

36
zonedb.rkt
View File

@ -21,6 +21,7 @@
filter-by-type
filter-rrs
rr-set->list
cname-sort ;; provided for unit tests
zone->bit-string
bit-string->zone)
@ -185,7 +186,7 @@
;; Like set->list, but places all CNAME records first.
;; This is apparently to work around bugs in old versions of BIND?
;;
;; TODO: Perhaps the CNAMEs even need to be in topologically-sorted order?
;; The CNAMEs even need to be in topologically-sorted order.
;; http://homepage.ntlworld.com./jonathan.deboynepollard/FGA/dns-response-taxonomy.html
;; has this to say on this topic:
;; "A content DNS server following the algorithm in § 4.3.2 of RFC
@ -193,10 +194,41 @@
;; response. The response parsing code in most resolving proxy DNS
;; servers and DNS client libraries expects this order. However,
;; the actual text of RFC 1034 itself does not guarantee it."
;; Sure enough, the resolver in Firefox seems not to be able to handle
;; CNAMEs in any order other than strictly causal. While we could be
;; more careful about retaining the ordering of RRs all the way
;; through the resolution and CNAME expansion processes, that would
;; pollute the logic with a bunch of noise about RR order which isn't
;; even supposed to be relevant. So we *recover* the order here, which
;; is a bit expensive.
(define (rr-set->list rrs)
(append (set->list (filter-by-type rrs 'cname))
(append (cname-sort (set->list (filter-by-type rrs 'cname)))
(set->list (set-filter (lambda (rr) (not (eqv? (rr-type rr) 'cname))) rrs))))
;; cname-sort : ListOf<RR<CNAME>> -> ListOf<RR<CNAME>>
;; Produce an ordering of the CNAMEs given that respects their
;; "causality". For example, if a CNAME b and b CNAME c, then the RRs
;; will be presented in that order (and not the other order, with b
;; CNAME c first).
(define (cname-sort cnames)
(define lhss (list->set (map rr-name cnames)))
(define rhss (list->set (map rr-rdata cnames)))
(define roots (set->list (set-subtract lhss rhss))) ;; Nodes not the targets of some edge.
(define (targets-of name) (for/list [(rr cnames) #:when (equal? (rr-name rr) name)] rr))
(let iterate ((remaining roots)
(seen (set))
(acc '()))
(if (null? remaining)
(reverse acc)
(let ((source (car remaining)))
(if (set-member? seen source)
(iterate (cdr remaining) seen acc)
(let* ((rrs (targets-of source))
(targets (map rr-rdata rrs)))
(iterate (append targets (cdr remaining))
(set-add seen source)
(append rrs acc))))))))
;; CompiledZone -> Bitstring
;; Produces a serialized form of the zone suitable for saving to disk.
(define (zone->bit-string zone)