From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 May 2000 00:37:57 +0000 (+0000)
Subject: Fix bug: if there were two memoized connections to the same server,
X-Git-Tag: 20090517-FFI~3727
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0a1df62d8f05a3f1a22b7b283d63d08c7bca8b5b;p=mit-scheme.git

Fix bug: if there were two memoized connections to the same server,
GET-IMAP-CONNECTION was returning the first one, even if it was
closed.  It should look for one that is still open and use it, using
the closed one only if there's no open one.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 19cc79f86..a3c07189e 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.78 2000/05/22 22:40:09 cph Exp $
+;;; $Id: imail-imap.scm,v 1.79 2000/05/23 00:37:57 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -271,25 +271,32 @@
 	 responses)))))
 
 (define (get-imap-connection url for-folder?)
-  (let loop ((connections memoized-imap-connections) (prev #f))
-    (if (weak-pair? connections)
-	(let ((connection (weak-car connections)))
-	  (if connection
-	      (if (let ((url* (imap-connection-url connection)))
-		    (if for-folder?
-			(eq? url* url)
-			(compatible-imap-urls? url* url)))
-		  connection
-		  (loop (weak-cdr connections) connections))
-	      (let ((next (weak-cdr connections)))
-		(if prev
-		    (weak-set-cdr! prev next)
-		    (set! memoized-imap-connections next))
-		(loop next prev))))
-	(let ((connection (make-imap-connection url)))
-	  (set! memoized-imap-connections
-		(weak-cons connection memoized-imap-connections))
-	  connection))))
+  (let loop ((connections memoized-imap-connections) (prev #f) (near #f))
+    (cond ((weak-pair? connections)
+	   (let ((connection (weak-car connections)))
+	     (if connection
+		 (if (let ((url* (imap-connection-url connection)))
+		       (if for-folder?
+			   (eq? url* url)
+			   (compatible-imap-urls? url* url)))
+		     (if (or for-folder?
+			     (test-imap-connection-open connection))
+			 connection
+			 (loop (weak-cdr connections) connections connection))
+		     (loop (weak-cdr connections) connections near))
+		 (let ((next (weak-cdr connections)))
+		   (if prev
+		       (weak-set-cdr! prev next)
+		       (set! memoized-imap-connections next))
+		   (loop next prev near)))))
+	  (near)
+	  (else
+	   (let ((connection (make-imap-connection url)))
+	     (without-interrupts
+	      (lambda ()
+		(set! memoized-imap-connections
+		      (weak-cons connection memoized-imap-connections))))
+	     connection)))))
 
 (define memoized-imap-connections '())
 
@@ -362,6 +369,14 @@
 	  (lambda ()
 	    (let ((port (imap-connection-port connection)))
 	      (set-imap-connection-port! connection #f)
+	      (let loop ((connections memoized-imap-connections) (prev #f))
+		(if (weak-pair? connections)
+		    (let ((next (weak-cdr connections)))
+		      (if (eq? (weak-car connections) connection)
+			  (if prev
+			      (weak-set-cdr! prev next)
+			      (set! memoized-imap-connections next))
+			  (loop next connections)))))
 	      port)))))
     (if port
 	(close-port port)))