From f9474b7a16ed5a96d8e2426c09d9b3e849cf9b97 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Wed, 15 Jan 2003 12:17:54 +0000
Subject: [PATCH] Replaced define-record by define-record-type

---
 scheme/lib/dns.scm  | 381 ++++++++++++++++++++++++--------------------
 scheme/packages.scm |   2 +-
 2 files changed, 208 insertions(+), 175 deletions(-)

diff --git a/scheme/lib/dns.scm b/scheme/lib/dns.scm
index 7640992..4c8a2e9 100644
--- a/scheme/lib/dns.scm
+++ b/scheme/lib/dns.scm
@@ -385,14 +385,14 @@
 ;; filters types in a list of rrs 
 (define (filter-type list type)
   (filter (lambda (rr) 
-	    (eq? (rr:type rr) type))
+	    (eq? (rr-type rr) type))
 	  list))
 
 ;; sorts a mx-rr-list by preference. needed for dns-lookup-mail-exchanger.
 (define (sort-by-preference mx-list)
   (sort-list mx-list 
 	     (lambda (a b) 
-	       (< (rr-data-mx:preference (rr:data a)) (rr-data-mx:preference (rr:data b))))))
+	       (< (rr-data-mx-preference (rr-data a)) (rr-data-mx-preference (rr-data b))))))
 
 
 ;; returns a IP if available (additonal type-a processing)
@@ -486,61 +486,76 @@
 ;;; -- parsed message records
 
 ;;; -- dns-message: complete data-structure of an dns-lookup
-(define-record dns-message
-  query
-  reply
-  cache?
-  protocol
-  tried-nameservers)
+(define-record-type dns-message :dns-message
+  (make-dns-message query reply cache? protocol tried-nameservers)
+  dns-message?
+  (query dns-message-query)
+  (reply dns-message-reply)
+  (cache? dns-message-cache?)
+  (protocol dns-message-protocol)
+  (tried-nameservers dns-message-tried-nameservers))
 
 ;; message
-(define-record message
-  header
-  questions
-  answers
-  nameservers
-  additionals
-  source)
+(define-record-type message :message
+  (make-message header questions answers nameservers additionals source)
+  message?
+  (header message-header)
+  (questions message-questions)
+  (answers message-answers)
+  (nameservers message-nameservers)
+  (additionals message-additionals)
+  (source message-source))
 
 ;; header
-(define-record header
-  id
-  flags
-  qdc
-  anc
-  nsc
-  arc)
+(define-record-type header :header
+  (make-header id flags qdc anc nsc arc)
+  header?
+  (id header-id)
+  (flags header-flags)
+  (qdc header-qdc)
+  (anc header-anc)
+  (nsc header-nsc)
+  (arc header-arc))
 
 ;; flags
-(define-record flags
-  querytype
-  opcode
-  auth
-  trunc
-  recursiondesired
-  recursionavailable
-  z
-  rcode)
+(define-record-type flags :flags
+  (make-flags querytype opcode auth trunc recursiondesired recursionavailable 
+	      z rcode)
+  flags?
+  (querytype           flags-querytype)
+  (opcode              flags-opcode)
+  (auth                flags-auth)
+  (trunc               flags-trunc)
+  (recursiondesired    flags-recursiondesired)
+  (recursionavailable  flags-recursionavailable)
+  (z                   flags-z)
+  (rcode               flags-rcode))
 
 ;; question
-(define-record question
-  name
-  type
-  class)
+(define-record-type question :question
+  (make-question name type class)
+  question?
+  (name question-name)
+  (type question-type)
+  (class question-class))
 
-;; rr
-(define-record rr
-  name
-  type
-  class
-  ttl
-  data)
+;;type  rr
+(define-record-type rr :rr
+  (make-rr name type class ttl data)
+  rr?
+  (name  rr-name)
+  (type  rr-type)
+  (class rr-class)
+  (ttl   rr-ttl)
+  (data  rr-data))
 
 ;; cache
