From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 25 May 2000 05:17:35 +0000 (+0000)
Subject: Don't store the user's pass phrase if the login fails.
X-Git-Tag: 20090517-FFI~3680
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8dd6bcb60cdb4cfcb1f468b359dcdcd407626777;p=mit-scheme.git

Don't store the user's pass phrase if the login fails.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 1a5fced5f..0be98f241 100644
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.90 2000/05/25 05:01:40 cph Exp $
+;;; $Id: imail-imap.scm,v 1.91 2000/05/25 05:16:36 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -328,16 +328,17 @@
 		   (lambda (condition)
 		     (let ((response (imap:server-error:response condition)))
 		       (if (imap:response:no? response)
-			   (error
-			    "Unable to log in:"
-			    (imap:response:response-text-string response)))))
+			   (begin
+			     (imail-delete-stored-pass-phrase url)
+			     (error "Unable to log in:"
+				    (imap:response:response-text-string
+				     response))))))
 		 (lambda ()
-		   (imail-call-with-pass-phrase
-		    (imap-connection-url connection)
-		    (lambda (pass-phrase)
-		      (imap:command:login connection
-					  (imap-url-user-id url)
-					  pass-phrase)))))
+		   (imail-call-with-pass-phrase url
+		     (lambda (pass-phrase)
+		       (imap:command:login connection
+					   (imap-url-user-id url)
+					   pass-phrase)))))
 	       (set! finished? #t))
 	     (lambda ()
 	       (if (not finished?)
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index fe30e984c..fcf079280 100644
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.108 2000/05/25 05:06:38 cph Exp $
+;;; $Id: imail-top.scm,v 1.109 2000/05/25 05:17:35 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -293,6 +293,9 @@ regardless of the folder type."
 		    entry)))
 	     (receiver pass-phrase)))))))
 
+(define (imail-delete-stored-pass-phrase url)
+  (hash-table/remove! memoized-pass-phrases (url-pass-phrase-key url)))
+
 (define (set-up-pass-phrase-timer! entry key retention-time)
   ;; A race condition can occur when the timer event is re-registered.
   ;; If the previous timer event is queued but not executed before