X-Git-Url: http://dolda2000.com/gitweb/?p=lisp-utils.git;a=blobdiff_plain;f=dns.lisp;h=41032daecd400dabbfb012e74c9d5d1320d8d1bf;hp=ce6117c28ab00b5eada14189e4e2a49d25870442;hb=HEAD;hpb=6c36ab4ac92a1bd1898063a3854cbf9c0d8d645f

diff --git a/dns.lisp b/dns.lisp
index ce6117c..41032da 100644
--- a/dns.lisp
+++ b/dns.lisp
@@ -39,7 +39,8 @@
     `(progn
        (defclass ,name (resource-record) ,slot-desc)
        (setf *rr-coding-types* (cons '(,name (,class ,type) ,format)
-				     (remove ',name *rr-coding-types* :key #'car))))))
+				     (remove ',name *rr-coding-types* :key #'car)))
+       (export '(,name)))))
 
 (define-rr-type a-record #x1 #x1
 		((address ipv4-address)))
@@ -69,6 +70,8 @@
 		 (port uint-16)
 		 (host-name domain-name)))
 
+(export '(resource-record))
+
 ;;; Packet decoding logic
 
 (defstruct dns-decode-state
@@ -76,7 +79,7 @@
   (pos 0 :type (mod 65536))
   (prev-names '() :type list))
 
-(define-condition dns-error (error) ())
+(define-condition dns-error (network-error) ())
 (define-condition dns-decode-error (dns-error)
   ((packet :initarg :packet)))
 (define-condition simple-dns-decode-error (dns-decode-error simple-error) ())
@@ -289,7 +292,7 @@
 			  (push (cons name (length packet-buf)) prev-names))
 			(let ((encoded (charcode:encode-string (car name) :ascii)))
 			  (unless (< (length encoded) 64)
-			    (error "DNS labels cannot exceed 63 octets in length: ~S" (car name)))
+			    (simple-dns-decode-error buf "DNS labels cannot exceed 63 octets in length: ~S" (car name)))
 			  (encode-uint-8 buf (length encoded))
 			  (encode-bytes buf encoded))
 			(encode-label (cdr name)))))))
@@ -325,7 +328,7 @@
 				      (string (charcode:encode-string val :ascii))
 				      ((array (unsigned-byte 8)) val))))
 			  (unless (< (length data) 256)
-			    (error "DNS text data length cannot exceed 255 octets."))
+			    (simple-dns-decode-error buf "DNS text data length cannot exceed 255 octets."))
 			  (encode-uint-8 buf (length data))
 			  (encode-bytes buf data)))
 		((ipv4-address)
@@ -677,7 +680,7 @@
 		       (error 'dns-name-error :query-name (unparse-domain-name name) :query-type types
 			      :config config))
 		     (eq resp-code :success)))
-	       (name-server-timeout () nil))))
+	       (network-error () nil))))
       (check-cache)
       (signal 'dns-resolver-help :query-name (unparse-domain-name name) :query-type types
 	      :config config)
@@ -713,6 +716,8 @@
 			    (return-from found-server))))))
 		  (check-cache))))))))
 
+(export '(*dns-resolver-config*))
+
 ;;; Misc.
 
 (defmethod print-object ((q resource-query) stream)