-(define-record cache
-  answer
-  ttl
-  time)
+(define-record-type cache :cache
+  (make-cache answer ttl time)
+  cache?
+  (answer cache-answer)
+  (ttl cache-ttl)
+  (time cache-time))
 
 ;;; -- message parser
 
@@ -615,43 +630,61 @@
 
 ;;; -- rr-data-type records
 
-(define-record rr-data-a
-  ip)
+(define-record-type rr-data-a :rr-data-a
+  (make-rr-data-a ip)
+  rr-data-a?
+  (ip rr-data-a-ip))
 
-(define-record rr-data-ns
-  name)
+(define-record-type rr-data-ns :rr-data-ns
+  (make-rr-data-ns name)
+  rr-data-ns?
+  (name rr-data-ns-name))
 
-(define-record rr-data-cname
-  name)
+(define-record-type rr-data-cname :rr-data-cname
+  (make-rr-data-cname name)
+  rr-data-cname?
+  (name rr-data-cname-name))
 
 ;; ###
 ;; hinfo not correctly implemented, trying to find examples 
-(define-record rr-data-hinfo  
-  data)                       
+(define-record-type rr-data-hinfo :rr-data-hinfo
+  (make-rr-data-hinfo data)
+  rr-data-hinfo?
+  (data rr-data-hinfo-data))
 
-(define-record rr-data-mx
-  preference
-  exchanger)
+(define-record-type rr-data-mx :rr-data-mx
+  (make-rr-data-mx preference exchanger)
+  rr-data-mx?
+  (preference rr-data-mx-preference)
+  (exchanger rr-data-mx-exchanger))
 
-(define-record rr-data-ptr
-  name)
+(define-record-type rr-data-ptr :rr-data-ptr
+  (make-rr-data-ptr name)
+  rr-data-ptr?
+  (name rr-data-ptr-name))
 
-(define-record rr-data-soa
-  mname
-  rname
-  serial
-  refresh
-  retry
-  expire
-  minimum)
+(define-record-type rr-data-soa :rr-data-soa
+  (make-rr-data-soa mname rname serial refresh retry expire minimum)
+  rr-data-soa?
+  (mname rr-data-soa-mname)
+  (rname rr-data-soa-rname)
+  (serial rr-data-soa-serial)
+  (refresh rr-data-soa-refresh)
+  (retry rr-data-soa-retry)
+  (expire rr-data-soa-expire)
+  (minimum rr-data-soa-minimum))
 
 ;; ### same as hinfo
-(define-record rr-data-txt
-  text)
+(define-record-type rr-data-txt :rr-data-txt
+  (make-rr-data-txt text)
+  rr-data-txt?
+  (text rr-data-txt-text))
 
 ;; ### same as hinfo and txt
-(define-record rr-data-wks
-  data)
+(define-record-type rr-data-wks :rr-data-wks
+  (make-rr-data-wks data)
+  rr-data-wks?
+  (data rr-data-wks-data))
 
 ;;
 
