From 5f88c2738264cd2d7538bd2d0ecf13023631f8ee Mon Sep 17 00:00:00 2001 From: mainzelm Date: Fri, 29 Nov 2002 17:08:14 +0000 Subject: [PATCH] + Removed *debug* + some renamings + explained nomenclature --- scheme/lib/dns.scm | 76 +++++++++++++++++----------------------------- 1 file changed, 28 insertions(+), 48 deletions(-) diff --git a/scheme/lib/dns.scm b/scheme/lib/dns.scm index e3469aa..15ae279 100644 --- a/scheme/lib/dns.scm +++ b/scheme/lib/dns.scm @@ -84,11 +84,6 @@ - -;;; should debug-msgs be printed out? -(define *debug* #f) - - ;; --- error conditions ;; supertype of all errors signaled by this library @@ -219,28 +214,34 @@ ;; assoc the other way round (define (cossa i l) - (if *debug* (display "cossa\n")) (cond ((null? l) 'unknown) ((equal? (cadar l) i) (car l)) (else (cossa i (cdr l))))) +;; number: 0<= x < 256 +;; octet-pair: (char char) +;; octet-quad: (char char char char) +;; name: string *{"." string} +;; octets: *{(char *char)} nullchar +;; octet-ip: (char char char char) +;; address32: 0 <= x < 2^32-1 +;; ip-string: "www.xxx.yyy.zzz" +;; ip-string-arpa: "zzz.yyy.xxx.www.in-addr.arpa" + ;; encodes numbers (16bit) to octets (define (number->octet-pair n) - (if *debug* (display "number->octet-pair\n")) (list (ascii->char (arithmetic-shift n -8)) (ascii->char (modulo n 256)))) ;; decodes octets to numbers (16bit) (define (octet-pair->number a b) - (if *debug* (display "octet-pair->number\n")) (+ (arithmetic-shift (char->ascii a) 8) (char->ascii b))) ;; encodes numbers (32bit) to octets, needed for ttl (define (number->octet-quad n) - (if *debug* (display "number->octet-quad\n")) (list (ascii->char (arithmetic-shift n -24)) (ascii->char (modulo (arithmetic-shift n -16) 256)) (ascii->char (modulo (arithmetic-shift n -8) 256)) @@ -248,7 +249,6 @@ ;; decodes octets to numbers, needed for 32bit ttl (define (octet-quad->number a b c d) - (if *debug* (display "octet-quad->number\n")) (+ (arithmetic-shift (char->ascii a) 24) (arithmetic-shift (char->ascii b) 16) (arithmetic-shift (char->ascii c) 8) @@ -261,7 +261,6 @@ (ascii->char (string-length s)) (string->list s))) - (if *debug* (display "name->octets\n")) (let loop ((s s)) (cond ((regexp-search (rx (: bos (submatch (* (~ "."))) "." (submatch (* any)))) @@ -273,6 +272,7 @@ (else (if (= 0 (string-length s)) (list *nul*) + ;;; TODO isn't this case an error? (append (encode-portion s) (list *nul*))))))) @@ -280,12 +280,10 @@ ;; for tcp: message has to be tagged with its length (define (add-size-tag m) - (if *debug* (display "add-size-tag\n")) (append (number->octet-pair (length m)) m)) ;; converts an octeted-ip to a 32bit integer internet-address (define (octet-ip->address32 ip) - (if *debug* (display "octet-ip->address32\n")) (+ (arithmetic-shift (char->ascii (list-ref ip 0)) 24) (arithmetic-shift (char->ascii (list-ref ip 1)) 16) (arithmetic-shift (char->ascii (list-ref ip 2)) 8) @@ -293,7 +291,6 @@ ;; converts a 32 bit integer internet-address to an octeted-ip (define (address32->octet-ip ip) - (if *debug* (display "number->octet-quad\n")) (list (arithmetic-shift ip -24) (modulo (arithmetic-shift ip -16) 256) (modulo (arithmetic-shift ip -8) 256) @@ -301,12 +298,10 @@ ;; converts an ip-string to an 32bit integer internet-address (define (ip-string->address32 ip) - (if *debug* (display "ip-string->address32\n")) - (octet-ip->address32 (string->octet-ip ip))) + (octet-ip->address32 (ip-string->octet-ip ip))) ;; converts an ip-string to an 32bit integer internet-address (define (address32->ip-string ip) -; (if *debug* (display "address32->ip-string\n")) (format #f "~a.~a.~a.~a" (arithmetic-shift ip -24) @@ -315,8 +310,7 @@ (modulo ip 256))) ;; converts an octeted-ip to an human readable ip-string -(define (octet-ip->string s) - (if *debug* (display "octet-ip->string\n")) +(define (octet-ip->ip-string s) (format #f "~a.~a.~a.~a" (char->ascii (list-ref s 0)) @@ -332,7 +326,7 @@ eos))) ;; converts an ip-string to octets -(define (string->octet-ip s) +(define (ip-string->octet-ip s) (cond ((regexp-search ip-string-regexp s) => (lambda (match) @@ -345,6 +339,7 @@ (error "invalid ip-string" s)))) ;; calculates a "random" number, needed for message-ids +;; TODO use SRFI-27 (define random (let ((crank (make-random (modulo (time) (- (expt 2 27) 1))))) (lambda (limit) @@ -375,7 +370,7 @@ (<= 0 v #xffffffff))) ;; returns a in-addr.arpa name-string or #f (needed to resolve hostname by ip) -(define (ip-string->in-addr s) +(define (ip-string->in-addr-arpa s) (cond ((regexp-search ip-string-regexp s) => (lambda (match) @@ -389,7 +384,6 @@ ;; filters types in a list of rrs (define (filter-type list type) - (if *debug* (display "ip-string->in-addr\n")) (filter (lambda (rr) (eq? (rr:type rr) type)) list)) @@ -417,7 +411,6 @@ ;; makes an message header (define (make-octet-header id qr opcode aa tc rd ra z rcode qdcount ancount nscount arcount) - (if *debug* (display "make-octet-header\n")) (let* ((header-id (number->octet-pair id)) (header-flags (list (ascii->char (+ (arithmetic-shift qr 7) @@ -442,7 +435,6 @@ ;; a standard query header, usefull for most queries (define (make-std-octet-query-header id question-count) - (if *debug* (display "make-std-octet-query-header\n")) (let* ((qr 0) ; querytype: query 0, response 1 (opcode 0) ; opcode: query 0, iquery 1 (OBSOLETE), status 2 (aa 0) ; authorative answer (in answers only) @@ -461,7 +453,6 @@ ;; makes a question (name, type, class) (define (make-octet-question name type class) - (if *debug* (display "make-octet-question\n")) (if (not (assoc type types)) (dns-error 'invalid-type)) (if (not (assoc class classes)) @@ -475,7 +466,6 @@ ;; makes a query-message (header and question only) (define (make-octet-query-message id name type class) - (if *debug* (display "make-octet-query-message\n")) (append (make-std-octet-query-header id 1) (make-octet-question name type class))) @@ -483,7 +473,6 @@ ;; makes a resource record for ans, nss, ars (name, type, class, ttl, data) (define (make-octet-rr name type class ttl rdata) - (if *debug* (display "make-octet-rr\n")) (let* ((name (name->octets name)) (type (number->octet-pair (cadr (assoc type types)))) (class (number->octet-pair (cadr (assoc class classes)))) @@ -557,7 +546,6 @@ ;; parses a domain-name in an message. returns the name and the rest of the message. (define (parse-name start message) - (if *debug* (display "parse-name\n")) (let ((v (char->ascii (car start)))) (cond ((zero? v) @@ -592,7 +580,6 @@ ;; parses a question in a message. returns the question and the rest of the message. (define (parse-question start message) - (if *debug* (display "parse-question\n")) (call-with-values (lambda () (parse-name start message)) (lambda (name start) @@ -604,7 +591,6 @@ ;; parses a resourcerecord in a message. returns the rr and the rest of the message. (define (parse-rr start message) - (if *debug* (display "parse-rr\n")) (call-with-values (lambda () (parse-name start message)) (lambda (name start) @@ -670,7 +656,6 @@ ;; (define (parse-rr-data type class data message) - (if *debug* (display "parse-rr-data\n")) (cond ((eq? type 'a) (make-rr-data-a (octet-ip->address32 data))) @@ -728,7 +713,6 @@ ;; parses n-times a message with parse. returns a list of parse-returns. (define (parse-n parse start message n) - (if *debug* (display "parse-n\n")) (let loop ((n n) (start start) (accum '())) (if (zero? n) (values (reverse! accum) start) @@ -739,7 +723,6 @@ ;; parses a message-headers flags. returns the flags. (define (parse-flags message) - (if *debug* (display "parse-flags\n")) (let ((v0 (list-ref message 2)) (v1 (list-ref message 3))) ;; Check for error code: @@ -756,7 +739,6 @@ ;; parses a message-header. returns the header. (define (parse-header message) - (if *debug* (display "parse-header\n")) (let ((id (octet-pair->number (list-ref message 0) (list-ref message 1))) (flags (parse-flags message)) (qd-count (octet-pair->number (list-ref message 4) (list-ref message 5))) @@ -768,7 +750,6 @@ ;; parses a message. returns the parsed message. (define (parse message) - (if *debug* (display "parse\n")) (let* ((header (parse-header message)) (start (list-tail message 12))) (call-with-values @@ -793,7 +774,6 @@ ;; checks if the received reply is valid. returns #t or error-msg. (define (reply-acceptable? reply query) - (if *debug* (display "reply-acceptable?\n")) ;; Check correct id (if (not (and (char=? (car reply) (car query)) (char=? (cadr reply) (cadr query)))) @@ -864,7 +844,6 @@ ;; here: via UDP (define (send-receive-message-udp nameservers query) - (if *debug* (display "send-receive-message\n")) (receive (reply hit-ns other-nss) (let ((sockets (map (lambda (nameserver) (let ((sock (create-socket protocol-family/internet @@ -918,7 +897,6 @@ ;; searches in a dns-msg for the shortest ttl. this is needed for cache-management. (define (find-shortest-ttl dns-msg) - (if *debug* (display "find-shortest-ttl\n")) (letrec ((minimum #f) (find-shortest-ttl-1 (lambda (dns-msg) @@ -1079,8 +1057,8 @@ ;; dns-lookup with more options than dns-lookup-* (define (dns-lookup name type . nameservers) (let* ((maybe-ip-string (if (address32? name) - (ip-string->in-addr (address32->ip-string name)) - (ip-string->in-addr name))) + (ip-string->in-addr-arpa (address32->ip-string name)) + (ip-string->in-addr-arpa name))) (question (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (make-octet-query-message (random 256) maybe-ip-string type 'in) (make-octet-query-message (random 256) name type 'in))) @@ -1101,8 +1079,8 @@ ;; (dns-lookup-name nameservers) (define (dns-lookup-name name . nameservers) (let* ((maybe-ip-string (if (address32? name) - (ip-string->in-addr (address32->ip-string name)) - (ip-string->in-addr name))) + (ip-string->in-addr-arpa (address32->ip-string name)) + (ip-string->in-addr-arpa name))) (question (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (dns-error 'not-a-hostname) (make-octet-query-message (random 256) name 'a 'in))) @@ -1121,8 +1099,8 @@ ;; (dns-inverse-lookup [nameserver]) (define (dns-lookup-ip ip . nameservers) (let* ((maybe-ip-string (if (address32? ip) - (ip-string->in-addr (address32->ip-string ip)) - (ip-string->in-addr ip))) + (ip-string->in-addr-arpa (address32->ip-string ip)) + (ip-string->in-addr-arpa ip))) (question (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (make-octet-query-message (random 256) maybe-ip-string 'ptr 'in) (dns-error 'not-a-ip))) @@ -1144,8 +1122,8 @@ ;; (dns-lookup-nameserver [nameserver]) (define (dns-lookup-nameserver name . nameservers) (let* ((maybe-ip-string (if (address32? name) - (ip-string->in-addr (address32->ip-string name)) - (ip-string->in-addr name))) + (ip-string->in-addr-arpa (address32->ip-string name)) + (ip-string->in-addr-arpa name))) (question (if maybe-ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (dns-error 'not-a-hostname) (make-octet-query-message (random 256) name 'ns 'in))) @@ -1174,8 +1152,8 @@ ;; (dns-lookup-mail-exchanger [nameserver]) (define (dns-lookup-mail-exchanger name . nameservers) (let* ((ip-string (if (address32? name) - (ip-string->in-addr (address32->ip-string name)) - (ip-string->in-addr name))) + (ip-string->in-addr-arpa (address32->ip-string name)) + (ip-string->in-addr-arpa name))) (question (if ip-string ; if name is a ip-addr, the query is a in-addr.arpa address (dns-error 'not-a-hostname) (make-octet-query-message (random 256) name 'mx 'in))) @@ -1337,6 +1315,7 @@ (define (host-fqdn name-or-socket-address) (if (socket-address? name-or-socket-address) (socket-address->fqdn name-or-socket-address #f) + ;; TODO: try looking up with domain from "search" appended (internet-address->fqdn (car (host-info:addresses @@ -1345,5 +1324,6 @@ ;;; TODO THIS USES gethostbyname (define (system-fqdn) + ;; TODO: isn't this simply (host-fqdn (system-name))? (internet-address->fqdn (car (host-info:addresses (host-info (system-name)))) #t))