Mercurial > emacs

changeset 92778:054fe9aaf3e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use with-current-buffer. (nntp-send-buffer): Just set the buffer to unibyte rather than use the dubious mm-with-unibyte-current-buffer. (nntp-with-open-group-function): New function extracted from nntp-with-open-group macro. (nntp-with-open-group): Use the function, so it's easier to debug. Add indentation and debugging info. (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet): Recommend the use of the netcat alternatives.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 12 Mar 2008 19:56:09 +0000
parents 1186239f19c8
children e9bef8bf2940
files lisp/gnus/ChangeLog lisp/gnus/nntp.el
diffstat 2 files changed, 105 insertions(+), 97 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Wed Mar 12 19:40:14 2008 +0000
+++ b/lisp/gnus/ChangeLog	Wed Mar 12 19:56:09 2008 +0000
@@ -1,5 +1,15 @@
 2008-03-12  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* nntp.el: Use with-current-buffer.
+	(nntp-send-buffer): Just set the buffer to unibyte rather than use the
+	dubious mm-with-unibyte-current-buffer.
+	(nntp-with-open-group-function): New function extracted from
+	nntp-with-open-group macro.
+	(nntp-with-open-group): Use the function, so it's easier to debug.
+	Add indentation and debugging info.
+	(nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet): Recommend the
+	use of the netcat alternatives.
+
 	* rfc2047.el (rfc2047-decode-string): Don't use `m'.
 	Avoid mm-string-as-multibyte as well.
 