@@ -753,16 +786,16 @@
   (let* ((header (parse-header message))
 	 (start (list-tail message 12)))
     (call-with-values
-     (lambda () (parse-n parse-question start message (header:qdc header)))
+     (lambda () (parse-n parse-question start message (header-qdc header)))
      (lambda (qds start)
        (call-with-values
-	(lambda () (parse-n parse-rr start message (header:anc header)))
+	(lambda () (parse-n parse-rr start message (header-anc header)))
 	(lambda (ans start)
 	  (call-with-values
-	   (lambda () (parse-n parse-rr start message (header:nsc header)))
+	   (lambda () (parse-n parse-rr start message (header-nsc header)))
 	   (lambda (nss start)
 	     (call-with-values
-	      (lambda () (parse-n parse-rr start message (header:arc header)))
+	      (lambda () (parse-n parse-rr start message (header-arc header)))
 	      (lambda (ars start)
 		(if (not (null? start))
 		    (dns-error 'parse-error))
@@ -779,7 +812,7 @@
 		(char=? (cadr reply) (cadr query))))
       (display "send-receive-message: bad reply id from server"))
   ;; Check for error code:
-  (let ((rcode (flags:rcode (parse-flags reply))))
+  (let ((rcode (flags-rcode (parse-flags reply))))
     (if (not (zero? rcode))
 	(case rcode
 	  ((1) (dns-error 'dns-format-error))
@@ -790,7 +823,7 @@
 
 ;; #t if message is truncated (could happen via UDP)
 (define (truncated? reply)
-  (let ((trunc (flags:trunc (parse-flags reply))))
+  (let ((trunc (flags-trunc (parse-flags reply))))
     (= trunc 1)))
 
 ;; connects to nameserver and sends and receives messages. returns the reply.
@@ -897,26 +930,26 @@
 	    (lambda (dns-msg)
 	      (cond
 	       ((dns-message? dns-msg) 
-		(find-shortest-ttl-1 (dns-message:reply dns-msg)))
+		(find-shortest-ttl-1 (dns-message-reply dns-msg)))
 	       ((message? dns-msg)
-		(for-each (lambda (x) (find-shortest-ttl-1 x)) (message:answers dns-msg))
-		(for-each (lambda (x) (find-shortest-ttl-1 x)) (message:nameservers dns-msg))
-		(for-each (lambda (x) (find-shortest-ttl-1 x)) (message:additionals dns-msg))
+		(for-each (lambda (x) (find-shortest-ttl-1 x)) (message-answers dns-msg))
+		(for-each (lambda (x) (find-shortest-ttl-1 x)) (message-nameservers dns-msg))
+		(for-each (lambda (x) (find-shortest-ttl-1 x)) (message-additionals dns-msg))
 		minimum)
 	       ((rr? dns-msg)
 		(cond
-		 ((not minimum)  (set! minimum (rr:ttl dns-msg)))
+		 ((not minimum)  (set! minimum (rr-ttl dns-msg)))
 		 (else
-		  (if (and (not minimum) (> minimum (rr:ttl dns-msg)))
-		      (set! minimum (rr:ttl dns-msg))))))))))
+		  (if (and (not minimum) (> minimum (rr-ttl dns-msg)))
+		      (set! minimum (rr-ttl dns-msg))))))))))
     (find-shortest-ttl-1 dns-msg)))
 
 
 (define (make-key qds nameserver)
   (let*;; cache-key relevant data
-      ((name (question:name (car qds)))
-       (type (question:type (car qds)))
-       (class (question:class (car qds))))
+      ((name (question-name (car qds)))
+       (type (question-type (car qds)))
+       (class (question-class (car qds))))
     (format #f "~a;~a;~a;~a" nameserver name type class)))
 
 (define (lookup-cache qds nameserver)
@@ -925,7 +958,7 @@
     (cond
      ((and found-data
 	   ;; checks if cached-data is still valid
-	   (< (time) (+ (cache:time found-data) (cache:ttl found-data))))
+	   (< (time) (+ (cache-time found-data) (cache-ttl found-data))))
       found-data)
      (else #f))))
 
@@ -942,7 +975,7 @@
 	    nss-with-no-reply)))
 
 (define (dns-query-with-cache question protocol nameservers tried)
-  (let ((qds (message:questions (parse question))))
+  (let ((qds (message-questions (parse question))))
     (let lp ((ns nameservers))
       (if (null? ns)
 	  (receive (reply-msg hit-ns nss-with-no-reply)
@@ -956,7 +989,7 @@
 	  (cond ((lookup-cache qds (car ns))
 		 => (lambda (found-data)
 		      ;; returns cached data
-		      (values (make-dns-message (parse question) (cache:answer found-data) #t protocol '())
+		      (values (make-dns-message (parse question) (cache-answer found-data) #t protocol '())
 			      #f
 			      nameservers)))
 		(else (lp (cdr ns))))))))
@@ -991,16 +1024,16 @@
 	      dns-msg
 	      (let ((auth? (not 
 			    (zero? 
-			     (flags:auth (header:flags 
-					  (message:header 
-					   (dns-message:reply dns-msg))))))))
+			     (flags-auth (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? (rr:type elem) 'a))
-				   (message:additionals (dns-message:reply dns-msg)))))
+			   (filter (lambda (elem) (eq? (rr-type elem) '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
@@ -1205,7 +1238,7 @@
 	 (nameservers (check-args nameservers))
 	 (check-answer (lambda (dns-msg) #t))
 	 (dns-msg (dns-get-information question use-cache? protocol nameservers check-answer))
-	 (answers (message:answers (dns-message:reply dns-msg))))
+	 (answers (message-answers (dns-message-reply dns-msg))))
     (if (not (null? answers))
 	(for-each (lambda (x) (show-dns-message x)(newline)) answers)
 	;;; TODO remove display
@@ -1226,12 +1259,12 @@
 	 (protocol 'udp)
 	 (nameservers (check-args nameservers))
 	 (check-answer (lambda (dns-msg) 
-			 (let* ((reply (dns-message:reply dns-msg))
-				(answers (message:answers reply)))
+			 (let* ((reply (dns-message-reply dns-msg))
+				(answers (message-answers reply)))
 			   (not (null? (filter-type answers 'a))))))
 	 (dns-msg (dns-get-information question use-cache? protocol nameservers check-answer))
-	 (answers (filter-type (message:answers (dns-message:reply dns-msg)) 'a)))
-    (rr-data-a:ip (rr:data (car answers)))))
+	 (answers (filter-type (message-answers (dns-message-reply dns-msg)) 'a)))
+    (rr-data-a-ip (rr-data (car answers)))))
 
 ;; looks up an ip, returns a hostname
 ;; (dns-inverse-lookup <name> [nameserver])
@@ -1246,12 +1279,12 @@
 	 (protocol 'udp)
 	 (nameservers (check-args nameservers))
 	 (check-answer (lambda (dns-msg) 
-			 (let* ((reply (dns-message:reply dns-msg))
-				(answers (message:answers reply)))
+			 (let* ((reply (dns-message-reply dns-msg))
+				(answers (message-answers reply)))
 			   (not (null? (filter-type answers 'ptr))))))
 	 (dns-msg (dns-get-information question use-cache? protocol nameservers check-answer))
-	 (answers (filter-type (message:answers (dns-message:reply dns-msg)) 'ptr)))
-    (rr-data-ptr:name (rr:data (car answers)))))
+	 (answers (filter-type (message-answers (dns-message-reply dns-msg)) 'ptr)))
+    (rr-data-ptr-name (rr-data (car answers)))))
 
 (define dns-inverse-lookup dns-lookup-ip)
 
@@ -1269,19 +1302,19 @@
 	 (protocol 'udp)
 	 (nameservers (check-args nameservers))
 	 (check-answer (lambda (dns-msg) 
-			 (let* ((reply (dns-message:reply dns-msg))
-				(answers (message:answers reply))
-				(nameservers (message:nameservers reply)))
+			 (let* ((reply (dns-message-reply dns-msg))
+				(answers (message-answers reply))
+				(nameservers (message-nameservers reply)))
 			   (or (not (null? (filter-type nameservers 'soa)))
 			       (not (null? (filter-type answers 'ns)))))))
 	 (dns-msg (dns-get-information question use-cache? protocol nameservers check-answer))
-	 (reply (dns-message:reply dns-msg))
-	 (soa (filter-type (message:nameservers reply) 'soa))
-	 (nss (filter-type (message:answers reply) 'ns))
-	 (add (filter-type (message:additionals reply) 'a)))
+	 (reply (dns-message-reply dns-msg))
+	 (soa (filter-type (message-nameservers reply) 'soa))
+	 (nss (filter-type (message-answers reply) 'ns))
+	 (add (filter-type (message-additionals reply) 'a)))
     (if (null? nss)
-	(list (dns-lookup-name (rr-data-soa:mname (rr:data (car soa)))))
-	(map (lambda (elem) (rr-data-a:ip (rr:data elem))) add))))
+	(list (dns-lookup-name (rr-data-soa-mname (rr-data (car soa)))))
+	(map (lambda (elem) (rr-data-a-ip (rr-data elem))) add))))
 
 ;; looks up a mail-exchanger for a hostname.
 ;; returns a list of mail-exchanger, sorted by their preference
@@ -1299,28 +1332,28 @@
 	 (protocol 'tcp)
 	 (nameservers (check-args nameservers))
 	 (check-answer (lambda (dns-msg) 
-			 (let* ((reply (dns-message:reply dns-msg))
-				(answers (message:answers reply))
-				(nameservers (message:nameservers reply)))
+			 (let* ((reply (dns-message-reply dns-msg))
+				(answers (message-answers reply))
+				(nameservers (message-nameservers reply)))
 			   (or (not (null? (filter-type answers 'mx)))
 			       (not (null? (filter-type answers 'cname)))
 			       (not (null? (filter-type answers 'a)))))))
 	 (dns-msg (dns-get-information question use-cache? protocol nameservers check-answer))
-	 (reply (dns-message:reply dns-msg))
-	 (mx (filter-type (message:answers reply) 'mx))
-	 (soa (filter-type (message:nameservers reply) 'soa))
-	 (cname (filter-type (message:answers reply) 'cname))
-	 (a (filter-type (message:answers reply) 'a)))
+	 (reply (dns-message-reply dns-msg))
+	 (mx (filter-type (message-answers reply) 'mx))
+	 (soa (filter-type (message-nameservers reply) 'soa))
+	 (cname (filter-type (message-answers reply) 'cname))
+	 (a (filter-type (message-answers reply) 'a)))
 
     (cond
      ((not (null? a)) 
-      (list (rr-data-a:ip (rr:data (car a)))))
+      (list (rr-data-a-ip (rr-data (car a)))))
      ((not (null? cname))
-      (dns-lookup-mail-exchanger (rr-data-cname:name (rr:data (car cname)))))
+      (dns-lookup-mail-exchanger (rr-data-cname-name (rr-data (car cname)))))
      ((null? mx) 
-      (list (rr-data-soa:rname (rr:data (car soa)))))
+      (list (rr-data-soa-rname (rr-data (car soa)))))
      (else
-      (map (lambda (elem) (rr-data-mx:exchanger (rr:data elem))) (sort-by-preference mx))))))
+      (map (lambda (elem) (rr-data-mx-exchanger (rr-data elem))) (sort-by-preference mx))))))
 
 ;;; pretty-prints a dns-msg
 (define (show-dns-message dns-msg)
@@ -1340,87 +1373,87 @@
      ((dns-message? dns-msg) 
       (begin
 	(d 0 "DNS-MESSAGE" "")
-	(d 1 "QUERY" "")(show-dns-message (dns-message:query dns-msg))(newline)
-	(d 1 "REPLY" "")(show-dns-message (dns-message:reply dns-msg))(newline)
-	(d 1 "CACHE?" (if (dns-message:cache? dns-msg)
+	(d 1 "QUERY" "")(show-dns-message (dns-message-query dns-msg))(newline)
+	(d 1 "REPLY" "")(show-dns-message (dns-message-reply dns-msg))(newline)
+	(d 1 "CACHE?" (if (dns-message-cache? dns-msg)
 			  "found in cache"
 			  "not found in cache"))
-	(d 1 "PROTOCOL" (let ((protocol (dns-message:protocol dns-msg)))
+	(d 1 "PROTOCOL" (let ((protocol (dns-message-protocol dns-msg)))
 			  (cond
 			   ((eq? protocol 'tcp) "TCP")
 			   ((eq? protocol 'udp) "UDP"))))
-	(d 1 "TRIED-NAMESERVERS" (if (> (length (dns-message:tried-nameservers dns-msg)) 1)
+	(d 1 "TRIED-NAMESERVERS" (if (> (length (dns-message-tried-nameservers dns-msg)) 1)
 				     (begin
 				       (display " had perform recursion: ")
-				       (dns-message:tried-nameservers dns-msg))
+				       (dns-message-tried-nameservers dns-msg))
 				     (begin
 				       (display " without recursion: ")
-				       (dns-message:tried-nameservers dns-msg))))))
+				       (dns-message-tried-nameservers dns-msg))))))
      ((message? dns-msg)
       (begin
 	(d 2 "MESSAGE" "")
-	(d 3 "Header     " "")(show-dns-message (message:header dns-msg))
-	(d 3 "Questions  " "")(for-each (lambda (x) (show-dns-message x)(newline)) (message:questions dns-msg))
-	(d 3 "Answers    " "")(for-each (lambda (x) (show-dns-message x)(newline)) (message:answers dns-msg))
-	(d 3 "Nameservers" "")(for-each (lambda (x) (show-dns-message x)(newline)) (message:nameservers dns-msg))
-	(d 3 "Additionals" "")(for-each (lambda (x) (show-dns-message x)(newline)) (message:additionals dns-msg))))
+	(d 3 "Header     " "")(show-dns-message (message-header dns-msg))
+	(d 3 "Questions  " "")(for-each (lambda (x) (show-dns-message x)(newline)) (message-questions dns-msg))
+	(d 3 "Answers    " "")(for-each (lambda (x) (show-dns-message x)(newline)) (message-answers dns-msg))
+	(d 3 "Nameservers" "")(for-each (lambda (x) (show-dns-message x)(newline)) (message-nameservers dns-msg))
+	(d 3 "Additionals" "")(for-each (lambda (x) (show-dns-message x)(newline)) (message-additionals dns-msg))))
      ((header? dns-msg)
       (begin
-	(d 4 "id" (header:id dns-msg))
-	(d 4 "Flags" "")(show-dns-message (header:flags dns-msg))
-	(d 4 "question-count    " (header:qdc dns-msg))
-	(d 4 "answer-count      " (header:anc dns-msg))
-	(d 4 "nameserver-count  " (header:nsc dns-msg))
-	(d 4 "additional-count  " (header:arc dns-msg))))
+	(d 4 "id" (header-id dns-msg))
+	(d 4 "Flags" "")(show-dns-message (header-flags dns-msg))
+	(d 4 "question-count    " (header-qdc dns-msg))
+	(d 4 "answer-count      " (header-anc dns-msg))
+	(d 4 "nameserver-count  " (header-nsc dns-msg))
+	(d 4 "additional-count  " (header-arc dns-msg))))
      ((flags? dns-msg)
       (begin 
-	(d 5 "querytype" (flags:querytype dns-msg))
-	(d 5 "opcode" (flags:opcode dns-msg))
-	(d 5 "auth" (flags:auth dns-msg))
-	(d 5 "trunc" (flags:trunc dns-msg))
-	(d 5 "recursiondesired" (flags:recursiondesired dns-msg))
-	(d 5 "recursionavailable" (flags:recursionavailable dns-msg))
-	(d 5 "z" (flags:z dns-msg))
-	(d 5 "rcode" (flags:rcode dns-msg))))
+	(d 5 "querytype" (flags-querytype dns-msg))
+	(d 5 "opcode" (flags-opcode dns-msg))
+	(d 5 "auth" (flags-auth dns-msg))
+	(d 5 "trunc" (flags-trunc dns-msg))
+	(d 5 "recursiondesired" (flags-recursiondesired dns-msg))
+	(d 5 "recursionavailable" (flags-recursionavailable dns-msg))
+	(d 5 "z" (flags-z dns-msg))
+	(d 5 "rcode" (flags-rcode dns-msg))))
      ((question? dns-msg)
       (begin
-	(d 4 "name " (question:name dns-msg))
-	(d 4 "type " (question:type dns-msg))
-	(d 4 "class" (question:class dns-msg))))
+	(d 4 "name " (question-name dns-msg))
+	(d 4 "type " (question-type dns-msg))
+	(d 4 "class" (question-class dns-msg))))
      ((rr? dns-msg)
       (begin
-	(d 4 "name " (rr:name dns-msg))
-	(d 4 "type " (rr:type dns-msg))
-	(d 4 "class" (rr:class dns-msg))
-	(d 4 "ttl  " (rr:ttl dns-msg))
-	(d 4 "data " "") (show-dns-message (rr:data dns-msg))))
+	(d 4 "name " (rr-name dns-msg))
+	(d 4 "type " (rr-type dns-msg))
+	(d 4 "class" (rr-class dns-msg))
+	(d 4 "ttl  " (rr-ttl dns-msg))
+	(d 4 "data " "") (show-dns-message (rr-data dns-msg))))
      ((rr-data-a? dns-msg)
-      (d 5 "ip " (rr-data-a:ip dns-msg)))
+      (d 5 "ip " (rr-data-a-ip dns-msg)))
      ((rr-data-ns? dns-msg)
-      (d 5 "name " (rr-data-ns:name dns-msg)))
+      (d 5 "name " (rr-data-ns-name dns-msg)))
      ((rr-data-cname? dns-msg)
-      (d 5 "name " (rr-data-cname:name dns-msg)))
+      (d 5 "name " (rr-data-cname-name dns-msg)))
      ((rr-data-mx? dns-msg)
       (begin
-	(d 5 "preference " (rr-data-mx:preference dns-msg))
-	(d 5 "exchanger  " (rr-data-mx:exchanger dns-msg))))
+	(d 5 "preference " (rr-data-mx-preference dns-msg))
+	(d 5 "exchanger  " (rr-data-mx-exchanger dns-msg))))
      ((rr-data-ptr? dns-msg) 
-      (d 5 "name " (rr-data-ptr:name dns-msg)))
+      (d 5 "name " (rr-data-ptr-name dns-msg)))
      ((rr-data-soa? dns-msg)
       (begin
-	(d 5 "mname   " (rr-data-soa:mname dns-msg))
-	(d 5 "rname   " (rr-data-soa:rname dns-msg))
-	(d 5 "serial  " (rr-data-soa:serial dns-msg))
-	(d 5 "refresh " (rr-data-soa:refresh dns-msg))
-	(d 5 "expire  " (rr-data-soa:expire dns-msg))
-	(d 5 "minimum " (rr-data-soa:expire dns-msg))))
+	(d 5 "mname   " (rr-data-soa-mname dns-msg))
+	(d 5 "rname   " (rr-data-soa-rname dns-msg))
+	(d 5 "serial  " (rr-data-soa-serial dns-msg))
+	(d 5 "refresh " (rr-data-soa-refresh dns-msg))
+	(d 5 "expire  " (rr-data-soa-expire dns-msg))
+	(d 5 "minimum " (rr-data-soa-expire dns-msg))))
      ;; ###
      ((rr-data-hinfo? dns-msg)
-      (d 5 "data " (rr-data-hinfo:data dns-msg)))
+      (d 5 "data " (rr-data-hinfo-data dns-msg)))
      ((rr-data-txt? dns-msg)
-      (d 5 "text " (rr-data-txt:text dns-msg)))
+      (d 5 "text " (rr-data-txt-text dns-msg)))
      ((rr-data-wks? dns-msg)
-      (d 5 "data " (rr-data-wks:data dns-msg)))
+      (d 5 "data " (rr-data-wks-data dns-msg)))
      
      )))
 
diff --git a/scheme/packages.scm b/scheme/packages.scm
index f973f1f..f1670ad 100644
--- a/scheme/packages.scm
+++ b/scheme/packages.scm
@@ -445,7 +445,7 @@
 	ascii
 	formats
 	signals
-	defrec-package
+	define-record-types
 	random
 	queues
 	conditions