From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 2 May 1995 00:40:13 +0000 (+0000)
Subject: Previously a POP password was discarded any time an error happened
X-Git-Tag: 20090517-FFI~6360
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=80f0e0d0e5a1ffd05b9783e70bb3246401bda7a0;p=mit-scheme.git

Previously a POP password was discarded any time an error happened
while fetching mail from the POP server.  Now, once mail has been
fetched successfully, the password is kept regardless of any errors.
---

diff --git a/v7/src/edwin/rmail.scm b/v7/src/edwin/rmail.scm
index 116ef645a..e87c4139c 100644
--- a/v7/src/edwin/rmail.scm
+++ b/v7/src/edwin/rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: rmail.scm,v 1.40 1995/04/30 06:53:42 cph Exp $
+;;;	$Id: rmail.scm,v 1.41 1995/05/02 00:40:13 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991-95 Massachusetts Institute of Technology
 ;;;
@@ -603,7 +603,7 @@ This variable is ignored if rmail-pop-procedure is #F."
   (let ((procedure (ref-variable rmail-pop-procedure buffer)))
     (and procedure
 	 (call-with-values (lambda () (get-pop-account-info server buffer))
-	   (lambda (user-name password)
+	   (lambda (user-name password save-password?)
 	     (let ((msg
 		    (string-append "Getting mail from POP server "
 				   server
@@ -611,22 +611,18 @@ This variable is ignored if rmail-pop-procedure is #F."
 	       (message msg)
 	       (let ((value
 		      (insert
-		       (let ((success? #f))
-			 (dynamic-wind
-			  (lambda () unspecific)
-			  (lambda ()
-			    (let ((filename
-				   (procedure
-				    server user-name password
-				    (buffer-default-directory buffer))))
-			      (set! success? #t)
-			      filename))
-			  (lambda ()
-			    ;; Failure might be due to bad password.
-			    (if (not success?)
-				(delete-saved-pop-server-password
-				 server
-				 user-name))))))))
+		       (let ((filename
+			      (procedure
+			       server user-name password
+			       (buffer-default-directory buffer))))
+			 (if save-password?
+			     ;; Password is saved only after
+			     ;; successful execution of the client, to
+			     ;; prevent saving an incorrect password.
+			     (save-pop-server-password server
+						       user-name
+						       password))
+			 filename))))
 		 (message msg "done")
 		 value)))))))
 
@@ -635,24 +631,23 @@ This variable is ignored if rmail-pop-procedure is #F."
     (if entry
 	(let ((user-name (cadr entry))
 	      (password (caddr entry)))
-	  (values user-name
-		  (case password
-		    ((PROMPT-ONCE)
-		     (or (get-saved-pop-server-password server user-name)
-			 (let ((password
-				(prompt-for-pop-server-password server)))
-			   (save-pop-server-password server user-name password)
-			   password)))
-		    ((PROMPT-ALWAYS)
-		     (prompt-for-pop-server-password server))
-		    (else
-		     password))))
+	  (case password
+	    ((PROMPT-ONCE)
+	     (let ((password (get-saved-pop-server-password server user-name)))
+	       (if password
+		   (values user-name password #f)
+		   (values user-name
+			   (prompt-for-pop-server-password server)
+			   #t))))
+	    ((PROMPT-ALWAYS)
+	     (values user-name (prompt-for-pop-server-password server) #f))
+	    (else
+	     (values user-name password #f))))
 	(let ((user-name
 	       (prompt-for-string
 		(string-append "User name for POP server " server)
 		(current-user-name))))
-	  (values user-name
-		  (prompt-for-pop-server-password server))))))
+	  (values user-name (prompt-for-pop-server-password server) #f)))))
 
 (define (get-saved-pop-server-password server user-name)
   (let ((entry (assoc (cons server user-name) saved-pop-passwords)))