diff options
| -rw-r--r-- | lisp/net/dns.el | 54 |
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. |
| 141 | If TCP-P, the first two bytes of the package with be the length field." | 141 | If 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)) |