Merge from emacs--devo--0, emacs--rel--22
[gnus] / lisp / imap.el
index 74c93c1..8e41c68 100644 (file)
@@ -1,6 +1,7 @@
 ;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
-;;        Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <jas@pdc.kth.se>
 ;; Keywords: mail
@@ -9,7 +10,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -19,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 ;; imap-message-append,               imap-envelope-from
 ;; imap-body-lines
 ;;
-;; It is my hope that theese commands should be pretty self
+;; It is my hope that these commands should be pretty self
 ;; explanatory for someone that know IMAP.  All functions have
 ;; additional documentation on how to invoke them.
 ;;
-;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
-;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
+;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented
+;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
 ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
 ;; LOGINDISABLED) (with use of external library starttls.el and
-;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731
-;; (with use of external program `imtest').  It also take advantage
-;; the UNSELECT extension in Cyrus IMAPD.
+;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731
+;; (with use of external program `imtest'), RFC2971 (ID).  It also
+;; takes advantage of the UNSELECT extension in Cyrus IMAPD.
 ;;
 ;; Without the work of John McClary Prevost and Jim Radford this library
 ;; would not have seen the light of day.  Many thanks.
 ;; o Don't use `read' at all (important places already fixed)
 ;; o Accept list of articles instead of message set string in most
 ;;   imap-message-* functions.
+;; o Send strings as literal if they contain, e.g., ".
 ;;
 ;; Revision history:
 ;;
 
 (eval-when-compile (require 'cl))
 (eval-and-compile
-  (autoload 'base64-decode-string "base64")
-  (autoload 'base64-encode-string "base64")
   (autoload 'starttls-open-stream "starttls")
   (autoload 'starttls-negotiate "starttls")
+  (autoload 'sasl-find-mechanism "sasl")
   (autoload 'digest-md5-parse-digest-challenge "digest-md5")
   (autoload 'digest-md5-digest-response "digest-md5")
   (autoload 'digest-md5-digest-uri "digest-md5")
   (autoload 'digest-md5-challenge "digest-md5")
   (autoload 'rfc2104-hash "rfc2104")
-  (autoload 'md5 "md5")
   (autoload 'utf7-encode "utf7")
   (autoload 'utf7-decode "utf7")
   (autoload 'format-spec "format-spec")
   (autoload 'format-spec-make "format-spec")
-  (autoload 'open-tls-stream "tls")
-  ;; Avoid use gnus-point-at-eol so we're independent of Gnus.  These
-  ;; days we have point-at-eol anyhow.
-  (if (fboundp 'point-at-eol)
-      (defalias 'imap-point-at-eol 'point-at-eol)
-    (defun imap-point-at-eol ()
-      (save-excursion
-       (end-of-line)
-       (point)))))
+  (autoload 'open-tls-stream "tls"))
 
 ;; User variables.
 
@@ -180,8 +172,7 @@ the list is tried until a successful connection is made."
   :type '(repeat string))
 
 (defcustom imap-gssapi-program (list
-                               (concat "gsasl --client --connect %s:%p "
-                                       "--imap --application-data "
+                               (concat "gsasl %s %p "
                                        "--mechanism GSSAPI "
                                        "--authentication-id %l")
                                "imtest -m gssapi -u %l -p %p %s")
@@ -220,7 +211,14 @@ until a successful connection is made."
   :type '(repeat string))
 
 (defcustom imap-process-connection-type nil
-  "*Value for `process-connection-type' to use for Kerberos4 and GSSAPI."
+  "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
+The `process-connection-type' variable control type of device
+used to communicate with subprocesses.  Values are nil to use a
+pipe, or t or `pty' to use a pty.  The value has no effect if the
+system has no ptys or if all ptys are busy: then a pipe is used
+in any case.  The value takes effect when a IMAP server is
+opened, changing it after that has no effect."
+  :version "22.1"
   :group 'imap
   :type 'boolean)
 
@@ -233,12 +231,20 @@ encoded mailboxes which doesn't translate into ISO-8859-1."
   :type 'boolean)
 
 (defcustom imap-log nil
-  "If non-nil, a imap session trace is placed in *imap-log* buffer."
+  "If non-nil, a imap session trace is placed in *imap-log* buffer.
+Note that username, passwords and other privacy sensitive
+information (such as e-mail) may be stored in the *imap-log*
+buffer.  It is not written to disk, however.  Do not enable this
+variable unless you are comfortable with that."
   :group 'imap
   :type 'boolean)
 
 (defcustom imap-debug nil
-  "If non-nil, random debug spews are placed in *imap-debug* buffer."
+  "If non-nil, random debug spews are placed in *imap-debug* buffer.
+Note that username, passwords and other privacy sensitive
+information (such as e-mail) may be stored in the *imap-debug*
+buffer.  It is not written to disk, however.  Do not enable this
+variable unless you are comfortable with that."
   :group 'imap
   :type 'boolean)
 
@@ -262,6 +268,11 @@ Shorter values mean quicker response, but is more CPU intensive."
   :type 'number
   :group 'imap)
 
+(defcustom imap-store-password nil
+  "If non-nil, store session password without promting."
+  :group 'imap
+  :type 'boolean)
+
 ;; Various variables.
 
 (defvar imap-fetch-data-hook nil
@@ -290,6 +301,7 @@ stream.")
                              kerberos4
                              digest-md5
                              cram-md5
+                             ;;sasl
                              login
                              anonymous)
   "Priority of authenticators to consider when authenticating to server.")
@@ -297,6 +309,7 @@ stream.")
 (defvar imap-authenticator-alist
   '((gssapi     imap-gssapi-auth-p    imap-gssapi-auth)
     (kerberos4  imap-kerberos4-auth-p imap-kerberos4-auth)
+    (sasl      imap-sasl-auth-p      imap-sasl-auth)
     (cram-md5   imap-cram-md5-p       imap-cram-md5-auth)
     (login      imap-login-p          imap-login-auth)
     (anonymous  imap-anonymous-p      imap-anonymous-auth)
@@ -312,7 +325,14 @@ for doing the actual authentication.")
 (defvar imap-error nil
   "Error codes from the last command.")
 
-;; Internal constants.  Change theese and die.
+(defvar imap-logout-timeout nil
+  "Close server immediately if it can't logout in this number of seconds.
+If it is nil, never close server until logout completes.  Normally,
+the value of this variable will be bound to a certain value to which
+an application program that uses this module specifies on a per-server
+basis.")
+
+;; Internal constants.  Change these and die.
 
 (defconst imap-default-port 143)
 (defconst imap-default-ssl-port 993)
@@ -332,6 +352,7 @@ for doing the actual authentication.")
                                 imap-current-target-mailbox
                                 imap-message-data
                                 imap-capability
+                                imap-id
                                 imap-namespace
                                 imap-state
                                 imap-reached-tag
@@ -387,6 +408,10 @@ and `examine'.")
 (defvar imap-capability nil
   "Capability for server.")
 
+(defvar imap-id nil
+  "Identity of server.
+See RFC 2971.")
+
 (defvar imap-namespace nil
   "Namespace for current server.")
 
@@ -498,6 +523,13 @@ sure of changing the value of `foo'."
            (while (and (memq (process-status process) '(open run))
                        (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                        (goto-char (point-min))
+                       ;; Athena IMTEST can output SSL verify errors
+                       (or (while (looking-at "^verify error:num=")
+                             (forward-line))
+                           t)
+                       (or (while (looking-at "^TLS connection established")
+                             (forward-line))
+                           t)
                        ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
                        (or (while (looking-at "^C:")
                              (forward-line))
@@ -529,7 +561,7 @@ sure of changing the value of `foo'."
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
-                 (imap-send-command "LOGOUT"))
+                 (imap-logout))
              (delete-process process)
              nil)))))
     done))
@@ -563,6 +595,13 @@ sure of changing the value of `foo'."
            (while (and (memq (process-status process) '(open run))
                        (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                        (goto-char (point-min))
+                       ;; Athena IMTEST can output SSL verify errors
+                       (or (while (looking-at "^verify error:num=")
+                             (forward-line))
+                           t)
+                       (or (while (looking-at "^TLS connection established")
+                             (forward-line))
+                           t)
                        ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
                        (or (while (looking-at "^C:")
                              (forward-line))
@@ -571,6 +610,10 @@ sure of changing the value of `foo'."
                        (or (not (looking-at "S: "))
                            (forward-char 3)
                            t)
+                       ;; GNU SASL may print 'Trying ...' first.
+                       (or (not (looking-at "Trying "))
+                           (forward-line)
+                           t)
                        (not (and (imap-parse-greeting)
                                  ;; success in imtest 1.6:
                                  (re-search-forward
@@ -593,7 +636,7 @@ sure of changing the value of `foo'."
                                (not (string-match "failed" response))))
                (setq done process)
              (if (memq (process-status process) '(open run))
-                 (imap-send-command "LOGOUT"))
+                 (imap-logout))
              (delete-process process)
              nil)))))
     done))
@@ -612,7 +655,11 @@ sure of changing the value of `foo'."
       (let* ((port (or port imap-default-ssl-port))
             (coding-system-for-read imap-coding-system-for-read)
             (coding-system-for-write imap-coding-system-for-write)
-            (process-connection-type nil)
+            (process-connection-type imap-process-connection-type)
+            (set-process-query-on-exit-flag
+             (if (fboundp 'set-process-query-on-exit-flag)
+                 'set-process-query-on-exit-flag
+               'process-kill-without-query))
             process)
        (when (progn
                (setq process (start-process
@@ -622,7 +669,7 @@ sure of changing the value of `foo'."
                                            (format-spec-make
                                             ?s server
                                             ?p (number-to-string port)))))
-               (process-kill-without-query process)
+               (funcall set-process-query-on-exit-flag process nil)
                process)
          (with-current-buffer buffer
            (goto-char (point-min))
@@ -752,7 +799,7 @@ sure of changing the value of `foo'."
         (coding-system-for-read imap-coding-system-for-read)
         (coding-system-for-write imap-coding-system-for-write)
         (process (starttls-open-stream name buffer server port))
-        done)
+        done tls-info)
     (message "imap: Connecting with STARTTLS...")
     (when process
       (while (and (memq (process-status process) '(open run))
@@ -775,9 +822,11 @@ sure of changing the value of `foo'."
             (buffer-disable-undo)
             (goto-char (point-max))
             (insert-buffer-substring buffer)))
-      (message "imap: STARTTLS info: %s" (starttls-negotiate process))
-      (when (memq (process-status process) '(open run))
+      (when (and (setq tls-info (starttls-negotiate process))
+                (memq (process-status process) '(open run)))
        (setq done process)))
+    (if (stringp tls-info)
+       (message "imap: STARTTLS info: %s" tls-info))
     (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
     done))
 
@@ -810,11 +859,13 @@ Returns t if login was successful, nil otherwise."
              (progn
                (setq ret t
                      imap-username user)
-               (if (and (not imap-password)
-                        (y-or-n-p "Store password for this session? "))
-                   (setq imap-password passwd)))
+               (when (and (not imap-password)
+                          (or imap-store-password
+                              (y-or-n-p "Store password for this session? ")))
+                 (setq imap-password passwd)))
            (message "Login failed...")
            (setq passwd nil)
+           (setq imap-password nil)
            (sit-for 1))))
       ;;       (quit (with-current-buffer buffer
       ;;               (setq user nil
@@ -825,8 +876,7 @@ Returns t if login was successful, nil otherwise."
       ret)))
 
 (defun imap-gssapi-auth-p (buffer)
-  (and (imap-capability 'AUTH=GSSAPI buffer)
-       (eq imap-stream 'gssapi)))
+  (eq imap-stream 'gssapi))
 
 (defun imap-gssapi-auth (buffer)
   (message "imap: Authenticating using GSSAPI...%s"
@@ -869,14 +919,27 @@ Returns t if login was successful, nil otherwise."
   (and (not (imap-capability 'LOGINDISABLED buffer))
        (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
 
+(defun imap-quote-specials (string)
+  (with-temp-buffer
+    (insert string)
+    (goto-char (point-min))
+    (while (re-search-forward "[\\\"]" nil t)
+      (forward-char -1)
+      (insert "\\")
+      (forward-char 1))
+    (buffer-string)))
+
 (defun imap-login-auth (buffer)
   "Login to server using the LOGIN command."
   (message "imap: Plaintext authentication...")
   (imap-interactive-login buffer
                          (lambda (user passwd)
                            (imap-ok-p (imap-send-command-wait
-                                       (concat "LOGIN \"" user "\" \""
-                                               passwd "\""))))))
+                                       (concat "LOGIN \""
+                                               (imap-quote-specials user)
+                                               "\" \""
+                                               (imap-quote-specials passwd)
+                                               "\""))))))
 
 (defun imap-anonymous-p (buffer)
   t)
@@ -888,6 +951,73 @@ Returns t if login was successful, nil otherwise."
                (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
                                                     (system-name)) "\"")))))
 
+;;; Compiler directives.
+
+(defvar imap-sasl-client)
+(defvar imap-sasl-step)
+
+(defun imap-sasl-make-mechanisms (buffer)
+  (let ((mecs '()))
+    (mapc (lambda (sym)
+           (let ((name (symbol-name sym)))
+             (if (and (> (length name) 5)
+                      (string-equal "AUTH=" (substring name 0 5 )))
+                 (setq mecs (cons (substring name 5) mecs)))))
+         (imap-capability nil buffer))
+    mecs))
+
+(declare-function sasl-find-mechanism "sasl" (mechanism))
+(declare-function sasl-mechanism-name "sasl" (mechanism))
+(declare-function sasl-make-client    "sasl" (mechanism name service server))
+(declare-function sasl-next-step      "sasl" (client step))
+(declare-function sasl-step-data      "sasl" (step))
+(declare-function sasl-step-set-data  "sasl" (step data))
+
+(defun imap-sasl-auth-p (buffer)
+  (and (condition-case ()
+          (require 'sasl)
+        (error nil))
+       (sasl-find-mechanism (imap-sasl-make-mechanisms buffer))))
+
+(defun imap-sasl-auth (buffer)
+  "Login to server using the SASL method."
+  (message "imap: Authenticating using SASL...")
+  (with-current-buffer buffer
+    (make-local-variable 'imap-username)
+    (make-local-variable 'imap-sasl-client)
+    (make-local-variable 'imap-sasl-step)
+    (let ((mechanism (sasl-find-mechanism (imap-sasl-make-mechanisms buffer)))
+         logged user)
+      (while (not logged)
+       (setq user (or imap-username
+                      (read-from-minibuffer
+                       (concat "IMAP username for " imap-server " using SASL "
+                               (sasl-mechanism-name mechanism) ": ")
+                       (or user imap-default-user))))
+       (when user
+         (setq imap-sasl-client (sasl-make-client mechanism user "imap2" imap-server)
+               imap-sasl-step (sasl-next-step imap-sasl-client nil))
+         (let ((tag (imap-send-command
+                     (if (sasl-step-data imap-sasl-step)
+                         (format "AUTHENTICATE %s %s"
+                                 (sasl-mechanism-name mechanism)
+                                 (sasl-step-data imap-sasl-step))
+                       (format "AUTHENTICATE %s" (sasl-mechanism-name mechanism)))
+                     buffer)))
+           (while (eq (imap-wait-for-tag tag) 'INCOMPLETE)
+             (sasl-step-set-data imap-sasl-step (base64-decode-string imap-continuation))
+             (setq imap-continuation nil
+                   imap-sasl-step (sasl-next-step imap-sasl-client imap-sasl-step))
+             (imap-send-command-1 (if (sasl-step-data imap-sasl-step)
+                                      (base64-encode-string (sasl-step-data imap-sasl-step) t)
+                                    "")))
+           (if (imap-ok-p (imap-wait-for-tag tag))
+               (setq imap-username user
+                     logged t)
+             (message "Login failed...")
+             (sit-for 1)))))
+      logged)))
+
 (defun imap-digest-md5-p (buffer)
   (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
        (condition-case ()
@@ -960,7 +1090,7 @@ necessary.  If nil, the buffer name is generated."
   (with-current-buffer (get-buffer-create buffer)
     (if (imap-opened buffer)
        (imap-close buffer))
-    (mapcar 'make-local-variable imap-local-variables)
+    (mapc 'make-local-variable imap-local-variables)
     (imap-disable-multibyte)
     (buffer-disable-undo)
     (setq imap-server (or server imap-server))
@@ -983,7 +1113,7 @@ necessary.  If nil, the buffer name is generated."
              (if (not (eq imap-default-stream stream))
                  (with-current-buffer (get-buffer-create
                                        (generate-new-buffer-name " *temp*"))
-                   (mapcar 'make-local-variable imap-local-variables)
+                   (mapc 'make-local-variable imap-local-variables)
                    (imap-disable-multibyte)
                    (buffer-disable-undo)
                    (setq imap-server (or server imap-server))
@@ -999,8 +1129,11 @@ necessary.  If nil, the buffer name is generated."
                           stream))
                      ;; We're done, kill the first connection
                      (imap-close buffer)
-                     (kill-buffer buffer)
-                     (rename-buffer buffer)
+                     (let ((name (if (stringp buffer)
+                                     buffer
+                                   (buffer-name buffer))))
+                       (kill-buffer buffer)
+                       (rename-buffer name))
                      (message "imap: Reconnecting with stream `%s'...done"
                               stream)
                      (setq imap-stream stream)
@@ -1035,7 +1168,7 @@ password is remembered in the buffer."
   (with-current-buffer (or buffer (current-buffer))
     (if (not (eq imap-state 'nonauth))
        (or (eq imap-state 'auth)
-           (eq imap-state 'select)
+           (eq imap-state 'selected)
            (eq imap-state 'examine))
       (make-local-variable 'imap-username)
       (make-local-variable 'imap-password)
@@ -1069,7 +1202,7 @@ If BUFFER is nil, the current buffer is used."
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-opened)
       (condition-case nil
-         (imap-send-command-wait "LOGOUT")
+         (imap-logout-wait)
        (quit nil)))
     (when (and imap-process
               (memq (process-status imap-process) '(open run)))
@@ -1092,6 +1225,26 @@ If BUFFER is nil, the current buffer is assumed."
        (memq (intern (upcase (symbol-name identifier))) imap-capability)
       imap-capability)))
 
+(defun imap-id (&optional list-of-values buffer)
+  "Identify client to server in BUFFER, and return server identity.
+LIST-OF-VALUES is nil, or a plist with identifier and value
+strings to send to the server to identify the client.
+
+Return a list of identifiers which server in BUFFER support, or
+nil if it doesn't support ID or returns no information.
+
+If BUFFER is nil, the current buffer is assumed."
+  (with-current-buffer (or buffer (current-buffer))
+    (when (and (imap-capability 'ID)
+              (imap-ok-p (imap-send-command-wait
+                          (if (null list-of-values)
+                              "ID NIL"
+                            (concat "ID (" (mapconcat (lambda (el)
+                                                        (concat "\"" el "\""))
+                                                      list-of-values
+                                                      " ") ")")))))
+      imap-id)))
+
 (defun imap-namespace (&optional buffer)
   "Return a namespace hierarchy at server in BUFFER.
 If BUFFER is nil, the current buffer is assumed."
@@ -1104,6 +1257,28 @@ If BUFFER is nil, the current buffer is assumed."
 (defun imap-send-command-wait (command &optional buffer)
   (imap-wait-for-tag (imap-send-command command buffer) buffer))
 
+(defun imap-logout (&optional buffer)
+  (or buffer (setq buffer (current-buffer)))
+  (if imap-logout-timeout
+      (with-timeout (imap-logout-timeout
+                    (condition-case nil
+                        (with-current-buffer buffer
+                          (delete-process imap-process))
+                      (error)))
+       (imap-send-command "LOGOUT" buffer))
+    (imap-send-command "LOGOUT" buffer)))
+
+(defun imap-logout-wait (&optional buffer)
+  (or buffer (setq buffer (current-buffer)))
+  (if imap-logout-timeout
+      (with-timeout (imap-logout-timeout
+                    (condition-case nil
+                        (with-current-buffer buffer
+                          (delete-process imap-process))
+                      (error)))
+       (imap-send-command-wait "LOGOUT" buffer))
+    (imap-send-command-wait "LOGOUT" buffer)))
+
 \f
 ;; Mailbox functions:
 
@@ -1338,10 +1513,11 @@ returned, if ITEMS is a symbol only its value is returned."
           (imap-send-command-wait (list "STATUS \""
                                         (imap-utf7-encode mailbox)
                                         "\" "
-                                        (format "%s"
-                                                (if (listp items)
-                                                    items
-                                                  (list items))))))
+                                        (upcase
+                                         (format "%s"
+                                                 (if (listp items)
+                                                     items
+                                                   (list items)))))))
       (if (listp items)
          (mapcar (lambda (item)
                    (imap-mailbox-get item mailbox))
@@ -1357,10 +1533,11 @@ or 'unseen.  The IMAP command tag is returned."
     (imap-send-command (list "STATUS \""
                             (imap-utf7-encode mailbox)
                             "\" "
-                            (format "%s"
-                                    (if (listp items)
-                                        items
-                                      (list items)))))))
+                            (upcase
+                             (format "%s"
+                                     (if (listp items)
+                                         items
+                                       (list items))))))))
 
 (defun imap-mailbox-acl-get (&optional mailbox buffer)
   "Get ACL on mailbox from server in BUFFER."
@@ -1432,7 +1609,7 @@ or 'unseen.  The IMAP command tag is returned."
 (defun imap-fetch (uids props &optional receive nouidfetch buffer)
   "Fetch properties PROPS from message set UIDS from server in BUFFER.
 UIDS can be a string, number or a list of numbers.  If RECEIVE
-is non-nil return theese properties."
+is non-nil return these properties."
   (with-current-buffer (or buffer (current-buffer))
     (when (imap-ok-p (imap-send-command-wait
                      (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
@@ -1531,7 +1708,7 @@ is non-nil return theese properties."
        (imap-mailbox-get-1 'search imap-current-mailbox)))))
 
 (defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
-  "Return t iff FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
+  "Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
   (with-current-buffer (or buffer (current-buffer))
     (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
        (member flag (imap-mailbox-get 'permanentflags mailbox)))))
@@ -1960,7 +2137,9 @@ Return nil if no complete line has arrived."
        (when (eq (char-after) ?\))
          (imap-forward)
          (nreverse addresses)))
-    (assert (imap-parse-nil) t "In imap-parse-address-list")))
+    ;; With assert, the code might not be eval'd.
+    ;; (assert (imap-parse-nil) t "In imap-parse-address-list")
+    (imap-parse-nil)))
 
 ;;   mailbox         = "INBOX" / astring
 ;;                       ; INBOX is case-insensitive.  All case variants of
@@ -2054,6 +2233,8 @@ Return nil if no complete line has arrived."
                               (read (concat "(" (upcase (buffer-substring
                                                          (point) (point-max)))
                                             ")"))))
+          (ID         (setq imap-id (read (buffer-substring (point)
+                                                            (point-max)))))
           (ACL        (imap-parse-acl))
           (t       (case (prog1 (read (current-buffer))
                            (imap-forward))
@@ -2344,7 +2525,7 @@ Return nil if no complete line has arrived."
       (while (and (not (eq (char-after) ?\)))
                  (or (forward-char) t)
                  (looking-at "\\([A-Za-z]+\\) "))
-       (let ((token (match-string 1)))
+       (let ((token (upcase (match-string 1))))
          (goto-char (match-end 0))
          (cond ((string= token "MESSAGES")
                 (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
@@ -2401,16 +2582,16 @@ Return nil if no complete line has arrived."
 
 (defun imap-parse-flag-list ()
   (let (flag-list start)
-    (assert (eq (char-after) ?\() t "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
     (while (and (not (eq (char-after) ?\)))
                (setq start (progn
                              (imap-forward)
                              ;; next line for Courier IMAP bug.
                              (skip-chars-forward " ")
                              (point)))
-               (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
+               (> (skip-chars-forward "^ )" (point-at-eol)) 0))
       (push (buffer-substring start (point)) flag-list))
-    (assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
     (imap-forward)
     (nreverse flag-list)))
 
@@ -2495,7 +2676,7 @@ Return nil if no complete line has arrived."
        (while (eq (char-after) ?\ )
          (imap-forward)
          (push (imap-parse-body-extension) b-e))
-       (assert (eq (char-after) ?\)) t "In imap-parse-body-extension")
+       (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
        (imap-forward)
        (nreverse b-e))
     (or (imap-parse-number)
@@ -2523,7 +2704,9 @@ Return nil if no complete line has arrived."
              (imap-forward)
              (push (imap-parse-string-list) dsp)
              (imap-forward))
-         (assert (imap-parse-nil) t "In imap-parse-body-ext"))
+         ;; With assert, the code might not be eval'd.
+         ;; (assert (imap-parse-nil) t "In imap-parse-body-ext")
+         (imap-parse-nil))
        (push (nreverse dsp) ext))
       (when (eq (char-after) ?\ ) ;; body-fld-lang
        (imap-forward)
@@ -2619,7 +2802,7 @@ Return nil if no complete line has arrived."
                (push (and (imap-parse-nil) nil) body))
              (setq body
                    (append (imap-parse-body-ext) body))) ;; body-ext-...
-           (assert (eq (char-after) ?\)) t "In imap-parse-body")
+           (assert (eq (char-after) ?\)) nil "In imap-parse-body")
            (imap-forward)
            (nreverse body))
 
@@ -2679,107 +2862,108 @@ Return nil if no complete line has arrived."
          (push (imap-parse-nstring) body) ;; body-fld-md5
          (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
 
-       (assert (eq (char-after) ?\)) t "In imap-parse-body 2")
+       (assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
        (imap-forward)
        (nreverse body)))))
 
 (when imap-debug                       ; (untrace-all)
   (require 'trace)
   (buffer-disable-undo (get-buffer-create imap-debug-buffer))
-  (mapcar (lambda (f) (trace-function-background f imap-debug-buffer))
-         '(
-           imap-utf7-encode
-           imap-utf7-decode
-           imap-error-text
-           imap-kerberos4s-p
-           imap-kerberos4-open
-           imap-ssl-p
-           imap-ssl-open
-           imap-network-p
-           imap-network-open
-           imap-interactive-login
-           imap-kerberos4a-p
-           imap-kerberos4-auth
-           imap-cram-md5-p
-           imap-cram-md5-auth
-           imap-login-p
-           imap-login-auth
-           imap-anonymous-p
-           imap-anonymous-auth
-           imap-open-1
-           imap-open
-           imap-opened
-           imap-authenticate
-           imap-close
-           imap-capability
-           imap-namespace
-           imap-send-command-wait
-           imap-mailbox-put
-           imap-mailbox-get
-           imap-mailbox-map-1
-           imap-mailbox-map
-           imap-current-mailbox
-           imap-current-mailbox-p-1
-           imap-current-mailbox-p
-           imap-mailbox-select-1
-           imap-mailbox-select
-           imap-mailbox-examine-1
-           imap-mailbox-examine
-           imap-mailbox-unselect
-           imap-mailbox-expunge
-           imap-mailbox-close
-           imap-mailbox-create-1
-           imap-mailbox-create
-           imap-mailbox-delete
-           imap-mailbox-rename
-           imap-mailbox-lsub
-           imap-mailbox-list
-           imap-mailbox-subscribe
-           imap-mailbox-unsubscribe
-           imap-mailbox-status
-           imap-mailbox-acl-get
-           imap-mailbox-acl-set
-           imap-mailbox-acl-delete
-           imap-current-message
-           imap-list-to-message-set
-           imap-fetch-asynch
-           imap-fetch
-           imap-message-put
-           imap-message-get
-           imap-message-map
-           imap-search
-           imap-message-flag-permanent-p
-           imap-message-flags-set
-           imap-message-flags-del
-           imap-message-flags-add
-           imap-message-copyuid-1
-           imap-message-copyuid
-           imap-message-copy
-           imap-message-appenduid-1
-           imap-message-appenduid
-           imap-message-append
-           imap-body-lines
-           imap-envelope-from
-           imap-send-command-1
-           imap-send-command
-           imap-wait-for-tag
-           imap-sentinel
-           imap-find-next-line
-           imap-arrival-filter
-           imap-parse-greeting
-           imap-parse-response
-           imap-parse-resp-text
-           imap-parse-resp-text-code
-           imap-parse-data-list
-           imap-parse-fetch
-           imap-parse-status
-           imap-parse-acl
-           imap-parse-flag-list
-           imap-parse-envelope
-           imap-parse-body-extension
-           imap-parse-body
-           )))
+  (mapc (lambda (f) (trace-function-background f imap-debug-buffer))
+       '(
+         imap-utf7-encode
+         imap-utf7-decode
+         imap-error-text
+         imap-kerberos4s-p
+         imap-kerberos4-open
+         imap-ssl-p
+         imap-ssl-open
+         imap-network-p
+         imap-network-open
+         imap-interactive-login
+         imap-kerberos4a-p
+         imap-kerberos4-auth
+         imap-cram-md5-p
+         imap-cram-md5-auth
+         imap-login-p
+         imap-login-auth
+         imap-anonymous-p
+         imap-anonymous-auth
+         imap-open-1
+         imap-open
+         imap-opened
+         imap-authenticate
+         imap-close
+         imap-capability
+         imap-namespace
+         imap-send-command-wait
+         imap-mailbox-put
+         imap-mailbox-get
+         imap-mailbox-map-1
+         imap-mailbox-map
+         imap-current-mailbox
+         imap-current-mailbox-p-1
+         imap-current-mailbox-p
+         imap-mailbox-select-1
+         imap-mailbox-select
+         imap-mailbox-examine-1
+         imap-mailbox-examine
+         imap-mailbox-unselect
+         imap-mailbox-expunge
+         imap-mailbox-close
+         imap-mailbox-create-1
+         imap-mailbox-create
+         imap-mailbox-delete
+         imap-mailbox-rename
+         imap-mailbox-lsub
+         imap-mailbox-list
+         imap-mailbox-subscribe
+         imap-mailbox-unsubscribe
+         imap-mailbox-status
+         imap-mailbox-acl-get
+         imap-mailbox-acl-set
+         imap-mailbox-acl-delete
+         imap-current-message
+         imap-list-to-message-set
+         imap-fetch-asynch
+         imap-fetch
+         imap-message-put
+         imap-message-get
+         imap-message-map
+         imap-search
+         imap-message-flag-permanent-p
+         imap-message-flags-set
+         imap-message-flags-del
+         imap-message-flags-add
+         imap-message-copyuid-1
+         imap-message-copyuid
+         imap-message-copy
+         imap-message-appenduid-1
+         imap-message-appenduid
+         imap-message-append
+         imap-body-lines
+         imap-envelope-from
+         imap-send-command-1
+         imap-send-command
+         imap-wait-for-tag
+         imap-sentinel
+         imap-find-next-line
+         imap-arrival-filter
+         imap-parse-greeting
+         imap-parse-response
+         imap-parse-resp-text
+         imap-parse-resp-text-code
+         imap-parse-data-list
+         imap-parse-fetch
+         imap-parse-status
+         imap-parse-acl
+         imap-parse-flag-list
+         imap-parse-envelope
+         imap-parse-body-extension
+         imap-parse-body
+         )))
 
 (provide 'imap)
 
+;;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7
 ;;; imap.el ends here