Support reverse lookups with IPv6 addresses

This commit is contained in:
Asumu Takikawa 2013-03-02 14:08:28 -05:00
parent cf4c71a51f
commit 3ab83001b4
2 changed files with 95 additions and 46 deletions

View File

@ -34,16 +34,19 @@
;; An LB is a (Listof Bytes)
;;
;; An IPAddressString passes the following predicate
;;
;; Any -> Boolean
;; check if the input string represents an IPv4 address
(define (ip-address-string? val)
(and (string? val)
(or (ipv4-string? val)
(ipv6-string? val))))
;; String -> Boolean
;; Check if the input string represents an IPv4 address
(define (ipv4-string? str)
;; String -> Boolean
;; check if the given string has leading zeroes
(define (has-leading-zeroes? str)
(and (> (string-length str) 1)
(char=? (string-ref str 0) #\0)))
(define (ipv4-string? str)
(define matches
(regexp-match #px"^(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})$"
str))
@ -53,6 +56,9 @@
(andmap byte? (map string->number (cdr matches)))
;; leading zeroes lead to query errors
(not (ormap has-leading-zeroes? matches))))
;; String -> Boolean
;; Check if the input string represents an IPv6 address
;; TODO: support dotted quad notation
(define (ipv6-string? str)
(define re-::/: #px"^([0-9a-fA-F]{1,4})(::|:)")
@ -81,9 +87,6 @@
(implies (not ::?) (= (length octet-pairs) 7))
;; this is the +1 octet pair
(regexp-match? re-end str))]))))
(and (string? val)
(or (ipv4-string? val)
(ipv6-string? val))))
(module+ test
(check-true (ip-address-string? "8.8.8.8"))
@ -404,6 +407,14 @@
(not (member ns tried))
(loop ns (cons ns tried)))))))))
;; String -> String
;; Convert an IP address to a suitable format for a reverse lookup
(define (ip->query-domain ip)
(if (ipv4-string? ip)
(ip->in-addr.arpa ip)
(ip->ip6.arpa ip)))
;; Convert an IPv4 address for reverse lookup
(define (ip->in-addr.arpa ip)
(let ([result (regexp-match #rx"^([0-9]+)\\.([0-9]+)\\.([0-9]+)\\.([0-9]+)$"
ip)])
@ -413,6 +424,45 @@
(list-ref result 2)
(list-ref result 1))))
;; Convert an IPv6 address for reverse lookup
(define (ip->ip6.arpa ip)
(define has-::? (regexp-match? #rx"::" ip))
(define octet-pair-strings
(cond [has-::?
(define without-:: (regexp-replace #rx"::" ip ":replace-me:"))
(define pieces (regexp-split #rx":" without-::))
(define num-pieces (sub1 (length pieces))) ; don't count replace-me
(flatten
;; put in as many 0s needed to expand the ::
(for/list ([piece pieces])
(if (string=? piece "replace-me")
(build-list (- 8 num-pieces) (λ _ "0"))
piece)))]
[else (regexp-split #rx":" ip)]))
;; convert to nibbles
(define nibbles
(for/fold ([nibbles '()])
([two-octs octet-pair-strings])
(define n (string->number two-octs 16))
(define nib1 (arithmetic-shift (bitwise-and #xf000 n) -12))
(define nib2 (arithmetic-shift (bitwise-and #x0f00 n) -8))
(define nib3 (arithmetic-shift (bitwise-and #x00f0 n) -4))
(define nib4 (bitwise-and #x000f n))
(append (list nib4 nib3 nib2 nib1) nibbles)))
(string-append
(string-join
(for/list ([n nibbles]) (~r n #:base 16))
".")
".ip6.arpa"))
(module+ test
(check-equal?
(ip->ip6.arpa "4321:0:1:2:3:4:567:89ab")
"b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.0.1.2.3.4.ip6.arpa")
(check-equal?
(ip->ip6.arpa "2001:db8::567:89ab")
"b.a.9.8.7.6.5.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.8.b.d.0.1.0.0.2.ip6.arpa"))
(define (get-ptr-list-from-ans ans)
(filter (lambda (ans-entry) (eq? (list-ref ans-entry 1) 'ptr)) ans))
@ -420,7 +470,7 @@
(or (try-forwarding
(lambda (nameserver)
(let-values ([(auth? qds ans nss ars reply)
(dns-query/cache nameserver (ip->in-addr.arpa ip) 'ptr 'in)])
(dns-query/cache nameserver (ip->query-domain ip) 'ptr 'in)])
(values (and (positive? (length (get-ptr-list-from-ans ans)))
(let ([s (rr-data (car (get-ptr-list-from-ans ans)))])
(let-values ([(name null) (parse-name s reply)])

View File

@ -22,7 +22,6 @@
(dns-get-address nameserver *racket-host*) => *racket-ip*
(dns-get-address nameserver *kame-url* #:ipv6? #t) => *kame-ip*
(dns-get-name nameserver *racket-ip*) => *racket-host*
(dns-get-name nameserver *racket-ip*) => *racket-host*
(dns-get-mail-exchanger nameserver *racket-url*) => *racket-mx*))
(define (tests)