diff --git a/scheme/lib/dns.scm b/scheme/lib/dns.scm
index eeab0c4..6d45af9 100644
--- a/scheme/lib/dns.scm
+++ b/scheme/lib/dns.scm
@@ -1,12 +1,13 @@
 ; 
 ; dns.scm
 ;
-; Implementation of the RFC1035 
+; Client-Implementation of the RFC 1035 
 
 ;;; This file is part of the Scheme Untergrund Networking package.
 
 ;;; Copyright (c) 2002 by Marcus Crestani.
 ;;; Copyright (c) 2002-2003 by Martin Gasbichler
+;;; Copyright (c) 2005-2006 by Norbert Freudemann
 ;;; For copyright information, see the file COPYING which comes with
 ;;; the distribution.
 
@@ -16,9 +17,11 @@
 ;
 ; TODO: 
 ;       - test, test, test
+;       - could be a good thing to merge dns.scm with the dnsd/resolver.scm?
 ;       - types from newer RFCs (41, unknown)
 ;       - more documentation
 ;
+;
 ; ---
 ; sample usage & documentation:
 ;
@@ -103,7 +106,8 @@
 (define parse-error? (condition-predicate 'parse))
 
 (define-condition-type 'unexpected-eof-from-server '(dns-error))
-(define unexpected-eof-from-server? (condition-predicate 'unexpected-eof-from-server))
+(define unexpected-eof-from-server? 
+  (condition-predicate 'unexpected-eof-from-server))
 
 (define-condition-type 'bad-address '(dns-error))
 (define bad-address? (condition-predicate 'bad-address))
@@ -161,12 +165,12 @@
      ((no-nameserver-given)
       "dns-find-nameserver: no nameservers given")
      ((bad-nameserver)
-      "send-receive-message: could not establish connection to server (no valid nameserver given)")
+      "send-receive-message: could not establish connection to server(s)")
      ((not-a-hostname)
       "no hostname given")
      ((not-a-ip)
       "no ip given")
-     ((dns-format-error) 
+     ((dns-format-error)
       "error from server: (1) format error")
      ((dns-server-failure) 
       "error from server: (2) server failure")
@@ -179,48 +183,106 @@
      (else (error "Unknown dns-error" condition)))))
   
 
-;;; -- globals and types
-;; off
-(define *nul* (ascii->char 0))
+;; --- (Q)Type and (Q)Class of a Message: ---
 
-;; on
-(define *on* (ascii->char 1))
-
-;; message types
-(define-enumerated-type message-type :message-type
+;; Message Type:
+;; The IANA assigned type-values as in RFC 1035 and 3596 (IPv6) including the
+;; super-set QTYPE starting at value 252+ that are needed for some queries.
+(define-finite-type message-type :message-type
+  (value)
   message-type?
-  the-message-types
+  the-message-type
   message-type-name
-  message-type-number
-  (unknown				; types, which are not yet implemented
-   a					; a host address 
-   ns					; an authoritative name server
-   md					; (obsolete)
-   mf					; (obsolete)
-   cname				; the canonical name for an alias
-   soa					; marks the start of a zone of authority
-   mb					; (experimental)
-   mg					; (experimental)
-   mr					; (experimental)
-   null					; (experimental)
-   wks					; a well known service description
-   ptr					; a domain name pointer
-   hinfo				; host information
-   minfo				; (experimental)
-   mx					; mail exchange
-   txt))				; text strings
+  message-type-index
+  (value message-type-number)
+  ((unknown 0)      ; Types which are not yet implemented
+   (a 1)            ; A host address 
+   (ns 2)           ; An authoritative name server
+   (md 3)           ; Obsolete
+   (mf 4)           ; Obsolete
+   (cname 5)        ; The canonical name for an alias
+   (soa 6)          ; Marks the start of a zone of authority
+   (mb 7)           ; Experimental
+   (mg 8)           ; Experimental
+   (mr 9)           ; Experimental
+   (null 10)        ; Experimental
+   (wks 11)         ; A well known service description (deprecated in RFC 1123)
+   (ptr 12)         ; A domain name pointer
+   (hinfo 13)       ; Host information
+   (minfo 14)       ; Experimental
+   (mx 15)          ; Mail exchange
+   (txt 16)         ; Text strings
+   (aaaa 28)        ; An IPv6 host address
+   (axfr 252)       ; A request for a zone-transfer
+   (mailb 253)      ; A request for mailbox-related records
+   (maila 254)      ; Obsolete
+   (* 255)))        ; A request for all records
 
-;; message classes
-(define-enumerated-type message-class :message-class
+
+;; Search for a message type, given the IANA-assigned value.
+;; TYPE: number -> message-type or #f
+(define (message-type-number->type number)
+  (let loop ((n (vector-length the-message-type)))
+    (if (= n 0)
+	#f
+	(let ((m (- n 1)))
+	  (if (= number (message-type-number (vector-ref the-message-type m)))
+	      (vector-ref the-message-type m)
+	      (loop m))))))
+
+
+;; Returns the message-type for a symbol
+;; TYPE: symbol -> message-type or #f
+(define (message-type-symbol->type symbol)
+  (let loop ((n (vector-length the-message-type)))
+    (if (= n 0)
+	#f
+	(let ((m (- n 1)))
+	  (if (eq? symbol (message-type-name (vector-ref the-message-type m)))
+	      (vector-ref the-message-type m)
+	      (loop m))))))
+
+
+;; Message Classes:
+;; The resource-record class-values including the super-set QCLASS
+;; (* 255)...
+(define-finite-type message-class :message-class
+  (value)
   message-class?
-  the-message-classes
+  the-message-class
   message-class-name
-  message-class-number
-  (placeholder ; this starts at 0...
-   in      ; the Internet
-   cs      ; (obsolete)
-   ch      ; the CHAOS class
-   hs))    ; Hesoid
+  message-class-index
+  (value message-class-number)
+  ((in 1)             ; Internet
+   (cs 2)             ; Obsolete
+   (ch 3)             ; CHAOS
+   (hs 4)             ; Hesiod
+   (* 255)))          ; A QCLASS value: search for any class-entries.
+
+
+;; Search for a message class, given the IANA-assigned value.  
+;; TYPE: number -> message-class or #f
+(define (message-class-number->type number)
+  (let loop ((n (vector-length the-message-class)))
+    (if (= n 0)
+	#f
+	(let ((m (- n 1)))
+	  (if (= number (message-class-number (vector-ref the-message-class m)))
+	      (vector-ref the-message-class m)
+	      (loop m))))))
+
+
+;; Returns the message-class for a symbol
+;; TYPE: symbol -> message-class or #f
+(define (message-class-symbol->type symbol)
+  (let loop ((n (vector-length the-message-class)))
+    (if (= n 0)
+	#f
+	(let ((m (- n 1)))
+	  (if (eq? symbol (message-class-name (vector-ref the-message-class m)))
+	      (vector-ref the-message-class m)
+	      (loop m))))))
+
 
 
 ;;; -- useful stuff
@@ -265,6 +327,8 @@
     (cons
      (ascii->char (string-length s))
      (string->list s)))
+  
+  (define *nul* (ascii->char 0))
 
   (let loop ((s s))
     (cond
@@ -287,22 +351,9 @@
 (define (add-size-tag m)
   (append (number->octet-pair (length m)) m))
 
-
-
-
-;; 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)
-      (quotient (* (modulo (crank) 314159265)
-		   limit)
-		314159265))))
-
-;; checks if v is a address32
+;; checks if v is an address32
 (define (address32? v)
-  (and (number? v)
-       (<= 0 v #xffffffff)))
+  (and (number? v) (<= 0 v #xffffffff)))
       
 ;; filters types in a list of rrs 
 (define (filter-type list type)
@@ -314,10 +365,11 @@
 (define (sort-by-preference mx-list)
   (sort-list mx-list 
 	     (lambda (a b) 
-	       (< (resource-record-data-mx-preference (resource-record-data a)) (resource-record-data-mx-preference (resource-record-data b))))))
+	       (< (resource-record-data-mx-preference (resource-record-data a))
+		  (resource-record-data-mx-preference (resource-record-data b))))))
 
 
-;; returns a IP if available (additonal type-a processing)
+;; returns an IP if available (additonal type-a processing)
 (define (force-ip name)
   (let loop ((result (dns-lookup-name name)))
     (if (ip-string? result)
@@ -329,18 +381,83 @@
   (map (lambda (elem) (force-ip elem)) names))
 
 
-;; a standard query header, usefull for most queries
+;; ----------------------------------
+;; --- Dealing with domain names: ---
+;; ----------------------------------
+
+;; Regexp matching a label of a name
+(define label-regexp
+  (rx (: (| (: bos "." eos)
+	    (:
+	     bos
+	     (submatch (| "*" (: alphanumeric (* (| alphanumeric "-")))))
+	     "."
+	     (submatch (| "" (: alphanumeric (* any))))
+	     eos)))))
+
+
+;; Splits a name in its first label an the rest
+;; Note: (dn-split? "de." will be ("de" . "")
+;; TYPE: string -> (string . string) or #f
+(define (dn-split? name)
+  (cond
+   ((string=? name ".") #f)
+   ((regexp-search label-regexp name)
+    => (lambda (match)
+	 (cons (match:substring match 1)
+	       (match:substring match 2))))
+   (else #f)))
+
+
+;; Look if a string is a FQDN
+;; TYPE: string -> boolean
+(define (fqdn? name)
+  (let loop ((name name))
+    (cond
+     ((dn-split? name)
+      => (lambda (p)
+	   (let ((cp (cdr p)))
+	     (if (string=? cp "")
+		 #t
+		 (loop (cdr p))))))
+     (else #f))))
+
+
+;; Cuts the first label from a FQDN and returns the rest of the name.
+;; TYPE: string -> string
+(define (cut-name name)
+  (cond
+   ((regexp-search label-regexp name)
+    => (lambda (match)
+	 (let ((m (match:substring match 2)))
+	   (if (string=? m "") "." m))))
+   (else #f)))
+
+
+; Adds an ending dot to a string if neccessary.
+; TYPE: string -> string
+(define (make-fqdn-name name)
+  (let ((last-char (string-ref name (- (string-length name) 1))))
+    (if (not (char=? #\. last-char))
+	(string-append name ".")
+	name)))
+
+
+; --- Message Constructors: ---
+
+; A standard query header, usefull for most queries.
+; See RFC 1035 (4.1.1) for details.
 (define (make-std-query-header id question-count)
-  (let* ((qr 'query)        ; querytype: query 0, response 1
-	 (opcode 0)    ; opcode: query 0, iquery 1 (OBSOLETE), status 2
+  (let* ((qr 'query)    ; querytype: query 0, response 1
+	 (opcode 0)     ; opcode: query 0, iquery 1 (OBSOLETE: see RFC 3425), status 2
 	 (aa #f)        ; authorative answer (in answers only)
 	 (tc #f)        ; truncation (size matters only with UDP)
 	 (rd #t)        ; recursion desired: nameserver pursues the query recursivly (optional)
 	 (ra #f)        ; recursion available (in answers only)
-	 (zero 0)         ; future use
-         (response-code 0)     ; response code: error conditions (in answers only)
+	 (zero 0)       ; future use
+         (response-code 0)      ; response code: error conditions (in answers only)
 	 (question-count question-count)
-	 (answer-count 0)   ; answer count (in answers only)
+	 (answer-count 0)       ; answer count (in answers only)
 	 (nameserver-count 0)   ; name server resources (in answers only)
 	 (additional-count 0))  ; additional records (in answers only)
     
@@ -361,24 +478,13 @@
 		   (map question->octets questions)))))
 
 (define (make-simple-query-message name type class)
-  (make-query-message (make-std-query-header (random 256) 1)
+  (make-query-message (make-std-query-header (random-integer 65536) 1)
 		      (make-question name type class)))
 
-;; makes a resource record for ans, nss, ars (name, type, class, ttl, data)
-(define (make-octet-rr name type class ttl rdata)
-  (let* ((name (name->octets name))
-	 (type (number->octet-pair (message-type-number type)))
-	 (class (number->octet-pair (message-class-number class)))
-	 (ttl (number->octet-quad ttl))
-	 (rdlength (number->octet-pair (length rdata)))
-	 (rdata rdata))
-    (append name type class ttl rdlength rdata)))
-
-
 
 ;;; -- parsed message records
 
-;;; -- dns-message: complete data-structure of an dns-lookup
+;; dns-message: complete data-structure of an dns-lookup
 (define-record-type dns-message :dns-message
   (make-dns-message query reply cache? protocol tried-nameservers)
   dns-message?
@@ -397,7 +503,7 @@
   (answers message-answers)
   (nameservers message-nameservers)
   (additionals message-additionals)
-  (source message-source))
+  (source message-source set-message-source!)) ; The bite-encoded message
 
 ;; header
 (define-record-type header :header
@@ -407,9 +513,9 @@
   (id header-id)
   (flags header-flags)
   (question-count header-question-count)
-  (answer-count header-answer-count)
-  (nameserver-count header-nameserver-count)
-  (additional-count header-additional-count))
+  (answer-count header-answer-count set-header-answer-count!)
+  (nameserver-count header-nameserver-count set-header-nameserver-count!)
+  (additional-count header-additional-count set-header-additional-count!))
 
 ;;; -- message constructors: encode to octet-messages
 
@@ -436,16 +542,16 @@
   flags?
   (query-type            flags-query-type)
   (opcode                flags-opcode)
-  (authoritative?        flags-authoritative?)
-  (truncated?            flags-truncated?)
+  (authoritative?        flags-authoritative? set-flags-authoritative!)
+  (truncated?            flags-truncated? set-flags-truncated!)
   (recursion-desired?    flags-recursion-desired?)
-  (recursion-available?  flags-recursion-available?)
+  (recursion-available?  flags-recursion-available? set-flags-recursion-available!)
   (zero                  flags-zero)
-  (response-code         flags-response-code))
+  (response-code         flags-response-code set-flags-response-code!))
 
-(define (make-flags-from-numbers
-	 querytype opcode authoritative? truncated? recursion-desired? recursion-available? 
-	 zero response-code)
+(define (make-flags-from-numbers 
+	 querytype opcode authoritative? truncated? recursion-desired? 
+	 recursion-available? zero response-code)
   (make-flags
    (if (zero? querytype) 'query 'response)
    opcode
@@ -466,28 +572,45 @@
   (define (boolean->0/1 bool)
     (if bool 1 0))
   (list 
-   (ascii->char (+ (arithmetic-shift 
-		    (if (eq? (flags-query-type flags) 'query) 0 1) 7)
-		   (arithmetic-shift (flags-opcode flags) 3)
-		   (arithmetic-shift 
-		    (boolean->0/1 (flags-authoritative? flags)) 2)
-		   (arithmetic-shift 
-		    (boolean->0/1 (flags-truncated? flags)) 1)
-		   (boolean->0/1 (flags-recursion-desired? flags))))
-   (ascii->char (+ (arithmetic-shift 
-		    (boolean->0/1 (flags-recursion-available? flags)) 7)
-		   (arithmetic-shift (flags-zero flags) 4)
-		   (flags-response-code flags)))))
-
+   (ascii->char 
+    (+ (arithmetic-shift 
+	(if (eq? (flags-query-type flags) 'query) 0 1) 7)
+       (arithmetic-shift (flags-opcode flags) 3)
+       (arithmetic-shift 
+	(boolean->0/1 (flags-authoritative? flags)) 2)
+       (arithmetic-shift 
+	(boolean->0/1 (flags-truncated? flags)) 1)
+       (boolean->0/1 (flags-recursion-desired? flags))))
+   (ascii->char 
+    (+ (arithmetic-shift 
+	(boolean->0/1 (flags-recursion-available? flags)) 7)
+       (arithmetic-shift (flags-zero flags) 4)
+       (let ((response-code (flags-response-code flags)))
+	 (if (number? response-code)
+	     response-code
+	     (if (symbol? response-code)
+		 (case response-code
+		   ((dns-no-error) 0)
+		   ((dns-format-error) 1)
+		   ((dns-server-failure) 2)
+		   ((dns-name-error) 3)
+		   ((dns-not-implemented) 4)
+		   ((dns-refused) 5)))))))))
+		     
 
 ;; question
 (define-record-type question :question
-  (make-question name type class)
+  (really-make-question name type class)
   question?
   (name question-name)
   (type question-type)
   (class question-class))
 
+; Ensures the internal representation of a domain-name:
+(define (make-question name type class)
+  (really-make-question (make-fqdn-name name) type class))
+   
+
 ;; makes a question (name, type, class)
 (define (question->octets q)
   (let* ((qname   (name->octets (question-name q)))
@@ -517,13 +640,14 @@
 
 ;;; -- message parser
 
-;; parses a domain-name in an message. returns the name and the rest of the message.
+;; parses a domain-name in an message.
+;; returns the name and the rest of the message.
 (define (parse-name start message)
   (let ((v (char->ascii (car start))))
     (cond
      ((zero? v)
       ;; End of name
-      (values #f (cdr start)))
+      (values "." (cdr start)))
      ((zero? (bitwise-and #xc0 v))
       ;; Normal label
       (let loop ((len v)
@@ -535,9 +659,9 @@
 	   (lambda () (parse-name start message))
 	   (lambda (s start)
 	     (let ((s0 (list->string (reverse! accum))))
-	       (values (if s
-			   (string-append s0 "." s)
-			   s0)
+	       (values (if (string-ci=? s ".")
+			   (string-append s0 ".")
+			   (string-append s0 "." s))
 		       start)))))
 	 (else (loop (- len 1)
 		     (cdr start)
@@ -556,59 +680,74 @@
   (call-with-values
    (lambda () (parse-name start message))
    (lambda (name start)
-     (let ((type (vector-ref the-message-types 
-			     (octet-pair->number (car start) (cadr start))))
+     (let ((type (message-type-number->type 
+		  (octet-pair->number (car start) (cadr start))))
 	   (start (cddr start)))
-       (let ((class (vector-ref the-message-classes 
-				(octet-pair->number (car start) (cadr start))))
+       (let ((class (message-class-number->type
+		      (octet-pair->number (car start) (cadr start))))
 	     (start (cddr start)))
 	 (values (make-question name type class) start))))))
 
-;; parses a resourcerecord in a message. returns the rr and the rest of the message.
-
-(define (type-number->type type-number)
-  (if (>= type-number (vector-length the-message-types))
-      'unsupported-message-type
-      (vector-ref the-message-types type-number)))
-
-(define (class-number->class class-number)
-  (if (>= class-number (vector-length the-message-classes))
-      'unsupported-message-class
-      (vector-ref the-message-classes class-number)))
 
+;; parses a resource-record in a message. returns the rr and the
+;; rest of the message.
 (define (parse-rr start message)
+  
+  (define (type-number->type type-number)
+    (let ((type (message-type-number->type type-number)))
+      (if type
+	  type
+	  'unsupported-message-type)))
+ 
+  (define (class-number->class class-number)
+    (let ((class (message-class-number->type class-number)))
+      (if class
+	  class
+	  'unsupported-message-class)))
+  
   (call-with-values
-   (lambda () (parse-name start message))
-   (lambda (name start)
-     (let ((type  (type-number->type
-                   (octet-pair->number (car start) (cadr start))))
-	   (start (cddr start)))
-       (let ((class (class-number->class
-                     (octet-pair->number (car start) (cadr start))))
-	     (start (cddr start)))
-	 (let ((ttl (octet-quad->number (car start) (cadr start)
-					(caddr start) (cadddr start)))
-	       (start (cddddr start)))
-	   (let ((len (octet-pair->number (car start) (cadr start)))
-		 (start (cddr start)))
-	     ;; Extract next len bytes of data:
-	     (let loop ((len len)
-			(start start)
-			(accum '()))
-	       (if (zero? len)
-		   (values (make-resource-record name type class ttl (parse-resource-record-data type class (reverse! accum) message)) start)
-		   (loop (- len 1)
-			 (cdr start)
-			 (cons (car start) accum)))))))))))
+      (lambda () (parse-name start message))
+    (lambda (name start)
+      (let ((type  (type-number->type
+		    (octet-pair->number (car start) (cadr start))))
+	    (start (cddr start)))
+	(let ((class (class-number->class
+		      (octet-pair->number (car start) (cadr start))))
+	      (start (cddr start)))
+	  (let ((ttl (octet-quad->number (car start) (cadr start)
+					 (caddr start) (cadddr start)))
+		(start (cddddr start)))
+	    (let ((len (octet-pair->number (car start) (cadr start)))
+		  (start (cddr start)))
+	      ;; Extract next len bytes of data:
+	      (let loop ((len len)
+			 (start start)
+			 (accum '()))
+		(if (zero? len)
+		    (values (make-resource-record 
+			     name type class ttl 
+			     (parse-resource-record-data 
+			      type class (reverse! accum) message)) start)
+		    (loop (- len 1)
+			  (cdr start)
+			  (cons (car start) accum)))))))))))
 
-;;; -- resource-record-data-type records
+
+;; -- Resource-Record records: ---
+
+;; Data-Fields for the supported types of resource records:
 
 (define-record-type resource-record-data-a :resource-record-data-a
   (make-resource-record-data-a ip)
   resource-record-data-a?
   (ip resource-record-data-a-ip))
 
-(define-record-type resource-record-data-ns :resource-record-data-ns
+(define-record-type resource-record-data-aaaa :resource-record-data-aaaa
+  (make-resource-record-data-aaaa ipv6)
+  resource-record-data-aaaa?
+  (ipv6 resource-record-data-aaaa-ipv6))
+
+ (define-record-type resource-record-data-ns :resource-record-data-ns
   (make-resource-record-data-ns name)
   resource-record-data-ns?
   (name resource-record-data-ns-name))
@@ -618,8 +757,6 @@
   resource-record-data-cname?
   (name resource-record-data-cname-name))
 
-;; ###
-;; hinfo not correctly implemented, trying to find examples 
 (define-record-type resource-record-data-hinfo :resource-record-data-hinfo
   (make-resource-record-data-hinfo data)
   resource-record-data-hinfo?
@@ -647,25 +784,254 @@
   (expire resource-record-data-soa-expire)
   (minimum resource-record-data-soa-minimum))
 
-;; ### same as hinfo
 (define-record-type resource-record-data-txt :resource-record-data-txt
   (make-resource-record-data-txt text)
   resource-record-data-txt?
   (text resource-record-data-txt-text))
 
-;; ### same as hinfo and txt
+;; ## not corretly implemented (deprecated in RFC 1123)
 (define-record-type resource-record-data-wks :resource-record-data-wks
   (make-resource-record-data-wks data)
   resource-record-data-wks?
   (data resource-record-data-wks-data))
 
-;;
+
+;; --------------------------------------------------
+;; ---  Message-(Un)-Parser / message-compression ---
+;; --------------------------------------------------
+
+;; FQDNs are stored together with the assiciated pointer-number in
+;; an association-list (a-list)
+;; The octet-message is stored in the o-list
+
+
+;; Returns an (if possible) compressed octet-name
+;; TYPE: string x l-of-octets x l-of-names-> l-of-octets x l-of-names
+(define (mc-name->octets name o-list a-list)
+  ;; TYPE: string -> octets
+  (define (encode-label s)
+    (cons (ascii->char (string-length s)) (string->list s)))
+  ;; Returns elements from the list-of-names who matches name
+  (define (lookup? name a-list)
+    (let ((res
+	   (fold-right
+	    (lambda (e l)
+	      (if (string-ci=? name (car e))
+		  (cons e l)
+		  l))
+	    '()
+	    a-list)))
+      (if (null? res) #f res)))
+  ;; Create a pointer to another byte of an octet-message
+  (define (make-name-pointer number)
+    (if (<= number #x3FFF)
+	(number->octet-pair (bitwise-ior #xC000 number))
+	(error "This must be a very long message... .")))
+
+  (cond
+   ;; Nothing left?
+   ((or (string=? name "") (string=? name "."))
+    (values (append o-list (list (ascii->char 0))) a-list))
+   ;; Matching FQDN?
+   ((lookup? name a-list)
+    => (lambda (e)
+	 (values (append o-list (make-name-pointer (cdar e)))
+		 a-list)))
+   ;; Cut-and-retry:
+   (else
+    (let ((dn-pair (dn-split? name)))
+      (if dn-pair
+	  (mc-name->octets (cdr dn-pair)
+			   (append o-list (encode-label (car dn-pair)))
+			   (cons (cons name (length o-list)) a-list))
+	  (error "mc-name->octets: Not a FQDN!"))))))
+    
+
+;; Converts a message-question-record-type into octets
+;; TYPE: msg-question x l-of-octets x l-of-names -> l-of-octets x l-of-names
+(define (mc-question->octets q o-list a-list)
+  (receive (o-list a-list)
+	   (mc-name->octets (question-name q) o-list a-list)
+	   (values (append o-list
+			   (number->octet-pair 
+			    (message-type-number (question-type q)))
+			   (number->octet-pair 
+			    (message-class-number (question-class q))))
+		   a-list)))
+
+
+;; Translate the resource-record-data-*-content into octets.
+;; TYPE: RR x list-of-octets x list-of-names -> list-of-octets x list-of-names 
+(define (mc-rdata->octets rr o-list a-list)
+  ;; TXT and HINFO strings
+  (define (string-list->char-string-list l)
+    (let loop ((l l)
+	       (r '()))
+      (if (null? l)
+	  r
+	  (let ((len (string-length (car l))))
+	    (loop (cdr l)
+		  (append
+		   r
+		   (list (ascii->char len))
+		   (string->list (car l))))))))
+  
+  (let ((rr-data (resource-record-data rr)))
+    (cond
+     ;; Parser fallback:
+     ((list? rr-data)
+      (values (append o-list rr-data) a-list))
+     ;; Only IN supported...
+     ((eq? (message-class in) (resource-record-class rr))
+      (cond
+       ((resource-record-data-a? rr-data)
+	(values (append o-list
+			(address32->octet-ip 
+			 (resource-record-data-a-ip rr-data)))
+		a-list))
+       ((resource-record-data-aaaa? rr-data) ;; TODO!
+	(values (append o-list (resource-record-data-aaaa-ipv6 rr-data))
+		a-list))
+       ((resource-record-data-ns? rr-data)
+	(mc-name->octets (resource-record-data-ns-name rr-data) o-list a-list))
+       ((resource-record-data-cname? rr-data)
+	(mc-name->octets (resource-record-data-cname-name rr-data) 
+			 o-list a-list))
+       ((resource-record-data-mx? rr-data)
+	(mc-name->octets (resource-record-data-mx-exchanger rr-data)
+			 (append o-list
+				 (number->octet-pair 
+				  (resource-record-data-mx-preference rr-data)))
+			 a-list))
+       ((resource-record-data-ptr? rr-data)
+	(mc-name->octets (resource-record-data-ptr-name rr-data) o-list a-list))
+       ((resource-record-data-soa? rr-data)
+	(receive (o-list a-list)
+		 (mc-name->octets (resource-record-data-soa-mname rr-data) 
+				  o-list a-list)
+		 (receive (o-list a-list)
+			  (mc-name->octets 
+			   (resource-record-data-soa-rname rr-data)
+			   o-list a-list)
+			  (values
+			   (append o-list
+				   (number->octet-quad
+				    (resource-record-data-soa-serial rr-data))
+				   (number->octet-quad
+				    (resource-record-data-soa-refresh rr-data))
+				   (number->octet-quad
+				    (resource-record-data-soa-retry rr-data))
+				   (number->octet-quad
+				    (resource-record-data-soa-expire rr-data))
+				   (number->octet-quad
+				    (resource-record-data-soa-minimum rr-data)))
+			   a-list))))
+       ((resource-record-data-txt? rr-data)
+	(values (append o-list (string-list->char-string-list 
+				(resource-record-data-txt-text rr-data)))
+		a-list))
+       ((resource-record-data-hinfo? rr-data)
+	(values (append o-list (string-list->char-string-list 
+				(resource-record-data-hinfo-data rr-data))
+			a-list)))
+       ((resource-record-data-wks? rr-data) ;; Deprecated
+	(values (append o-list (resource-record-data-wks-data rr-data) a-list)))
+       (else (error "unknown-resource-record"))))
+     (else (error "class not supported")))))
+
+
+;; Handle the conversion of a RR into octets:
+;; TYPE: RR x list-of-octets x list-of-names -> list-of-octets x list-of-names
+(define (mc-resource-record->octets r o-list a-list)
+  (receive (o-list a-list)
+	   (mc-name->octets (resource-record-name r) o-list a-list)
+	   (let* ((o-list
+		   (append o-list
+			   (number->octet-pair
+			    (message-type-number (resource-record-type r)))
+			   (number->octet-pair
+			    (message-class-number (resource-record-class r)))
+			   (number->octet-quad (resource-record-ttl r))))
+		  ;; A placeholder value for RDLENGTH:
+		  (o-list-w (append o-list (number->octet-pair 0))))
+	     (receive (o-list-1 a-list-1)
+		      (mc-rdata->octets r o-list-w a-list)
+		      (let* ((l-ol (length o-list-w))
+			     (oc-data (list-tail o-list-1 l-ol)))
+			(values (append o-list
+					(number->octet-pair (length oc-data))
+					oc-data)
+				a-list-1))))))
+
+
+;; Converts a message-record-type into octets:
+;; TYPE: message -> octet-message
+(define (mc-message->octets m)
+  ;; Convert the RRs:
+  (define fold-proc-for-rrs
+    (lambda (e p)
+      (receive (o-list a-list)
+	       (mc-resource-record->octets e (car p) (cdr p))
+	       (cons o-list a-list))))
+
+  ;;(pretty-print-dns-message m)
+  (let* ((oct-header (header->octets (message-header m)))
+	 (oct-q-pair
+	  (fold ;; this is fold-left (srfi-1)
+	   (lambda (e p)
+	     (receive (o-list a-list)
+		      (mc-question->octets e (car p) (cdr p))
+		      (cons o-list a-list)))
+	   (cons oct-header '())
+	   (message-questions m)))
+	 (oct-answ-pair
+	  (fold fold-proc-for-rrs oct-q-pair (message-answers m)))
+	 (oct-auth-pair
+	  (fold fold-proc-for-rrs oct-answ-pair (message-nameservers m)))
+	 (oct-addi-pair
+	  (fold fold-proc-for-rrs oct-auth-pair (message-additionals m))))
+    (car oct-addi-pair)))
+
+
+
+;; ---
+
+;; Parse the resource records data-field:
 
 (define (parse-resource-record-data type class data message)
+
+  (define (list-head l k)
+    (if (<= k (length l))
+	(let loop ((k k)
+		   (l l)
+		   (r '()))
+	  (if (= 0 k)
+	      r
+	      (loop (- k 1)
+		    (cdr l)
+		    (append r (list (car l))))))
+	(error "list-head")))
+
+  (define (parse-char-strings data)
+    (let loop ((len (char->ascii (car data)))
+		(l (cdr data))
+		(res '()))
+       (let ((str (list->string (list-head l len))))
+	 (if (> (length l) len)
+	     (let ((tail (list-tail l len)))
+	       (loop (char->ascii (car tail))
+		     (cdr tail)
+		     (append res (list str))))
+	     (append res (list str))))))
+
   (cond
    ((eq? type (message-type a))
     (make-resource-record-data-a (octet-ip->address32 data)))
    
+   ((eq? type (message-type aaaa))
+    (make-resource-record-data-aaaa data)) ; TODO ...
+
+   
    ((eq? type (message-type ns))
     (make-resource-record-data-ns (call-with-values 
 		      (lambda () (parse-name data message))
@@ -706,11 +1072,14 @@
 			(rest (cddddr rest)))
 		    (make-resource-record-data-soa mname rname serial refresh retry expire minimum)))))))))))
 
-   ((eq? type (message-type hinfo))
-    (make-resource-record-data-hinfo (list->string data)))
-
+   ;; The TXT&Hinfo-Type contains one or more <character-strings> 
+   ;; (see. Ch.3.3// RFC 1035
    ((eq? type (message-type txt))
-    (make-resource-record-data-txt (list->string data)))
+    (make-resource-record-data-txt
+     (parse-char-strings data)))
+
+   ((eq? type (message-type hinfo))
+    (parse-char-strings data))
    
    ((eq? type (message-type wks))
     (make-resource-record-data-wks data))
@@ -791,13 +1160,15 @@
     (if (not (eq? response-code 'dns-no-error))
 	(dns-error response-code))))
 
-
 (define *max-tries* 3)
 (define *timeout* 1)
 
 ;; connects to nameserver and sends and receives messages. returns the reply.
 ;; here: via TCP
-(define (send-receive-message-tcp nameservers query)
+(define (send-receive-message-tcp nameserver query)
+  (send-receive-message-tcp-int nameserver query reply-acceptable?))
+
+(define (send-receive-message-tcp-int nameservers query accept?)
   (receive (reply hit-ns other-nss)
 	   (let ((sockets (map
 			   (lambda (nameserver)
@@ -843,7 +1214,8 @@
 			(ws-new (delete-list tried-channels ws)))
 		 (if (or (null? ws-new) (>= number-tries *max-tries*))
 		     (dns-error 'bad-nameserver)
-		     (let ((ready (apply select-port-channels *timeout* ws)))
+		     (let ((ready (apply select-ports *timeout* ws)))
+;;		     (let ((ready (apply select-port-channels *timeout* ws)))
 		       (if (= (length tried-channels) (length ws))
 			   (dns-error 'bad-nameserver)
 			   (let loop-ready-channels ((ready-channels ready))
@@ -876,13 +1248,14 @@
 									  (delete hit-ns nameservers))))))))))))))))))))
 	   (lambda ()
 	     (for-each close-socket sockets)))))
-    (reply-acceptable? reply query)
-    (values reply
-	    hit-ns
-	    other-nss)))
+    (accept? reply query)
+    (values reply hit-ns other-nss)))
 
 ;; here: via UDP
-(define (send-receive-message-udp nameservers query)
+(define (send-receive-message-udp nameserver query)
+  (send-receive-message-udp-int nameserver query reply-acceptable?))
+
+(define (send-receive-message-udp-int nameservers query accept?)
   (receive (reply hit-ns other-nss)
       (let ((sockets (map (lambda (nameserver)
 			    (let ((sock (create-socket protocol-family/internet
@@ -915,7 +1288,8 @@
 			  (rs-new (delete-list tried-channels rs)))
 		   (if (or (null? rs-new) (>= number-tries *max-tries*))
 		       (dns-error 'bad-nameserver)
-		       (let ((ready (apply select-port-channels *timeout* rs-new)))
+		       (let ((ready (apply select-ports *timeout* rs-new))) 
+;;		       (let ((ready (apply select-port-channels *timeout* rs-new))) 
 			 (if (= (length tried-channels) (length rs))
 			     (dns-error 'bad-nameserver)
 			     (let loop-ready-channels ((ready-channels ready))
@@ -934,22 +1308,21 @@
 						       (delete hit-ns nameservers)))))))))))))))
 	   (lambda ()
 	     (for-each close-socket sockets)))))
-      (reply-acceptable? reply query)
+      (accept? reply query)
       (if (flags-truncated? (header-flags (message-header reply)))
-	  (send-receive-message-tcp nameservers query)
-	  (values reply
-		  hit-ns
-		  other-nss))))
+	  (send-receive-message-tcp-int nameservers query accept?)
+	  (values reply hit-ns other-nss))))
+
 
 
 ;;; -- cache
 
 ;; creates the cache, an empty string-table
-(define cache (make-string-table))
-
+(define *cache* (make-string-table))
+ 
 ;; resets the cache
 (define (dns-clear-cache!)
-  (set! cache (make-string-table)))
+  (set! *cache* (make-string-table)))
 
 ;; searches in a dns-msg for the shortest ttl. this is needed for cache-management.
 (define (find-shortest-ttl dns-msg)
@@ -986,7 +1359,7 @@
 
 (define (lookup-cache qds nameserver)
   (let* ((key (make-key qds nameserver))
-	 (found-data (table-ref cache key)))
+	 (found-data (table-ref *cache* key)))
     (cond
      ((and found-data
 	   ;; checks if cached-data is still valid
@@ -995,7 +1368,7 @@
      (else #f))))
 
 (define (update-cache! key entry)
-  (table-set! cache key entry))
+  (table-set! *cache* key entry))
 
 (define (dns-query-no-cache query protocol nameservers tried)
 	 ;; returns new retrieved data
@@ -1010,14 +1383,15 @@
   (let ((qds (message-questions query)))
     (let lp ((ns nameservers))
       (if (null? ns)
-	  (receive (reply-msg hit-ns nss-with-no-reply)
-	      (send-receive-message nameservers query protocol)
-	    (update-cache! (make-key qds hit-ns) 
-			   (make-cache reply-msg (find-shortest-ttl reply-msg) (time)))
-	    ;; returns new retrieved data and updates cache
-	    (values (make-dns-message query reply-msg #f protocol (reverse tried))
-		    hit-ns
-		    nss-with-no-reply))
+	  (receive 
+	   (reply-msg hit-ns nss-with-no-reply)
+	   (send-receive-message nameservers query protocol)
+	   (update-cache! (make-key qds hit-ns) 
+			  (make-cache reply-msg (find-shortest-ttl reply-msg) (time)))
+	   ;; returns new retrieved data and updates cache
+	   (values (make-dns-message query reply-msg #f protocol (reverse tried))
+		   hit-ns
+		   nss-with-no-reply))
 	  (cond ((lookup-cache qds (car ns))
 		 => (lambda (found-data)
 		      ;; returns cached data
@@ -1052,32 +1426,54 @@
 ;;  normally the recursion is done for us by the nameserver istself, but
 ;;  this feature is technically optional (RFC 1035).
 ;;  dns-get-information implements the resovler-side recursion.
-;;  it returns a dns-message
+;;  it returns a dns-message. 
+;   (The means of trying recursion are given by the check-answer proc)
+
+
 (define (dns-get-information query protocol check-answer . args)
   (receive (nameservers use-cache?) (lookup-optional-args args)
     (let lp ((tried '()) (nss nameservers))
+      (display "Tried nameservers: ")
+      (map (lambda (x) (display (address32->ip-string x)) (display " ")) tried)(newline)
+      (display "Nameserver list: ")
+      (map (lambda (x) (display (address32->ip-string x)) (display " ")) nss)(newline)
       (if (null? nss)
 	  (if (null? tried)
 	      (dns-error 'no-nameserver-given)
 	      (dns-error 'bad-address))
-	  (receive (dns-msg hit-ns nss-with-no-reply)
-	      (dns-query/cache query use-cache? protocol nss tried)
-	    (if (check-answer dns-msg)
-		dns-msg
-		(let ((auth? (flags-authoritative? (header-flags
-						    (message-header
-						     (dns-message-reply dns-msg))))))
-		  (if auth?
-		      (dns-error 'bad-address)
-		      ;; other nameservers names are found in the nameserver-part,
-		      ;; but their ip-adresses are found in the additonal-rrs
-		      (let ((other-nameservers 
-			     (filter (lambda (elem) (eq? (resource-record-type elem) (message-type a)))
-				     (message-additionals (dns-message-reply dns-msg)))))
-			(lp (if (not (member hit-ns tried)) (cons hit-ns tried) tried)
-			    (lset-union equal?
-					nss-with-no-reply
-					(lset-difference equal? other-nameservers tried))))))))))))
+	  (receive 
+	   (dns-msg hit-ns nss-with-no-reply)
+	   (dns-query/cache query use-cache? protocol nss tried)
+	   (if (check-answer dns-msg)
+	       dns-msg
+	       (let ((auth? (flags-authoritative? 
+			     (header-flags
+			      (message-header
+			       (dns-message-reply dns-msg))))))
+		 (if auth?
+		     (dns-error 'bad-address)
+		     ;; other nameservers names are found in the nameserver-part,
+		     ;; but their ip-adresses are found in the additonal-rrs
+		     (let* ((other-nameservers-rr
+			     (filter (lambda (elem) 
+				       (eq? (resource-record-type elem) 
+					    (message-type a)))
+				     (message-additionals 
+				      (dns-message-reply dns-msg))))
+			    (other-nameservers
+			     (map (lambda (e)
+				    (resource-record-data-a-ip
+				     (resource-record-data e)))
+				  other-nameservers-rr)))
+		       (lp (if (not (member hit-ns tried)) 
+			       (cons hit-ns tried) 
+			       tried)
+			   (lset-union equal?
+				       nss-with-no-reply
+				       (lset-difference equal?
+							other-nameservers 
+							tried))))))))))))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Parsing of /etc/resolv.conf
@@ -1108,7 +1504,6 @@
     (if match
 	(cons 'domain (match:substring match 1))
 	(signal 'resolv.conf-parse-error))))
-
 (define (parse-search rest-of-line)
   (let ((domains (regexp-fold-right domain-name-regexp 
 				    (lambda (match junk accu)
@@ -1581,7 +1976,9 @@
 	     (d 4 "ttl  " (resource-record-ttl dns-msg))
 	     (d 4 "data " "") (show-dns-message (resource-record-data dns-msg))))
 	  ((resource-record-data-a? dns-msg)
-	   (d 5 "ip " (resource-record-data-a-ip dns-msg)))
+	   (d 5 "ip " (address32->ip-string (resource-record-data-a-ip dns-msg))))
+	  ((resource-record-data-aaaa? dns-msg)
+	   (d 5 "ipv6 " (resource-record-data-aaaa-ipv6 dns-msg)))
 	  ((resource-record-data-ns? dns-msg)
 	   (d 5 "name " (resource-record-data-ns-name dns-msg)))
 	  ((resource-record-data-cname? dns-msg)
@@ -1598,8 +1995,9 @@
 	     (d 5 "rname   " (resource-record-data-soa-rname dns-msg))
 	     (d 5 "serial  " (resource-record-data-soa-serial dns-msg))
 	     (d 5 "refresh " (resource-record-data-soa-refresh dns-msg))
+	     (d 5 "retry   " (resource-record-data-soa-retry dns-msg))
 	     (d 5 "expire  " (resource-record-data-soa-expire dns-msg))
-	     (d 5 "minimum " (resource-record-data-soa-expire dns-msg))))
+	     (d 5 "minimum " (resource-record-data-soa-minimum dns-msg))))
 	  ;; ###
 	  ((resource-record-data-hinfo? dns-msg)
 	   (d 5 "data " (resource-record-data-hinfo-data dns-msg)))
@@ -1670,4 +2068,3 @@
 
 (define (system-fqdn . args)
   (apply host-fqdn (system-name) args))
-