Re: [Bug-mit-scheme] imail: message shouldn't retain deleted flag when filed

[Taylor R Campbell]

   Date: Thu, 30 Apr 2009 17:15:47 -0400
   From: Julie Sussman <address@hidden>

   Actually, this is not fixed.

Sorry, you're right: if you are filing a message from an IMAP folder
to another IMAP folder on the same server, the flags will generally be
preserved.  This is because the IMAP provides a command to copy a
message from one folder to another, but no way when doing this to
alter the message's flags explicitly.

There are three ways around this that come to mind:

1. Simply transmit the message over the wire with all its new flags.
   This is what happens already for messages that are filed between
   incompatible folders (from file folder to IMAP folder, from one
   server to another, &c.).  This is slow, and worse for larger
   messages.

2. (a) Set the flags in the original folder, (b) file the message, and
   (c) then revert the flags in the original folder.  If another
   client concurrently changes the original message's during step (b),
   these changes will be lost.

3. If the UIDPLUS extension is available, file the message, select the
   target folder, and remove the ephemeral flags from the deleted
   message.  This is too complex to implement right now, and also
   involves another race condition (if another client is reading the
   target folder, it will see the wrong flags on the message
   initially).

I have prepared patches for options 1 and 2.  You can try whichever
option you want by putting the point after the expression and hitting
C-x C-e, in IMAIL.  Please let me know if you have any preference, or
any problems with either of these options.  Also, Chris: if you're
listening and have any other suggestions, please let me know.

;;; Option 1.

((lambda (form)
   (eval form (->environment '(EDWIN IMAIL IMAP-FOLDER))))
'(define-method %append-message ((message <message>) (url <imap-folder-url>))
  (let ((folder (message-folder message))
        (flags (flags-delete "recent" (message-permanent-flags message)))
        (maybe-create
         (lambda (connection thunk)
           (if (imap:catch-no-response
                (lambda (response)
                  (let ((code (imap:response:response-text-code response)))
                    (and code
                         (imap:response-code:trycreate? code))))
                (lambda ()
                  (thunk)
                  #f))
               (begin
                 (imap:command:create connection (imap-url-server-mailbox url))
                 (thunk)
                 #t)))))
    (if (and (lset= string-ci=?
                    flags
                    (flags-delete "recent" (message-flags message)))
             (let ((url* (resource-locator folder)))
               (and (imap-url? url*)
                    (compatible-imap-urls? url url*))))
        (let ((connection (guarantee-imap-folder-open folder)))
          (maybe-create connection
            (lambda ()
              (imap:command:uid-copy connection
                                     uid
                                     (imap-url-server-mailbox url)))))
        (with-open-imap-connection url
          (lambda (connection)
            (maybe-create connection
              (lambda ()
                (imap:command:append connection
                                     (imap-url-server-mailbox url)
                                     (map imail-flag->imap-flag flags)
                                     (message-internal-time message)
                                     (message->string message))))))))))

;;; Option 2.

((lambda (form)
   (eval form (->environment '(EDWIN IMAIL IMAP-FOLDER))))
'(define-method %append-message ((message <message>) (url <imap-folder-url>))
  (let ((folder (message-folder message))
        (maybe-create
         (lambda (connection thunk)
           (if (imap:catch-no-response
                (lambda (response)
                  (let ((code (imap:response:response-text-code response)))
                    (and code
                         (imap:response-code:trycreate? code))))
                (lambda ()
                  (thunk)
                  #f))
               (begin
                 (imap:command:create connection (imap-url-server-mailbox url))
                 (thunk)
                 #t)))))
    (if (let ((url* (resource-locator folder)))
          (and (imap-url? url*)
               (compatible-imap-urls? url url*)))
        (let ((connection (guarantee-imap-folder-open folder))
              (uid (imap-message-uid message)))
          (define (do-copy)
            (maybe-create connection
              (lambda ()
                (imap:command:uid-copy connection
                                       uid
                                       (imap-url-server-mailbox url)))))
          (define (store-flags flags)
            (imap:command connection 'UID 'STORE uid 'FLAGS.SILENT
                          (map imail-flag->imap-flag flags)))
          (let ((flags (flags-delete "recent" (message-flags message)))
                (permanent-flags
                 (flags-delete "recent" (message-permanent-flags message))))
            (if (lset= string-ci=? flags permanent-flags)
                (do-copy)
                (begin (store-flags permanent-flags)
                       (do-copy)
                       (store-flags flags)))))
        (with-open-imap-connection url
          (lambda (connection)
            (maybe-create connection
              (lambda ()
                (imap:command:append connection
                                     (imap-url-server-mailbox url)
                                     (map imail-flag->imap-flag
                                          (flags-delete
                                           "recent"
                                           (message-permanent-flags message)))
                                     (message-internal-time message)
                                     (message->string message))))))))))