Mercurial > emacs

changeset 92781:f231a5d1706d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(dns-read-string-name, dns-read, dns-read-type, query-dns): Use set-buffer-multibyte rather than set default-enable-multibyte-characters.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 12 Mar 2008 20:52:31 +0000
parents 23eda9299411
children b643f53a57c5
files lisp/ChangeLog lisp/net/dns.el
diffstat 2 files changed, 148 insertions(+), 147 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Mar 12 20:51:26 2008 +0000
+++ b/lisp/ChangeLog	Wed Mar 12 20:52:31 2008 +0000
@@ -1,5 +1,6 @@
 2008-03-12  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* net/dns.el (dns-read-string-name, dns-read, dns-read-type, query-dns):
 	* sha1.el (sha1-string-external): Use set-buffer-multibyte rather than
 	setting default-enable-multibyte-characters.
 
--- a/lisp/net/dns.el	Wed Mar 12 20:51:26 2008 +0000
+++ b/lisp/net/dns.el	Wed Mar 12 20:52:31 2008 +0000
@@ -102,11 +102,11 @@
   (dns-write-bytes 0))
 
 (defun dns-read-string-name (string buffer)
-  (let (default-enable-multibyte-characters)
-    (with-temp-buffer
-      (insert string)
-      (goto-char (point-min))
-      (dns-read-name buffer))))
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (insert string)
+    (goto-char (point-min))
+    (dns-read-name buffer)))
 
 (defun dns-read-name (&optional buffer)
   (let ((ended nil)
@@ -186,72 +186,72 @@
     (buffer-string)))
 
 (defun dns-read (packet)
-  (let (default-enable-multibyte-characters)
-    (with-temp-buffer
-      (let ((spec nil)
-            queries answers authorities additionals)
-        (insert packet)
-        (goto-char (point-min))
-        (push (list 'id (dns-read-bytes 2)) spec)
-        (let ((byte (dns-read-bytes 1)))
-          (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
-                spec)
-          (let ((opcode (logand byte (lsh 7 3))))
-            (push (list 'opcode
-                        (cond ((eq opcode 0) 'query)
-                              ((eq opcode 1) 'inverse-query)
-                              ((eq opcode 2) 'status)))
-                  spec))
-          (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
-                                           nil t)) spec)
-          (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
-                spec)
-          (push (list 'recursion-desired-p
-                      (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
-        (let ((rc (logand (dns-read-bytes 1) 15)))
-          (push (list 'response-code
-                      (cond
-                       ((eq rc 0) 'no-error)
-                       ((eq rc 1) 'format-error)
-                       ((eq rc 2) 'server-failure)
-                       ((eq rc 3) 'name-error)
-                       ((eq rc 4) 'not-implemented)
-                       ((eq rc 5) 'refused)))
+  (with-temp-buffer
+    (set-buffer-multibyte nil)
+    (let ((spec nil)
+          queries answers authorities additionals)
+      (insert packet)
+      (goto-char (point-min))
+      (push (list 'id (dns-read-bytes 2)) spec)
+      (let ((byte (dns-read-bytes 1)))
+        (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
+              spec)
+        (let ((opcode (logand byte (lsh 7 3))))
+          (push (list 'opcode
+                      (cond ((eq opcode 0) 'query)
+                            ((eq opcode 1) 'inverse-query)
+                            ((eq opcode 2) 'status)))
                 spec))
-        (setq queries (dns-read-bytes 2))
-        (setq answers (dns-read-bytes 2))
-        (setq authorities (dns-read-bytes 2))
-        (setq additionals (dns-read-bytes 2))
-        (let ((qs nil))
-          (dotimes (i queries)
+        (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
+                                         nil t)) spec)
+        (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
+              spec)
+        (push (list 'recursion-desired-p
+                    (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
+      (let ((rc (logand (dns-read-bytes 1) 15)))
+        (push (list 'response-code
+                    (cond
+                     ((eq rc 0) 'no-error)
+                     ((eq rc 1) 'format-error)
+                     ((eq rc 2) 'server-failure)
+                     ((eq rc 3) 'name-error)
+                     ((eq rc 4) 'not-implemented)
+                     ((eq rc 5) 'refused)))
+              spec))
+      (setq queries (dns-read-bytes 2))
+      (setq answers (dns-read-bytes 2))
+      (setq authorities (dns-read-bytes 2))
+      (setq additionals (dns-read-bytes 2))
+      (let ((qs nil))
+        (dotimes (i queries)
+          (push (list (dns-read-name)
+                      (list 'type (dns-inverse-get (dns-read-bytes 2)
+                                                   dns-query-types))
+                      (list 'class (dns-inverse-get (dns-read-bytes 2)
+                                                    dns-classes)))
+                qs))
+        (push (list 'queries qs) spec))
+      (dolist (slot '(answers authorities additionals))
+        (let ((qs nil)
+              type)
+          (dotimes (i (symbol-value slot))
             (push (list (dns-read-name)
-                        (list 'type (dns-inverse-get (dns-read-bytes 2)
-                                                     dns-query-types))
+                        (list 'type
+                              (setq type (dns-inverse-get (dns-read-bytes 2)
+                                                          dns-query-types)))
                         (list 'class (dns-inverse-get (dns-read-bytes 2)
-                                                      dns-classes)))
+                                                      dns-classes))
+                        (list 'ttl (dns-read-bytes 4))
+                        (let ((length (dns-read-bytes 2)))
+                          (list 'data
+                                (dns-read-type
+                                 (buffer-substring
+                                  (point)
+                                  (progn (forward-char length) (point)))
+                                 type))))
                   qs))
-          (push (list 'queries qs) spec))
-        (dolist (slot '(answers authorities additionals))
-          (let ((qs nil)
-                type)
-            (dotimes (i (symbol-value slot))
-              (push (list (dns-read-name)
-                          (list 'type
-                                (setq type (dns-inverse-get (dns-read-bytes 2)
-                                                            dns-query-types)))
-                          (list 'class (dns-inverse-get (dns-read-bytes 2)
-                                                        dns-classes))
-                          (list 'ttl (dns-read-bytes 4))
-                          (let ((length (dns-read-bytes 2)))
-                            (list 'data
-                                  (dns-read-type
-                                   (buffer-substring
-                                    (point)
-                                    (progn (forward-char length) (point)))
-                                   type))))
-                    qs))
-            (push (list slot qs) spec)))
-        (nreverse spec)))))
+          (push (list slot qs) spec)))
+      (nreverse spec))))
 
 (defun dns-read-int32 ()
   ;; Full 32 bit Integers can't be handled by Emacs.  If we use
@@ -263,40 +263,40 @@
   (let ((buffer (current-buffer))
 	(point (point)))
     (prog1
-        (let (default-enable-multibyte-characters)
-          (with-temp-buffer
-            (insert string)
-            (goto-char (point-min))
-            (cond
-             ((eq type 'A)
-              (let ((bytes nil))
-                (dotimes (i 4)
-                  (push (dns-read-bytes 1) bytes))
-                (mapconcat 'number-to-string (nreverse bytes) ".")))
-             ((eq type 'AAAA)
-              (let (hextets)
-                (dotimes (i 8)
-                  (push (dns-read-bytes 2) hextets))
-                (mapconcat (lambda (n) (format "%x" n))
-                           (nreverse hextets) ":")))
-             ((eq type 'SOA)
-              (list (list 'mname (dns-read-name buffer))
-                    (list 'rname (dns-read-name buffer))
-                    (list 'serial (dns-read-int32))
-                    (list 'refresh (dns-read-int32))
-                    (list 'retry (dns-read-int32))
-                    (list 'expire (dns-read-int32))
-                    (list 'minimum (dns-read-int32))))
-             ((eq type 'SRV)
-              (list (list 'priority (dns-read-bytes 2))
-                    (list 'weight (dns-read-bytes 2))
-                    (list 'port (dns-read-bytes 2))
-                    (list 'target (dns-read-name buffer))))
-             ((eq type 'MX)
-              (cons (dns-read-bytes 2) (dns-read-name buffer)))
-             ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
-              (dns-read-string-name string buffer))
-             (t string))))
+        (with-temp-buffer
+          (set-buffer-multibyte nil)
+          (insert string)
+          (goto-char (point-min))
+          (cond
+           ((eq type 'A)
+            (let ((bytes nil))
+              (dotimes (i 4)
+                (push (dns-read-bytes 1) bytes))
+              (mapconcat 'number-to-string (nreverse bytes) ".")))
+           ((eq type 'AAAA)
+            (let (hextets)
+              (dotimes (i 8)
+                (push (dns-read-bytes 2) hextets))
+              (mapconcat (lambda (n) (format "%x" n))
+                         (nreverse hextets) ":")))
+           ((eq type 'SOA)
+            (list (list 'mname (dns-read-name buffer))
+                  (list 'rname (dns-read-name buffer))
+                  (list 'serial (dns-read-int32))
+                  (list 'refresh (dns-read-int32))
+                  (list 'retry (dns-read-int32))
+                  (list 'expire (dns-read-int32))
+                  (list 'minimum (dns-read-int32))))
+           ((eq type 'SRV)
+            (list (list 'priority (dns-read-bytes 2))
+                  (list 'weight (dns-read-bytes 2))
+                  (list 'port (dns-read-bytes 2))
+                  (list 'target (dns-read-name buffer))))
+           ((eq type 'MX)
+            (cons (dns-read-bytes 2) (dns-read-name buffer)))
+           ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
+            (dns-read-string-name string buffer))
+           (t string)))
       (goto-char point))))
 
 (defun dns-parse-resolv-conf ()
@@ -378,53 +378,53 @@
 
   (if (not dns-servers)
       (message "No DNS server configuration found")
-    (let (default-enable-multibyte-characters)
-      (with-temp-buffer
-        (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)
-                          (opcode query)
-                          (queries ((,name (type ,type))))
-                          (recursion-desired-p t))
-                        tcp-p))
-            (while (and (zerop (buffer-size))
-                        (> times 0))
-              (sit-for (/ step 1000.0))
-              (accept-process-output process 0 step)
-              (setq times (- times step)))
-            (condition-case nil
-                (delete-process process)
-              (error nil))
-            (when (and tcp-p
-                       (>= (buffer-size) 2))
-              (goto-char (point-min))
-              (delete-region (point) (+ (point) 2)))
-            (when (and (>= (buffer-size) 2)
-                       ;; We had a time-out.
-                       (> times 0))
-              (let ((result (dns-read (buffer-string))))
-                (if fullp
-                    result
-                  (let ((answer (car (dns-get 'answers result))))
-                    (when (eq type (dns-get 'type answer))
-                      (if (eq type 'TXT)
-                          (dns-get-txt-answer (dns-get 'answers result))
-                        (dns-get 'data answer)))))))))))))
+    (with-temp-buffer
+      (set-buffer-multibyte nil)
+      (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)
+                        (opcode query)
+                        (queries ((,name (type ,type))))
+                        (recursion-desired-p t))
+                      tcp-p))
+          (while (and (zerop (buffer-size))
+                      (> times 0))
+            (sit-for (/ step 1000.0))
+            (accept-process-output process 0 step)
+            (setq times (- times step)))
+          (condition-case nil
+              (delete-process process)
+            (error nil))
+          (when (and tcp-p
+                     (>= (buffer-size) 2))
+            (goto-char (point-min))
+            (delete-region (point) (+ (point) 2)))
+          (when (and (>= (buffer-size) 2)
+                     ;; We had a time-out.
+                     (> times 0))
+            (let ((result (dns-read (buffer-string))))
+              (if fullp
+                  result
+                (let ((answer (car (dns-get 'answers result))))
+                  (when (eq type (dns-get 'type answer))
+                    (if (eq type 'TXT)
+                        (dns-get-txt-answer (dns-get 'answers result))
+                      (dns-get 'data answer))))))))))))
 
 (provide 'dns)
 
-;;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a
+;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a
 ;;; dns.el ends here