(smtpmail-read-response): Abort if process has

died to avoid infloop.  Reported by Jonathan Glauner
<jglauner@sbum.org>.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b2237cb06209a8ca34bd0e722abf8e382663d310..4fbf3c5aea5a458cda1f8bf68716700e9bc55f9a 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2004-03-11  Simon Josefsson  <jas@extundo.com>
+
+       * mail/smtpmail.el (smtpmail-read-response): Abort if process has
+       died to avoid infloop.  Reported by Jonathan Glauner
+       <jglauner@sbum.org>.
+
 2004-03-10  John Paul Wallington  <jpw@gnu.org>
 
        * foldout.el (foldout-fold-list, foldout-modeline-string): 

diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index e516133c6a00ac9249921f1933606a463dda8e05..3ebea497e87d9bc64ac38ecdcf7642792e090639 100644 (file)
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -1,6 +1,6 @@
 ;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
 
-;; Copyright (C) 1995, 1996, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
 ;; Maintainer: Simon Josefsson <simon@josefsson.org>
@@ -778,49 +778,49 @@ This is relative to `smtpmail-queue-dir'.")
        (response-continue t)
        (return-value '(nil ()))
        match-end)
-
-    (while response-continue
-      (goto-char smtpmail-read-point)
-      (while (not (search-forward "\r\n" nil t))
-       (accept-process-output process)
-       (goto-char smtpmail-read-point))
-
-      (setq match-end (point))
-      (setq response-strings
-           (cons (buffer-substring smtpmail-read-point (- match-end 2))
-                 response-strings))
-
-      (goto-char smtpmail-read-point)
-      (if (looking-at "[0-9]+ ")
-         (let ((begin (match-beginning 0))
-               (end (match-end 0)))
-           (if smtpmail-debug-info
-               (message "%s" (car response-strings)))
-
-           (setq smtpmail-read-point match-end)
-
-           ;; ignore lines that start with "0"
-           (if (looking-at "0[0-9]+ ")
-               nil
+    (catch 'done
+      (while response-continue
+       (goto-char smtpmail-read-point)
+       (while (not (search-forward "\r\n" nil t))
+         (unless (memq (process-status process) '(open run))
+           (throw 'done nil))
+         (accept-process-output process)
+         (goto-char smtpmail-read-point))
+
+       (setq match-end (point))
+       (setq response-strings
+             (cons (buffer-substring smtpmail-read-point (- match-end 2))
+                   response-strings))
+
+       (goto-char smtpmail-read-point)
+       (if (looking-at "[0-9]+ ")
+           (let ((begin (match-beginning 0))
+                 (end (match-end 0)))
+             (if smtpmail-debug-info
+                 (message "%s" (car response-strings)))
+
+             (setq smtpmail-read-point match-end)
+
+             ;; ignore lines that start with "0"
+             (if (looking-at "0[0-9]+ ")
+                 nil
+               (setq response-continue nil)
+               (setq return-value
+                     (cons (string-to-int
+                            (buffer-substring begin end))
+                           (nreverse response-strings)))))
+
+         (if (looking-at "[0-9]+-")
+             (progn (if smtpmail-debug-info
+                        (message "%s" (car response-strings)))
+                    (setq smtpmail-read-point match-end)
+                    (setq response-continue t))
+           (progn
+             (setq smtpmail-read-point match-end)
              (setq response-continue nil)
              (setq return-value
-                   (cons (string-to-int
-                          (buffer-substring begin end))
-                         (nreverse response-strings)))))
-
-       (if (looking-at "[0-9]+-")
-           (progn (if smtpmail-debug-info
-                    (message "%s" (car response-strings)))
-                  (setq smtpmail-read-point match-end)
-                  (setq response-continue t))
-         (progn
-           (setq smtpmail-read-point match-end)
-           (setq response-continue nil)
-           (setq return-value
-                 (cons nil (nreverse response-strings)))
-           )
-         )))
-    (setq smtpmail-read-point match-end)
+                   (cons nil (nreverse response-strings)))))))
+      (setq smtpmail-read-point match-end))
     return-value))