aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2008-03-12 20:52:31 +0000
committerStefan Monnier2008-03-12 20:52:31 +0000
commiteb21f2ff519ebd89e37f39652ae84328cc6c78d2 (patch)
tree960fa531e8faab2f66882ece1135644edfa62c5f
parent5d2e28bfb45805e2ae248d44ceb4b7a65b331656 (diff)
downloademacs-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/ChangeLog1
-rw-r--r--lisp/net/dns.el294
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 @@
12008-03-12 Stefan Monnier <monnier@iro.umontreal.ca> 12008-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