--- a/lisp/gnus/nntp.el	Wed Mar 12 19:40:14 2008 +0000
+++ b/lisp/gnus/nntp.el	Wed Mar 12 19:56:09 2008 +0000
@@ -335,8 +335,7 @@
 
 (defun nntp-record-command (string)
   "Record the command STRING."
-  (save-excursion
-    (set-buffer (get-buffer-create "*nntp-log*"))
+  (with-current-buffer (get-buffer-create "*nntp-log*")
     (goto-char (point-max))
     (let ((time (current-time)))
       (insert (format-time-string "%Y%m%dT%H%M%S" time)
@@ -393,8 +392,7 @@
 (defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
   "Wait for WAIT-FOR to arrive from PROCESS."
 
-  (save-excursion
-    (set-buffer (process-buffer process))
+  (with-current-buffer (process-buffer process)
     (goto-char (point-min))
 
     (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
@@ -432,8 +430,7 @@
 	      (setq nntp-process-response response)))
 	  (nntp-decode-text (not decode))
 	  (unless discard
-	    (save-excursion
-	      (set-buffer buffer)
+	    (with-current-buffer buffer
 	      (goto-char (point-max))
 	      (nntp-insert-buffer-substring (process-buffer process))
 	      ;; Nix out "nntp reading...." message.
@@ -539,8 +536,7 @@
 		       nntp-open-connection-function
 		       nntp-open-connection-functions-never-echo-commands))
 	    (nntp-accept-response)
-	    (save-excursion
-	      (set-buffer buffer)
+	    (with-current-buffer buffer
 	      (goto-char pos)
 	      (if (looking-at (regexp-quote command))
 		  (delete-region pos (progn (forward-line 1)
@@ -563,8 +559,7 @@
 	  ;; If nothing to wait for, still remove possibly echo'ed commands
 	  (unless wait-for
 	    (nntp-accept-response)
-	    (save-excursion
-	      (set-buffer buffer)
+	    (with-current-buffer buffer
 	      (goto-char pos)
 	      (if (looking-at (regexp-quote command))
 		  (delete-region pos (progn (forward-line 1)
@@ -590,8 +585,7 @@
 	  ;; If nothing to wait for, still remove possibly echo'ed commands
 	  (unless wait-for
 	    (nntp-accept-response)
-	    (save-excursion
-	      (set-buffer buffer)
+	    (with-current-buffer buffer
 	      (goto-char pos)
 	      (if (looking-at (regexp-quote command))
 		  (delete-region pos (progn (forward-line 1) (point-at-bol))))
@@ -607,10 +601,12 @@
     (nntp-erase-buffer
      (nntp-find-connection-buffer nntp-server-buffer)))
   (nntp-encode-text)
-  (mm-with-unibyte-current-buffer
-    ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
-    (process-send-region (nntp-find-connection nntp-server-buffer)
-			 (point-min) (point-max)))
+  ;; Make sure we did not forget to encode some of the content.
+  (assert (save-excursion (goto-char (point-min))
+                          (not (re-search-forward "[^\000-\377]" nil t))))
+  (mm-disable-multibyte)
+  (process-send-region (nntp-find-connection nntp-server-buffer)
+                       (point-min) (point-max))
   (nntp-retrieve-data
    nil nntp-address nntp-port-number nntp-server-buffer
    wait-for nnheader-callback-function))
@@ -648,67 +644,79 @@
   (defvar nntp-with-open-group-internal nil)
   (defvar nntp-report-n nil))
 
+(defun nntp-with-open-group-function (-group -server -connectionless -bodyfun)
+  "Protect against servers that don't like clients that keep idle connections opens.
+The problem being that these servers may either close a connection or
+simply ignore any further requests on a connection.  Closed
+connections are not detected until `accept-process-output' has updated
+the `process-status'.  Dropped connections are not detected until the
+connection timeouts (which may be several minutes) or
+`nntp-connection-timeout' has expired.  When these occur
+`nntp-with-open-group', opens a new connection then re-issues the NNTP
+command whose response triggered the error."
+  (letf ((nntp-report-n (symbol-function 'nntp-report))
+         ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
+         (nntp-with-open-group-internal nil))
+    (while (catch 'nntp-with-open-group-error
+             ;; Open the connection to the server
+             ;; NOTE: Existing connections are NOT tested.
+             (nntp-possibly-change-group -group -server -connectionless)
+
+             (let ((-timer
+                    (and nntp-connection-timeout
+                         (run-at-time
+                          nntp-connection-timeout nil
+                          (lambda ()
+                            (let* ((-process (nntp-find-connection
+                                             nntp-server-buffer))
+                                   (-buffer  (and -process
+                                                  (process-buffer -process))))
+                              ;; When I an able to identify the
+                              ;; connection to the server AND I've
+                              ;; received NO reponse for
+                              ;; nntp-connection-timeout seconds.
+                              (when (and -buffer (eq 0 (buffer-size -buffer)))
+                                ;; Close the connection.  Take no
+                                ;; other action as the accept input
+                                ;; code will handle the closed
+                                ;; connection.
+                                (nntp-kill-buffer -buffer))))))))
+               (unwind-protect
+                   (setq nntp-with-open-group-internal
+                         (condition-case nil
+                             (funcall -bodyfun)
+                           (quit
+                            (unless debug-on-quit
+                              (nntp-close-server))
+                            (signal 'quit nil))))
+                 (when -timer
+                   (nnheader-cancel-timer -timer)))
+               nil))
+      (setf (symbol-function 'nntp-report) nntp-report-n))
+    nntp-with-open-group-internal))
+
 (defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
   "Protect against servers that don't like clients that keep idle connections opens.
 The problem being that these servers may either close a connection or
 simply ignore any further requests on a connection.  Closed
-connections are not detected until accept-process-output has updated
-the process-status.  Dropped connections are not detected until the
+connections are not detected until `accept-process-output' has updated
+the `process-status'.  Dropped connections are not detected until the
 connection timeouts (which may be several minutes) or
-nntp-connection-timeout has expired.  When these occur
-nntp-with-open-group, opens a new connection then re-issues the NNTP
+`nntp-connection-timeout' has expired.  When these occur
+`nntp-with-open-group', opens a new connection then re-issues the NNTP
 command whose response triggered the error."
+  (declare (indent 2) (debug (form form [&optional symbolp] def-body)))
   (when (and (listp connectionless)
 	     (not (eq connectionless nil)))
     (setq forms (cons connectionless forms)
 	  connectionless nil))
-  `(letf ((nntp-report-n (symbol-function 'nntp-report))
-	  ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
-	  (nntp-with-open-group-internal nil))
-     (while (catch 'nntp-with-open-group-error
-	      ;; Open the connection to the server
-	      ;; NOTE: Existing connections are NOT tested.
-	      (nntp-possibly-change-group ,group ,server ,connectionless)
-
-	      (let ((timer
-		     (and nntp-connection-timeout
-			  (run-at-time
-			   nntp-connection-timeout nil
-			   '(lambda ()
-			      (let ((process (nntp-find-connection
-					      nntp-server-buffer))
-				    (buffer  (and process
-						  (process-buffer process))))
-				;; When I am able to identify the
-				;; connection to the server AND I've
-				;; received NO reponse for
-				;; nntp-connection-timeout seconds.
-				(when (and buffer (eq 0 (buffer-size buffer)))
-				  ;; Close the connection.  Take no
-				  ;; other action as the accept input
-				  ;; code will handle the closed
-				  ;; connection.
-				  (nntp-kill-buffer buffer))))))))
-		(unwind-protect
-		    (setq nntp-with-open-group-internal
-                          (condition-case nil
-			      (progn ,@forms)
-			    (quit
-			     (unless debug-on-quit
-			       (nntp-close-server))
-                             (signal 'quit nil))))
-		  (when timer
-		    (nnheader-cancel-timer timer)))
-		nil))
-       (setf (symbol-function 'nntp-report) nntp-report-n))
-     nntp-with-open-group-internal))
+  `(nntp-with-open-group-function ,group ,server ,connectionless (lambda () ,@forms)))
 
 (deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
   "Retrieve the headers of ARTICLES."
   (nntp-with-open-group
    group server
-   (save-excursion
-     (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
+   (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer)
      (erase-buffer)
      (if (and (not gnus-nov-is-evil)
               (not nntp-nov-is-evil)
@@ -930,8 +938,7 @@
 
 (defun nntp-try-list-active (group)
   (nntp-list-active-group group)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer
     (goto-char (point-min))
     (cond ((or (eobp)
 	       (looking-at "5[0-9]+"))
@@ -959,8 +966,7 @@
            (if (numberp article) (int-to-string article) article))
       (if (and buffer
                (not (equal buffer nntp-server-buffer)))
-          (save-excursion
-            (set-buffer nntp-server-buffer)
+          (with-current-buffer nntp-server-buffer
             (copy-to-buffer buffer (point-min) (point-max))
             (nntp-find-group-and-number group))
         (nntp-find-group-and-number group)))))
@@ -1057,8 +1063,7 @@
 (deffoo nntp-request-newgroups (date &optional server)
   (nntp-with-open-group
    nil server
-   (save-excursion
-     (set-buffer nntp-server-buffer)
+   (with-current-buffer nntp-server-buffer
      (let* ((time (date-to-time date))
             (ls (- (cadr time) (nth 8 (decode-time time)))))
        (cond ((< ls 0)
@@ -1227,12 +1232,11 @@
 
 (defun nntp-make-process-buffer (buffer)
   "Create a new, fresh buffer usable for nntp process connections."
-  (save-excursion
-    (set-buffer
-     (generate-new-buffer
-      (format " *server %s %s %s*"
-	      nntp-address nntp-port-number
-	      (gnus-buffer-exists-p buffer))))
+  (with-current-buffer
+      (generate-new-buffer
+       (format " *server %s %s %s*"
+               nntp-address nntp-port-number
+               (gnus-buffer-exists-p buffer)))
     (mm-disable-multibyte)
     (set (make-local-variable 'after-change-functions) nil)
     (set (make-local-variable 'nntp-process-wait-for) nil)
@@ -1275,8 +1279,7 @@
 	  (prog1
 	      (caar (push (list process buffer nil) nntp-connection-alist))
 	    (push process nntp-connection-list)
-	    (save-excursion
-	      (set-buffer pbuffer)
+	    (with-current-buffer pbuffer
 	      (nntp-read-server-type)
 	      (erase-buffer)
 	      (set-buffer nntp-server-buffer)
@@ -1304,8 +1307,7 @@
 					    ?s nntp-address
 					    ?p nntp-port-number)))))
     (gnus-set-process-query-on-exit-flag proc nil)
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (let ((nntp-connection-alist (list proc buffer nil)))
 	(nntp-wait-for-string "^\r*20[01]"))
       (beginning-of-line)
@@ -1315,8 +1317,7 @@
 (defun nntp-open-tls-stream (buffer)
   (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
     (gnus-set-process-query-on-exit-flag proc nil)
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (let ((nntp-connection-alist (list proc buffer nil)))
 	(nntp-wait-for-string "^\r*20[01]"))
       (beginning-of-line)
@@ -1337,8 +1338,7 @@
 	  (funcall (cadr entry)))))))
 
 (defun nntp-async-wait (process wait-for buffer decode callback)
-  (save-excursion
-    (set-buffer (process-buffer process))
+  (with-current-buffer (process-buffer process)
     (unless nntp-inside-change-function
       (erase-buffer))
     (setq nntp-process-wait-for wait-for
@@ -1386,8 +1386,7 @@
       (setq after-change-functions '(nntp-after-change-function)))))
 
 (defun nntp-async-trigger (process)
-  (save-excursion
-    (set-buffer (process-buffer process))
+  (with-current-buffer (process-buffer process)
     (when nntp-process-callback
       ;; do we have an error message?
       (goto-char nntp-process-start-point)
@@ -1412,8 +1411,7 @@
 	    (let ((buf (current-buffer))
 		  (start nntp-process-start-point)
 		  (decode nntp-process-decode))
-	      (save-excursion
-		(set-buffer nntp-process-to-buffer)
+	      (with-current-buffer nntp-process-to-buffer
 		(goto-char (point-max))
 		(save-restriction
 		  (narrow-to-region (point) (point))
@@ -1477,8 +1475,7 @@
       (cond ((not entry)
              (nntp-report "Server closed connection"))
             ((not (equal group (caddr entry)))
-             (save-excursion
-               (set-buffer (process-buffer (car entry)))
+             (with-current-buffer (process-buffer (car entry))
                (erase-buffer)
                (nntp-send-command "^[245].*\n" "GROUP" group)
                (setcar (cddr entry) group)
@@ -1678,8 +1675,7 @@
 	;; We try them all until we get at positive response.
 	(while (and commands (eq nntp-server-xover 'try))
 	  (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
-	  (save-excursion
-	    (set-buffer nntp-server-buffer)
+	  (with-current-buffer nntp-server-buffer
 	    (goto-char (point-min))
 	    (and (looking-at "[23]")	; No error message.
 		 ;; We also have to look at the lines.  Some buggy
@@ -1700,6 +1696,7 @@
 (defun nntp-find-group-and-number (&optional group)
   (save-excursion
     (save-restriction
+      ;; FIXME: This is REALLY FISHY: set-buffer after save-restriction?!?
       (set-buffer nntp-server-buffer)
       (narrow-to-region (goto-char (point-min))
 			(or (search-forward "\n\n" nil t) (point-max)))
@@ -1876,6 +1873,8 @@
 
 (defun nntp-open-telnet-stream (buffer)
   "Open a nntp connection by telnet'ing the news server.
+`nntp-open-via-netcat' is recommended in place of this function
+because it is more reliable.
 
 Please refer to the following variables to customize the connection:
 - `nntp-pre-command',
@@ -1891,8 +1890,7 @@
     (and nntp-pre-command
 	 (push nntp-pre-command command))
     (setq proc (apply 'start-process "nntpd" buffer command))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (nntp-wait-for-string "^\r*20[01]")
       (beginning-of-line)
       (delete-region (point-min) (point))
@@ -1902,6 +1900,8 @@
   "Open a connection to an nntp server through an intermediate host.
 First rlogin to the remote host, and then telnet the real news server
 from there.
+`nntp-open-via-rlogin-and-netcat' is recommended in place of this function
+because it is more reliable.
 
 Please refer to the following variables to customize the connection:
 - `nntp-pre-command',
@@ -1926,8 +1926,7 @@
     (and nntp-pre-command
 	 (push nntp-pre-command command))
     (setq proc (apply 'start-process "nntpd" buffer command))
-    (save-excursion
-      (set-buffer buffer)
+    (with-current-buffer buffer
       (nntp-wait-for-string "^r?telnet")
       (process-send-string proc (concat "open " nntp-address
 					" " nntp-port-number "\n"))
@@ -1993,8 +1992,7 @@
 - `nntp-address',
 - `nntp-port-number',
 - `nntp-end-of-line'."
-  (save-excursion
-    (set-buffer buffer)
+  (with-current-buffer buffer
     (erase-buffer)
     (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
 	  (case-fold-search t)
@@ -2141,5 +2139,5 @@
 
 (provide 'nntp)
 
-;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
+;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
 ;;; nntp.el ends here