From 92583e24ee833901a6cd93e5163e8bd72861d15b Mon Sep 17 00:00:00 2001 From: "Taylor R. Campbell" Date: Mon, 25 Aug 2008 01:29:02 +0000 Subject: [PATCH] When resynchronizing message UIDs with the server, stop if we find a message whose UID is uninitialized. This arises if the previous attempt to read the UIDs from the server was interrupted. --- v7/src/imail/imail-imap.scm | 61 ++++++++++++++++++++----------------- 1 file changed, 33 insertions(+), 28 deletions(-) diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm index 34ab07282..e8907d03f 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.225 2008/08/24 21:27:05 riastradh Exp $ +$Id: imail-imap.scm,v 1.226 2008/08/25 01:29:02 riastradh Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -955,7 +955,9 @@ USA. ;;; set with empty messages, read in the UIDs for the new messages, ;;; then match up the old messages with the new. Any old message that ;;; matches a new one replaces it in the folder, thus preserving -;;; message pointers where possible. +;;; message pointers where possible. However, we stop if we find a +;;; message whose UID is not known, in case a previous attempt to read +;;; the UIDs was aborted in the middle. ;;; The reason for this complexity in the second case is that we can't ;;; be guaranteed that we will complete reading the UIDs for the new @@ -1014,10 +1016,12 @@ USA. (let ((v* (imap-folder-messages folder)) (n* (folder-length folder))) (let loop ((i 0) (i* 0)) - (if (and (fix:< i n) (fix:< i* n*)) + (if (and (fix:< i n) + (fix:< i* n*) + (%imap-message-uid-initialized? (vector-ref v i))) (let ((m (vector-ref v i)) (m* (vector-ref v* i*))) - (if (= (imap-message-uid m) (imap-message-uid m*)) + (if (= (%imap-message-uid m) (%imap-message-uid m*)) (begin ;; Flags might have been updated while ;; reading the UIDs. @@ -1106,30 +1110,31 @@ USA. ;;; filled in by READ-MESSAGE-HEADERS!, but it's possible for ;;; READ-MESSAGE-HEADERS! to be interrupted, leaving unfilled slots. -(let ((accessor (slot-accessor 'UID)) - (initpred (slot-initpred 'UID))) - (define-method imap-message-uid ((message )) - (if (not (initpred message)) - (with-imap-message-open message - (lambda (connection) - (let ((index (%message-index message))) - (let ((suffix - (string-append " UID for message " - (number->string (+ index 1))))) - ((imail-ui:message-wrapper "Reading" suffix) - (lambda () - (imap:command:fetch connection index '(UID)) - (if (not (initpred message)) - (begin - ;; Still don't have the goods. Send a NOOP, in - ;; case the server is holding it back because it - ;; also needs to send an EXPUNGE. - (imap:command:noop connection) - (if (not (initpred message)) - (error - (string-append "Unable to obtain" - suffix)))))))))))) - (accessor message))) +(define %imap-message-uid (slot-accessor 'UID)) +(define %imap-message-uid-initialized? (slot-initpred 'UID)) + +(define-method imap-message-uid ((message )) + (if (not (%imap-message-uid-initialized? message)) + (with-imap-message-open message + (lambda (connection) + (let ((index (%message-index message))) + (let ((suffix + (string-append " UID for message " + (number->string (+ index 1))))) + ((imail-ui:message-wrapper "Reading" suffix) + (lambda () + (imap:command:fetch connection index '(UID)) + (if (not (%imap-message-uid message)) + (begin + ;; Still don't have the goods. Send a NOOP, in + ;; case the server is holding it back because it + ;; also needs to send an EXPUNGE. + (imap:command:noop connection) + (if (not (%imap-message-uid-initialized? message)) + (error + (string-append "Unable to obtain" + suffix)))))))))))) + (%imap-message-uid message)) (define (guarantee-slot-initialized message initpred noun keywords) (if (not (initpred message)) -- 2.25.1