aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/net/dns.el54
1 files changed, 21 insertions, 33 deletions
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 4fa87050e57..9b0fd7235a2 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -106,7 +106,7 @@ updated. Set this variable to t to disable the check.")
106 106
107(defun dns-read-string-name (string buffer) 107(defun dns-read-string-name (string buffer)
108 (with-temp-buffer 108 (with-temp-buffer
109 (unless (featurep 'xemacs) (set-buffer-multibyte nil)) 109 (set-buffer-multibyte nil)
110 (insert string) 110 (insert string)
111 (goto-char (point-min)) 111 (goto-char (point-min))
112 (dns-read-name buffer))) 112 (dns-read-name buffer)))
@@ -140,7 +140,7 @@ updated. Set this variable to t to disable the check.")
140 "Write a DNS packet according to SPEC. 140 "Write a DNS packet according to SPEC.
141If TCP-P, the first two bytes of the package with be the length field." 141If TCP-P, the first two bytes of the package with be the length field."
142 (with-temp-buffer 142 (with-temp-buffer
143 (unless (featurep 'xemacs) (set-buffer-multibyte nil)) 143 (set-buffer-multibyte nil)
144 (dns-write-bytes (dns-get 'id spec) 2) 144 (dns-write-bytes (dns-get 'id spec) 2)
145 (dns-write-bytes 145 (dns-write-bytes
146 (logior 146 (logior
@@ -191,7 +191,7 @@ If TCP-P, the first two bytes of the package with be the length field."
191 191
192(defun dns-read (packet) 192(defun dns-read (packet)
193 (with-temp-buffer 193 (with-temp-buffer
194 (unless (featurep 'xemacs) (set-buffer-multibyte nil)) 194 (set-buffer-multibyte nil)
195 (let ((spec nil) 195 (let ((spec nil)
196 queries answers authorities additionals) 196 queries answers authorities additionals)
197 (insert packet) 197 (insert packet)
@@ -268,7 +268,7 @@ If TCP-P, the first two bytes of the package with be the length field."
268 (point (point))) 268 (point (point)))
269 (prog1 269 (prog1
270 (with-temp-buffer 270 (with-temp-buffer
271 (unless (featurep 'xemacs) (set-buffer-multibyte nil)) 271 (set-buffer-multibyte nil)
272 (insert string) 272 (insert string)
273 (goto-char (point-min)) 273 (goto-char (point-min))
274 (cond 274 (cond
@@ -356,26 +356,21 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
356 356
357;;; Interface functions. 357;;; Interface functions.
358(defmacro dns-make-network-process (server) 358(defmacro dns-make-network-process (server)
359 (if (featurep 'xemacs) 359 `(let ((server ,server)
360 `(let ((coding-system-for-read 'binary) 360 (coding-system-for-read 'binary)
361 (coding-system-for-write 'binary)) 361 (coding-system-for-write 'binary))
362 (open-network-stream "dns" (current-buffer) 362 (if (fboundp 'make-network-process)
363 ,server "domain" 'udp)) 363 (make-network-process
364 `(let ((server ,server) 364 :name "dns"
365 (coding-system-for-read 'binary) 365 :coding 'binary
366 (coding-system-for-write 'binary)) 366 :buffer (current-buffer)
367 (if (fboundp 'make-network-process) 367 :host server
368 (make-network-process 368 :service "domain"
369 :name "dns" 369 :type 'datagram)
370 :coding 'binary 370 ;; Older versions of Emacs doesn't have
371 :buffer (current-buffer) 371 ;; `make-network-process', so we fall back on opening a TCP
372 :host server 372 ;; connection to the DNS server.
373 :service "domain" 373 (open-network-stream "dns" (current-buffer) server "domain"))))
374 :type 'datagram)
375 ;; Older versions of Emacs doesn't have
376 ;; `make-network-process', so we fall back on opening a TCP
377 ;; connection to the DNS server.
378 (open-network-stream "dns" (current-buffer) server "domain")))))
379 374
380(defvar dns-cache (make-vector 4096 0)) 375(defvar dns-cache (make-vector 4096 0))
381 376
@@ -409,7 +404,7 @@ If REVERSEP, look up an IP address."
409 (if (not dns-servers) 404 (if (not dns-servers)
410 (message "No DNS server configuration found") 405 (message "No DNS server configuration found")
411 (with-temp-buffer 406 (with-temp-buffer
412 (unless (featurep 'xemacs) (set-buffer-multibyte nil)) 407 (set-buffer-multibyte nil)
413 (let ((process (condition-case () 408 (let ((process (condition-case ()
414 (dns-make-network-process (car dns-servers)) 409 (dns-make-network-process (car dns-servers))
415 (error 410 (error
@@ -417,8 +412,6 @@ If REVERSEP, look up an IP address."
417 "dns: Got an error while trying to talk to %s" 412 "dns: Got an error while trying to talk to %s"
418 (car dns-servers)) 413 (car dns-servers))
419 nil))) 414 nil)))
420 (tcp-p (and (not (fboundp 'make-network-process))
421 (not (featurep 'xemacs))))
422 (step 100) 415 (step 100)
423 (times (* dns-timeout 1000)) 416 (times (* dns-timeout 1000))
424 (id (random 65000))) 417 (id (random 65000)))
@@ -428,8 +421,7 @@ If REVERSEP, look up an IP address."
428 (dns-write `((id ,id) 421 (dns-write `((id ,id)
429 (opcode query) 422 (opcode query)
430 (queries ((,name (type ,type)))) 423 (queries ((,name (type ,type))))
431 (recursion-desired-p t)) 424 (recursion-desired-p t))))
432 tcp-p))
433 (while (and (zerop (buffer-size)) 425 (while (and (zerop (buffer-size))
434 (> times 0)) 426 (> times 0))
435 (let ((step-sec (/ step 1000.0))) 427 (let ((step-sec (/ step 1000.0)))
@@ -439,10 +431,6 @@ If REVERSEP, look up an IP address."
439 (condition-case nil 431 (condition-case nil
440 (delete-process process) 432 (delete-process process)
441 (error nil)) 433 (error nil))
442 (when (and tcp-p
443 (>= (buffer-size) 2))
444 (goto-char (point-min))
445 (delete-region (point) (+ (point) 2)))
446 (when (and (>= (buffer-size) 2) 434 (when (and (>= (buffer-size) 2)
447 ;; We had a time-out. 435 ;; We had a time-out.
448 (> times 0)) 436 (> times 0))