From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 3 Nov 2007 04:00:36 +0000 (+0000)
Subject: Fix bug: IMAP-MAILBOX-DELIMITER was using the mailbox name as a key
X-Git-Tag: 20090517-FFI~413
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1b0201e2967e9ab0f7ce3d54c4a1dad2a21d5ce7;p=mit-scheme.git

Fix bug: IMAP-MAILBOX-DELIMITER was using the mailbox name as a key
into a global table, without considering the server that the mailbox
resided on.  Consequently there were collisions when multiple servers
had different delimiters.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 93c6a0304..21c05b2eb 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.213 2007/08/05 23:57:30 riastradh Exp $
+$Id: imail-imap.scm,v 1.214 2007/11/03 04:00:36 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -441,20 +441,17 @@ USA.
 
 (define (imap-mailbox-delimiter url mailbox)
   (let* ((slash (string-find-next-char mailbox #\/))
-	 (root (if slash (string-head mailbox slash) mailbox)))
-    (let ((delimiter (hash-table/get imap-delimiters-table root 'UNKNOWN)))
-      (if (eq? delimiter 'UNKNOWN)
-	  (let ((delimiter
-		 (imap:response:list-delimiter
-		  (with-open-imap-connection url
-		    (lambda (connection)
-		      (imap:command:get-delimiter connection root))))))
-	    (let ((delimiter
-		   (and delimiter
-			(string-ref delimiter 0))))
-	      (hash-table/put! imap-delimiters-table root delimiter)
-	      delimiter))
-	  delimiter))))
+	 (root (if slash (string-head mailbox slash) mailbox))
+	 (key (make-imap-url-string url root)))
+    (hash-table/intern! imap-delimiters-table key
+      (lambda ()
+	(let ((delimiter
+	       (imap:response:list-delimiter
+		(with-open-imap-connection url
+		  (lambda (connection)
+		    (imap:command:get-delimiter connection root))))))
+	  (and delimiter
+	       (string-ref delimiter 0)))))))
 
 (define imap-delimiters-table
   (make-equal-hash-table))