Synch to Oort Gnus 200304290052.

[elisp/gnus.git-] / lisp / dns.el

diff --git a/lisp/dns.el b/lisp/dns.el
index c35300e..349d29f 100644 (file)
--- a/lisp/dns.el
+++ b/lisp/dns.el
@@ -1,5 +1,5 @@
 ;;; dns.el --- Domain Name Service lookups
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -25,6 +25,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (require 'mm-util)
 
 (defvar dns-timeout 5
@@ -280,6 +282,29 @@ If TCP-P, the first two bytes of the package with be the length field."
 
 ;;; Interface functions.
 
+(defmacro dns-make-network-process (server)
+  (if (featurep 'xemacs)
+      `(let ((coding-system-for-read 'binary)
+            (coding-system-for-write 'binary))
+        (open-network-stream "dns" (current-buffer) ,server "domain" 'udp))
+    `(let ((server ,server)
+          (coding-system-for-read 'binary)
+          (coding-system-for-write 'binary)
+          (default-process-coding-system '(binary . binary))
+          program-coding-system-alist)
+       (if (fboundp 'make-network-process)
+          (make-network-process
+           :name "dns"
+           :coding 'binary
+           :buffer (current-buffer)
+           :host server
+           :service "domain"
+           :type 'datagram)
+        ;; Older versions of Emacs doesn't have
+        ;; `make-network-process', so we fall back on opening a TCP
+        ;; connection to the DNS server.
+        (open-network-stream "dns" (current-buffer) server "domain")))))
+
 (defun query-dns (name &optional type fullp)
   "Query a DNS server for NAME of TYPE.
 If FULLP, return the entire record returned."
@@ -289,29 +314,18 @@ If FULLP, return the entire record returned."
     (unless dns-servers
       (error "No DNS server configuration found")))
   (mm-with-unibyte-buffer
-    (let ((coding-system-for-read 'binary) 
-         (coding-system-for-write 'binary)
-         (tcp-p (and (not (fboundp 'open-network-stream))
-                     (not (featurep 'xemacs)))))
-      (let ((process
-            (cond
-             ((featurep 'xemacs)
-              (open-network-stream
-               "dns" (current-buffer) (car dns-servers) "domain" 'udp))
-             (tcp-p
-              (open-network-stream
-               "dns" (current-buffer) (car dns-servers) "domain"))
-             (t
-              (make-network-process
-               :name "dns"
-               :coding 'binary
-               :buffer (current-buffer)
-               :host (car dns-servers)
-               :service "domain"
-               :type 'datagram))))
-           (step 100)
-           (times (* dns-timeout 1000))
-           (id (random 65000)))
+    (let ((process (condition-case ()
+                      (dns-make-network-process (car dns-servers))
+                    (error
+                     (message "dns: Got an error while trying to talk to %s"
+                              (car dns-servers))
+                     nil)))
+         (tcp-p (and (not (fboundp 'make-network-process))
+                     (not (featurep 'xemacs))))
+         (step 100)
+         (times (* dns-timeout 1000))
+         (id (random 65000)))
+      (when process
        (process-send-string
         process
         (dns-write `((id ,id)
@@ -335,7 +349,7 @@ If FULLP, return the entire record returned."
              (let ((answer (car (dns-get 'answers result))))
                (when (eq type (dns-get 'type answer))
                  (dns-get 'data answer))))))))))
-    
+
 (provide 'dns)
 
 ;;; dns.el ends here