8e05211169
The new `dns-get-srv` returns a *list* of srv-rr structs, rather than zero or one. A general-purpose RR-lookup routine, `dns-lookup`, exists but is not exported for now since its API needs work. See comments in net/dns.rkt.
68 lines
1.9 KiB
Racket
68 lines
1.9 KiB
Racket
#lang racket/base
|
|
;; Utilities for parsing and unparsing various pieces of DNS wire formats.
|
|
|
|
(provide number->octet-pair
|
|
octet-pair->number
|
|
octet-quad->number
|
|
parse-name
|
|
name->octets
|
|
rr-data
|
|
rr-type
|
|
rr-name)
|
|
|
|
(define (number->octet-pair n)
|
|
(list (arithmetic-shift n -8)
|
|
(modulo n 256)))
|
|
|
|
(define (octet-pair->number a b)
|
|
(+ (arithmetic-shift a 8) b))
|
|
|
|
(define (octet-quad->number a b c d)
|
|
(+ (arithmetic-shift a 24)
|
|
(arithmetic-shift b 16)
|
|
(arithmetic-shift c 8)
|
|
d))
|
|
|
|
(define (parse-name start reply)
|
|
(define v (car start))
|
|
(cond
|
|
[(zero? v)
|
|
;; End of name
|
|
(values #f (cdr start))]
|
|
[(zero? (bitwise-and #xc0 v))
|
|
;; Normal label
|
|
(let loop ([len v] [start (cdr start)] [accum null])
|
|
(if (zero? len)
|
|
(let-values ([(s start) (parse-name start reply)])
|
|
(define s0 (list->bytes (reverse accum)))
|
|
(values (if s (bytes-append s0 #"." s) s0)
|
|
start))
|
|
(loop (sub1 len) (cdr start) (cons (car start) accum))))]
|
|
[else
|
|
;; Compression offset
|
|
(define offset (+ (arithmetic-shift (bitwise-and #x3f v) 8)
|
|
(cadr start)))
|
|
(define-values [s ignore-start] (parse-name (list-tail reply offset) reply))
|
|
(values s (cddr start))]))
|
|
|
|
;; Bytes -> LB
|
|
;; Convert the domain name into a sequence of labels, where each
|
|
;; label is a length octet and then that many octets
|
|
(define (name->octets s)
|
|
(define (do-one s) (cons (bytes-length s) (bytes->list s)))
|
|
(let loop ([s s])
|
|
(define m (regexp-match #rx#"^([^.]*)[.](.*)" s))
|
|
(if m
|
|
(append (do-one (cadr m)) (loop (caddr m)))
|
|
;; terminate with zero length octet
|
|
(append (do-one s) (list 0)))))
|
|
|
|
(define (rr-data rr)
|
|
(cadddr (cdr rr)))
|
|
|
|
(define (rr-type rr)
|
|
(cadr rr))
|
|
|
|
(define (rr-name rr)
|
|
(car rr))
|