If IMAP command doesn't complete normally, close the connection.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index d97b0728de2dc32ecab027eec747196140fdc51a..ac41749bbbed9985704fa798de1089f736e5a929 100644 (file)
--- 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.119 2000/06/15 20:04:54 cph Exp $
+;;; $Id: imail-imap.scm,v 1.120 2000/06/15 20:31:35 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1335,18 +1335,28 @@
   (condition-accessor condition-type:imap-server-error 'RESPONSE))
 
 (define (imap:command connection command . arguments)
-  (handle-broken-pipe
-   (lambda (condition)
-     condition
-     (close-imap-connection connection)
-     (error "Connection to IMAP server broken; please try again."))
-   (lambda ()
-     (imap:wait-for-tagged-response
-      connection
-      (imap:send-command connection command arguments)
-      (if (eq? command 'UID)
-         (car arguments)
-         command)))))
+  (let ((finished? #f))
+    (dynamic-wind
+     (lambda () unspecific)
+     (lambda ()
+       (let ((v
+             (handle-broken-pipe
+              (lambda (condition)
+                condition
+                (close-imap-connection connection)
+                (error "Connection to IMAP server broken; please try again."))
+              (lambda ()
+                (imap:wait-for-tagged-response
+                 connection
+                 (imap:send-command connection command arguments)
+                 (if (eq? command 'UID)
+                     (car arguments)
+                     command))))))
+        (set! finished? #t)
+        v))
+     (lambda ()
+       (if (not finished?)
+          (close-imap-connection connection))))))
 
 (define (start-imap-trace pathname)
   (stop-imap-trace)