diff options
| author | Stefan Monnier | 2008-03-12 20:52:31 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2008-03-12 20:52:31 +0000 |
| commit | eb21f2ff519ebd89e37f39652ae84328cc6c78d2 (patch) | |
| tree | 960fa531e8faab2f66882ece1135644edfa62c5f | |
| parent | 5d2e28bfb45805e2ae248d44ceb4b7a65b331656 (diff) | |
| download | emacs-eb21f2ff519ebd89e37f39652ae84328cc6c78d2.tar.gz emacs-eb21f2ff519ebd89e37f39652ae84328cc6c78d2.zip | |
(dns-read-string-name, dns-read, dns-read-type, query-dns):
Use set-buffer-multibyte rather than set default-enable-multibyte-characters.
| -rw-r--r-- | lisp/ChangeLog | 1 | ||||
| -rw-r--r-- | lisp/net/dns.el | 294 |
2 files changed, 148 insertions, 147 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d8f9b361527..2c0be4b6a91 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,6 @@ | |||
| 1 | 2008-03-12 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2008-03-12 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * net/dns.el (dns-read-string-name, dns-read, dns-read-type, query-dns): | ||
| 3 | * sha1.el (sha1-string-external): Use set-buffer-multibyte rather than | 4 | * sha1.el (sha1-string-external): Use set-buffer-multibyte rather than |
| 4 | setting default-enable-multibyte-characters. | 5 | setting default-enable-multibyte-characters. |
| 5 | 6 | ||
diff --git a/lisp/net/dns.el b/lisp/net/dns.el index f8f46173fe4..9e32d1fc353 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el | |||
| @@ -102,11 +102,11 @@ If nil, /etc/resolv.conf will be consulted.") | |||
| 102 | (dns-write-bytes 0)) | 102 | (dns-write-bytes 0)) |
| 103 | 103 | ||
| 104 | (defun dns-read-string-name (string buffer) | 104 | (defun dns-read-string-name (string buffer) |
| 105 | (let (default-enable-multibyte-characters) | 105 | (with-temp-buffer |
| 106 | (with-temp-buffer | 106 | (set-buffer-multibyte nil) |
| 107 | (insert string) | 107 | (insert string) |
| 108 | (goto-char (point-min)) | 108 | (goto-char (point-min)) |
| 109 | (dns-read-name buffer)))) | 109 | (dns-read-name buffer))) |
| 110 | 110 | ||
| 111 | (defun dns-read-name (&optional buffer) | 111 | (defun dns-read-name (&optional buffer) |
| 112 | (let ((ended nil) | 112 | (let ((ended nil) |
| @@ -186,72 +186,72 @@ If TCP-P, the first two bytes of the package with be the length field." | |||
| 186 | (buffer-string))) | 186 | (buffer-string))) |
| 187 | 187 | ||
| 188 | (defun dns-read (packet) | 188 | (defun dns-read (packet) |
| 189 | (let (default-enable-multibyte-characters) | 189 | (with-temp-buffer |
| 190 | (with-temp-buffer | 190 | (set-buffer-multibyte nil) |
| 191 | (let ((spec nil) | 191 | (let ((spec nil) |
| 192 | queries answers authorities additionals) | 192 | queries answers authorities additionals) |
| 193 | (insert packet) | 193 | (insert packet) |
| 194 | (goto-char (point-min)) | 194 | (goto-char (point-min)) |
| 195 | (push (list 'id (dns-read-bytes 2)) spec) | 195 | (push (list 'id (dns-read-bytes 2)) spec) |
| 196 | (let ((byte (dns-read-bytes 1))) | 196 | (let ((byte (dns-read-bytes 1))) |
| 197 | (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t)) | 197 | (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t)) |
| 198 | spec) | 198 | spec) |
| 199 | (let ((opcode (logand byte (lsh 7 3)))) | 199 | (let ((opcode (logand byte (lsh 7 3)))) |
| 200 | (push (list 'opcode | 200 | (push (list 'opcode |
| 201 | (cond ((eq opcode 0) 'query) | 201 | (cond ((eq opcode 0) 'query) |
| 202 | ((eq opcode 1) 'inverse-query) | 202 | ((eq opcode 1) 'inverse-query) |
| 203 | ((eq opcode 2) 'status))) | 203 | ((eq opcode 2) 'status))) |
| 204 | spec)) | ||
| 205 | (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2))) | ||
| 206 | nil t)) spec) | ||
| 207 | (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t)) | ||
| 208 | spec) | ||
| 209 | (push (list 'recursion-desired-p | ||
| 210 | (if (zerop (logand byte (lsh 1 0))) nil t)) spec)) | ||
| 211 | (let ((rc (logand (dns-read-bytes 1) 15))) | ||
| 212 | (push (list 'response-code | ||
| 213 | (cond | ||
| 214 | ((eq rc 0) 'no-error) | ||
| 215 | ((eq rc 1) 'format-error) | ||
| 216 | ((eq rc 2) 'server-failure) | ||
| 217 | ((eq rc 3) 'name-error) | ||
| 218 | ((eq rc 4) 'not-implemented) | ||
| 219 | ((eq rc 5) 'refused))) | ||
| 220 | spec)) | 204 | spec)) |
| 221 | (setq queries (dns-read-bytes 2)) | 205 | (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2))) |
| 222 | (setq answers (dns-read-bytes 2)) | 206 | nil t)) spec) |
| 223 | (setq authorities (dns-read-bytes 2)) | 207 | (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t)) |
| 224 | (setq additionals (dns-read-bytes 2)) | 208 | spec) |
| 225 | (let ((qs nil)) | 209 | (push (list 'recursion-desired-p |
| 226 | (dotimes (i queries) | 210 | (if (zerop (logand byte (lsh 1 0))) nil t)) spec)) |
| 211 | (let ((rc (logand (dns-read-bytes 1) 15))) | ||
| 212 | (push (list 'response-code | ||
| 213 | (cond | ||
| 214 | ((eq rc 0) 'no-error) | ||
| 215 | ((eq rc 1) 'format-error) | ||
| 216 | ((eq rc 2) 'server-failure) | ||
| 217 | ((eq rc 3) 'name-error) | ||
| 218 | ((eq rc 4) 'not-implemented) | ||
| 219 | ((eq rc 5) 'refused))) | ||
| 220 | spec)) | ||
| 221 | (setq queries (dns-read-bytes 2)) | ||
| 222 | (setq answers (dns-read-bytes 2)) | ||
| 223 | (setq authorities (dns-read-bytes 2)) | ||
| 224 | (setq additionals (dns-read-bytes 2)) | ||
| 225 | (let ((qs nil)) | ||
| 226 | (dotimes (i queries) | ||
| 227 | (push (list (dns-read-name) | ||
| 228 | (list 'type (dns-inverse-get (dns-read-bytes 2) | ||
| 229 | dns-query-types)) | ||
| 230 | (list 'class (dns-inverse-get (dns-read-bytes 2) | ||
| 231 | dns-classes))) | ||
| 232 | qs)) | ||
| 233 | (push (list 'queries qs) spec)) | ||
| 234 | (dolist (slot '(answers authorities additionals)) | ||
| 235 | (let ((qs nil) | ||
| 236 | type) | ||
| 237 | (dotimes (i (symbol-value slot)) | ||
| 227 | (push (list (dns-read-name) | 238 | (push (list (dns-read-name) |
| 228 | (list 'type (dns-inverse-get (dns-read-bytes 2) | 239 | (list 'type |
| 229 | dns-query-types)) | 240 | (setq type (dns-inverse-get (dns-read-bytes 2) |
| 241 | dns-query-types))) | ||
| 230 | (list 'class (dns-inverse-get (dns-read-bytes 2) | 242 | (list 'class (dns-inverse-get (dns-read-bytes 2) |
| 231 | dns-classes))) | 243 | dns-classes)) |
| 244 | (list 'ttl (dns-read-bytes 4)) | ||
| 245 | (let ((length (dns-read-bytes 2))) | ||
| 246 | (list 'data | ||
| 247 | (dns-read-type | ||
| 248 | (buffer-substring | ||
| 249 | (point) | ||
| 250 | (progn (forward-char length) (point))) | ||
| 251 | type)))) | ||
| 232 | qs)) | 252 | qs)) |
| 233 | (push (list 'queries qs) spec)) | 253 | (push (list slot qs) spec))) |
| 234 | (dolist (slot '(answers authorities additionals)) | 254 | (nreverse spec)))) |
| 235 | (let ((qs nil) | ||
| 236 | type) | ||
| 237 | (dotimes (i (symbol-value slot)) | ||
| 238 | (push (list (dns-read-name) | ||
| 239 | (list 'type | ||
| 240 | (setq type (dns-inverse-get (dns-read-bytes 2) | ||
| 241 | dns-query-types))) | ||
| 242 | (list 'class (dns-inverse-get (dns-read-bytes 2) | ||
| 243 | dns-classes)) | ||
| 244 | (list 'ttl (dns-read-bytes 4)) | ||
| 245 | (let ((length (dns-read-bytes 2))) | ||
| 246 | (list 'data | ||
| 247 | (dns-read-type | ||
| 248 | (buffer-substring | ||
| 249 | (point) | ||
| 250 | (progn (forward-char length) (point))) | ||
| 251 | type)))) | ||
| 252 | qs)) | ||
| 253 | (push (list slot qs) spec))) | ||
| 254 | (nreverse spec))))) | ||
| 255 | 255 | ||
| 256 | (defun dns-read-int32 () | 256 | (defun dns-read-int32 () |
| 257 | ;; Full 32 bit Integers can't be handled by Emacs. If we use | 257 | ;; Full 32 bit Integers can't be handled by Emacs. If we use |
| @@ -263,40 +263,40 @@ If TCP-P, the first two bytes of the package with be the length field." | |||
| 263 | (let ((buffer (current-buffer)) | 263 | (let ((buffer (current-buffer)) |
| 264 | (point (point))) | 264 | (point (point))) |
| 265 | (prog1 | 265 | (prog1 |
| 266 | (let (default-enable-multibyte-characters) | 266 | (with-temp-buffer |
| 267 | (with-temp-buffer | 267 | (set-buffer-multibyte nil) |
| 268 | (insert string) | 268 | (insert string) |
| 269 | (goto-char (point-min)) | 269 | (goto-char (point-min)) |
| 270 | (cond | 270 | (cond |
| 271 | ((eq type 'A) | 271 | ((eq type 'A) |
| 272 | (let ((bytes nil)) | 272 | (let ((bytes nil)) |
| 273 | (dotimes (i 4) | 273 | (dotimes (i 4) |
| 274 | (push (dns-read-bytes 1) bytes)) | 274 | (push (dns-read-bytes 1) bytes)) |
| 275 | (mapconcat 'number-to-string (nreverse bytes) "."))) | 275 | (mapconcat 'number-to-string (nreverse bytes) "."))) |
| 276 | ((eq type 'AAAA) | 276 | ((eq type 'AAAA) |
| 277 | (let (hextets) | 277 | (let (hextets) |
| 278 | (dotimes (i 8) | 278 | (dotimes (i 8) |
| 279 | (push (dns-read-bytes 2) hextets)) | 279 | (push (dns-read-bytes 2) hextets)) |
| 280 | (mapconcat (lambda (n) (format "%x" n)) | 280 | (mapconcat (lambda (n) (format "%x" n)) |
| 281 | (nreverse hextets) ":"))) | 281 | (nreverse hextets) ":"))) |
| 282 | ((eq type 'SOA) | 282 | ((eq type 'SOA) |
| 283 | (list (list 'mname (dns-read-name buffer)) | 283 | (list (list 'mname (dns-read-name buffer)) |
| 284 | (list 'rname (dns-read-name buffer)) | 284 | (list 'rname (dns-read-name buffer)) |
| 285 | (list 'serial (dns-read-int32)) | 285 | (list 'serial (dns-read-int32)) |
| 286 | (list 'refresh (dns-read-int32)) | 286 | (list 'refresh (dns-read-int32)) |
| 287 | (list 'retry (dns-read-int32)) | 287 | (list 'retry (dns-read-int32)) |
| 288 | (list 'expire (dns-read-int32)) | 288 | (list 'expire (dns-read-int32)) |
| 289 | (list 'minimum (dns-read-int32)))) | 289 | (list 'minimum (dns-read-int32)))) |
| 290 | ((eq type 'SRV) | 290 | ((eq type 'SRV) |
| 291 | (list (list 'priority (dns-read-bytes 2)) | 291 | (list (list 'priority (dns-read-bytes 2)) |
| 292 | (list 'weight (dns-read-bytes 2)) | 292 | (list 'weight (dns-read-bytes 2)) |
| 293 | (list 'port (dns-read-bytes 2)) | 293 | (list 'port (dns-read-bytes 2)) |
| 294 | (list 'target (dns-read-name buffer)))) | 294 | (list 'target (dns-read-name buffer)))) |
| 295 | ((eq type 'MX) | 295 | ((eq type 'MX) |
| 296 | (cons (dns-read-bytes 2) (dns-read-name buffer))) | 296 | (cons (dns-read-bytes 2) (dns-read-name buffer))) |
| 297 | ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR)) | 297 | ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR)) |
| 298 | (dns-read-string-name string buffer)) | 298 | (dns-read-string-name string buffer)) |
| 299 | (t string)))) | 299 | (t string))) |
| 300 | (goto-char point)))) | 300 | (goto-char point)))) |
| 301 | 301 | ||
| 302 | (defun dns-parse-resolv-conf () | 302 | (defun dns-parse-resolv-conf () |
| @@ -378,53 +378,53 @@ If REVERSEP, look up an IP address." | |||
| 378 | 378 | ||
| 379 | (if (not dns-servers) | 379 | (if (not dns-servers) |
| 380 | (message "No DNS server configuration found") | 380 | (message "No DNS server configuration found") |
| 381 | (let (default-enable-multibyte-characters) | 381 | (with-temp-buffer |
| 382 | (with-temp-buffer | 382 | (set-buffer-multibyte nil) |
| 383 | (let ((process (condition-case () | 383 | (let ((process (condition-case () |
| 384 | (dns-make-network-process (car dns-servers)) | 384 | (dns-make-network-process (car dns-servers)) |
| 385 | (error | 385 | (error |
| 386 | (message | 386 | (message |
| 387 | "dns: Got an error while trying to talk to %s" | 387 | "dns: Got an error while trying to talk to %s" |
| 388 | (car dns-servers)) | 388 | (car dns-servers)) |
| 389 | nil))) | 389 | nil))) |
| 390 | (tcp-p (and (not (fboundp 'make-network-process)) | 390 | (tcp-p (and (not (fboundp 'make-network-process)) |
| 391 | (not (featurep 'xemacs)))) | 391 | (not (featurep 'xemacs)))) |
| 392 | (step 100) | 392 | (step 100) |
| 393 | (times (* dns-timeout 1000)) | 393 | (times (* dns-timeout 1000)) |
| 394 | (id (random 65000))) | 394 | (id (random 65000))) |
| 395 | (when process | 395 | (when process |
| 396 | (process-send-string | 396 | (process-send-string |
| 397 | process | 397 | process |
| 398 | (dns-write `((id ,id) | 398 | (dns-write `((id ,id) |
| 399 | (opcode query) | 399 | (opcode query) |
| 400 | (queries ((,name (type ,type)))) | 400 | (queries ((,name (type ,type)))) |
| 401 | (recursion-desired-p t)) | 401 | (recursion-desired-p t)) |
| 402 | tcp-p)) | 402 | tcp-p)) |
| 403 | (while (and (zerop (buffer-size)) | 403 | (while (and (zerop (buffer-size)) |
| 404 | (> times 0)) | 404 | (> times 0)) |
| 405 | (sit-for (/ step 1000.0)) | 405 | (sit-for (/ step 1000.0)) |
| 406 | (accept-process-output process 0 step) | 406 | (accept-process-output process 0 step) |
| 407 | (setq times (- times step))) | 407 | (setq times (- times step))) |
| 408 | (condition-case nil | 408 | (condition-case nil |
| 409 | (delete-process process) | 409 | (delete-process process) |
| 410 | (error nil)) | 410 | (error nil)) |
| 411 | (when (and tcp-p | 411 | (when (and tcp-p |
| 412 | (>= (buffer-size) 2)) | 412 | (>= (buffer-size) 2)) |
| 413 | (goto-char (point-min)) | 413 | (goto-char (point-min)) |
| 414 | (delete-region (point) (+ (point) 2))) | 414 | (delete-region (point) (+ (point) 2))) |
| 415 | (when (and (>= (buffer-size) 2) | 415 | (when (and (>= (buffer-size) 2) |
| 416 | ;; We had a time-out. | 416 | ;; We had a time-out. |
| 417 | (> times 0)) | 417 | (> times 0)) |
| 418 | (let ((result (dns-read (buffer-string)))) | 418 | (let ((result (dns-read (buffer-string)))) |
| 419 | (if fullp | 419 | (if fullp |
| 420 | result | 420 | result |
| 421 | (let ((answer (car (dns-get 'answers result)))) | 421 | (let ((answer (car (dns-get 'answers result)))) |
| 422 | (when (eq type (dns-get 'type answer)) | 422 | (when (eq type (dns-get 'type answer)) |
| 423 | (if (eq type 'TXT) | 423 | (if (eq type 'TXT) |
| 424 | (dns-get-txt-answer (dns-get 'answers result)) | 424 | (dns-get-txt-answer (dns-get 'answers result)) |
| 425 | (dns-get 'data answer))))))))))))) | 425 | (dns-get 'data answer)))))))))))) |
| 426 | 426 | ||
| 427 | (provide 'dns) | 427 | (provide 'dns) |
| 428 | 428 | ||
| 429 | ;;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a | 429 | ;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a |
| 430 | ;;; dns.el ends here | 430 | ;;; dns.el ends here |