;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000
-;; Free Software Foundation, Inc.
-;; Author: Simon Josefsson <jas@pdc.kth.se>
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;; imap.el is a elisp library providing an interface for talking to
+;; imap.el is an elisp library providing an interface for talking to
;; IMAP servers.
;;
;; imap.el is roughly divided in two parts, one that parses IMAP
;;
;; Mailbox commands:
;;
-;; imap-mailbox-get, imap-mailbox-map, imap-current-mailbox,
+;; imap-mailbox-get, imap-mailbox-map, imap-current-mailbox,
;; imap-current-mailbox-p, imap-search, imap-mailbox-select,
;; imap-mailbox-examine, imap-mailbox-unselect, imap-mailbox-expunge
;; imap-mailbox-close, imap-mailbox-create, imap-mailbox-delete
;; imap-fetch-asynch, imap-fetch,
;; imap-current-message, imap-list-to-message-set,
;; imap-message-get, imap-message-map
-;; imap-message-envelope-date, imap-message-envelope-subject,
+;; imap-message-envelope-date, imap-message-envelope-subject,
;; imap-message-envelope-from, imap-message-envelope-sender,
;; imap-message-envelope-reply-to, imap-message-envelope-to,
;; imap-message-envelope-cc, imap-message-envelope-bcc
;; 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
-;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS)
-;; (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.
+;; imap.el supports RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1). The 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'), and 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.
;;
-;; This is a transcript of short interactive session for demonstration
+;; This is a transcript of a short interactive session for demonstration
;; purposes.
;;
;; (imap-open "my.mail.server")
;; => " *imap* my.mail.server:0"
;;
;; The rest are invoked with current buffer as the buffer returned by
-;; `imap-open'. It is possible to do all without this, but it would
+;; `imap-open'. It is possible to do it all without this, but it would
;; look ugly here since `buffer' is always the last argument for all
;; imap.el API functions.
;;
;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: <jas@pdc.kth.se>^M\r...."
;;
;; Todo:
-;;
+;;
;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.
+;; Use IEEE floats (which are effectively exact)? -- fx
;; 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:
;;
;; - 19991218 added starttls/digest-md5 patch,
;; by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
;; NB! you need SLIM for starttls.el and digest-md5.el
-;; - 19991023 commited to pgnus
+;; - 19991023 committed to pgnus
;;
;;; Code:
(eval-when-compile (require 'cl))
(eval-and-compile
- (autoload 'open-ssl-stream "ssl")
- (autoload 'base64-decode-string "base64")
- (autoload 'base64-encode-string "base64")
+ ;; For Emacs <22.2 and XEmacs.
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(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 'format-spec-make "format-spec")
+ (autoload 'open-tls-stream "tls"))
;; User variables.
(defgroup imap nil
"Low-level IMAP issues."
+ :version "21.1"
:group 'mail)
(defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
:group 'imap
:type '(repeat string))
-(defcustom imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
+(defcustom imap-gssapi-program (list
+ (concat "gsasl %s %p "
+ "--mechanism GSSAPI "
+ "--authentication-id %l")
+ "imtest -m gssapi -u %l -p %p %s")
"List of strings containing commands for GSSAPI (krb5) authentication.
%s is replaced with server hostname, %p with port to connect to, and
%l with the value of `imap-default-user'. The program should accept
:group 'imap
:type '(repeat string))
-(defcustom imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p"
- "openssl s_client -ssl2 -connect %s:%p"
- "s_client -ssl3 -connect %s:%p"
- "s_client -ssl2 -connect %s:%p")
+(defcustom imap-ssl-program '("openssl s_client -quiet -ssl3 -connect %s:%p"
+ "openssl s_client -quiet -ssl2 -connect %s:%p"
+ "s_client -quiet -ssl3 -connect %s:%p"
+ "s_client -quiet -ssl2 -connect %s:%p")
"A string, or list of strings, containing commands for SSL connections.
Within a string, %s is replaced with the server address and %p with
port number on server. The program should accept IMAP commands on
Within a string, %s is replaced with the server address, %p with port
number on server, %g with `imap-shell-host', and %l with
`imap-default-user'. The program should read IMAP commands from stdin
-and write IMAP response to stdout. Each entry in the list is tried
+and write IMAP response to stdout. Each entry in the list is tried
until a successful connection is made."
:group 'imap
:type '(repeat string))
-(defvar imap-shell-host "gateway"
- "Hostname of rlogin proxy.")
+(defcustom imap-process-connection-type nil
+ "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
+The `process-connection-type' variable controls the 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 an IMAP server is
+opened; changing it after that has no effect."
+ :version "22.1"
+ :group 'imap
+ :type 'boolean)
-(defvar imap-default-user (user-login-name)
- "Default username to use.")
+(defcustom imap-use-utf7 t
+ "If non-nil, do utf7 encoding/decoding of mailbox names.
+Since the UTF7 decoding currently only decodes into ISO-8859-1
+characters, you may disable this decoding if you need to access UTF7
+encoded mailboxes which doesn't translate into ISO-8859-1."
+ :group 'imap
+ :type 'boolean)
-(defvar imap-error nil
- "Error codes from the last command.")
+(defcustom imap-log nil
+ "If non-nil, an 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 buffer.
+It is not written to disk, however. Do not enable this
+variable unless you are comfortable with that.
+
+See also `imap-debug'."
+ :group 'imap
+ :type 'boolean)
+
+(defcustom imap-debug nil
+ "If non-nil, trace imap- functions into `imap-debug-buffer'.
+Uses `trace-function-background', so you can turn it off with,
+say, `untrace-all'.
+
+Note that username, passwords and other privacy sensitive
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however. Do not enable this
+variable unless you are comfortable with that.
+
+This variable only takes effect when loading the `imap' library.
+See also `imap-log'."
+ :group 'imap
+ :type 'boolean)
+
+(defcustom imap-shell-host "gateway"
+ "Hostname of rlogin proxy."
+ :group 'imap
+ :type 'string)
+
+(defcustom imap-default-user (user-login-name)
+ "Default username to use."
+ :group 'imap
+ :type 'string)
+
+(defcustom imap-read-timeout (if (string-match
+ "windows-nt\\|os/2\\|cygwin"
+ (symbol-name system-type))
+ 1.0
+ 0.1)
+ "*How long to wait between checking for the end of output.
+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 prompting."
+ :group 'imap
+ :type 'boolean)
;; Various variables.
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
-(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
+(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
"Priority of streams to consider when opening connection to server.")
(defvar imap-stream-alist
'((gssapi imap-gssapi-stream-p imap-gssapi-open)
(kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
+ (tls imap-tls-p imap-tls-open)
(ssl imap-ssl-p imap-ssl-open)
(network imap-network-p imap-network-open)
(shell imap-shell-p imap-shell-open)
(starttls imap-starttls-p imap-starttls-open))
"Definition of network streams.
-(NAME CHECK OPEN)
+\(NAME CHECK OPEN)
NAME names the stream, CHECK is a function returning non-nil if the
server support the stream and OPEN is a function for opening the
stream.")
-(defvar imap-authenticators '(gssapi
+(defvar imap-authenticators '(gssapi
kerberos4
digest-md5
cram-md5
+ ;;sasl
login
anonymous)
"Priority of authenticators to consider when authenticating to server.")
-(defvar imap-authenticator-alist
+(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)
(digest-md5 imap-digest-md5-p imap-digest-md5-auth))
"Definition of authenticators.
-(NAME CHECK AUTHENTICATE)
+\(NAME CHECK AUTHENTICATE)
NAME names the authenticator. CHECK is a function returning non-nil if
the server support the authenticator and AUTHENTICATE is a function
-for doing the actuall authentification.")
+for doing the actual authentication.")
-(defvar imap-use-utf7 t
- "If non-nil, do utf7 encoding/decoding of mailbox names.
-Since the UTF7 decoding currently only decodes into ISO-8859-1
-characters, you may disable this decoding if you need to access UTF7
-encoded mailboxes which doesn't translate into ISO-8859-1.")
+(defvar imap-error nil
+ "Error codes from the last command.")
+
+(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 theese and die.
+;; Internal constants. Change these and die.
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
+(defconst imap-default-tls-port 993)
(defconst imap-default-stream 'network)
(defconst imap-coding-system-for-read 'binary)
(defconst imap-coding-system-for-write 'binary)
imap-current-target-mailbox
imap-message-data
imap-capability
+ imap-id
imap-namespace
imap-state
imap-reached-tag
imap-process
imap-calculate-literal-size-first
imap-mailbox-data))
+(defconst imap-log-buffer "*imap-log*")
+(defconst imap-debug-buffer "*imap-debug*")
;; Internal variables.
(defvar imap-port nil)
(defvar imap-username nil)
(defvar imap-password nil)
+(defvar imap-last-authenticator nil)
(defvar imap-calculate-literal-size-first nil)
-(defvar imap-state 'closed
+(defvar imap-state 'closed
"IMAP state.
Valid states are `closed', `initial', `nonauth', `auth', `selected'
and `examine'.")
"Obarray with mailbox data.")
(defvar imap-mailbox-prime 997
- "Length of imap-mailbox-data.")
+ "Length of `imap-mailbox-data'.")
(defvar imap-current-message nil
"Current message number.")
"Obarray with message data.")
(defvar imap-message-prime 997
- "Length of imap-message-data.")
+ "Length of `imap-message-data'.")
(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.")
(defvar imap-reached-tag 0
"Lower limit on command tags that have been parsed.")
-(defvar imap-failed-tags nil
+(defvar imap-failed-tags nil
"Alist of tags that failed.
Each element is a list with four elements; tag (a integer), response
state (a symbol, `OK', `NO' or `BAD'), response code (a string), and
(defvar imap-continuation nil
"Non-nil indicates that the server emitted a continuation request.
-The actually value is really the text on the continuation line.")
+The actual value is really the text on the continuation line.")
+
+(defvar imap-callbacks nil
+ "List of response tags and callbacks, on the form `(number . function)'.
+The function should take two arguments, the first the IMAP tag and the
+second the status (OK, NO, BAD etc) of the command.")
-(defvar imap-log nil
- "Name of buffer for imap session trace.
-For example: (setq imap-log \"*imap-log*\")")
+(defvar imap-enable-exchange-bug-workaround nil
+ "Send FETCH UID commands as *:* instead of *.
-(defvar imap-debug nil ;"*imap-debug*"
- "Name of buffer for random debug spew.
-For example: (setq imap-debug \"*imap-debug*\")")
+When non-nil, use an alternative UIDS form. Enabling appears to
+be required for some servers (e.g., Microsoft Exchange 2007)
+which otherwise would trigger a response 'BAD The specified
+message set is invalid.'. We don't unconditionally use this
+form, since this is said to be significantly inefficient.
+
+This variable is set to t automatically per server if the
+canonical form fails.")
\f
;; Utility functions:
-(defsubst imap-disable-multibyte ()
+(defun imap-remassoc (key alist)
+ "Delete by side effect any elements of ALIST whose car is `equal' to KEY.
+The modified ALIST is returned. If the first member
+of ALIST has a car that is `equal' to KEY, there is no way to remove it
+by side effect; therefore, write `(setq foo (remassoc key foo))' to be
+sure of changing the value of `foo'."
+ (when alist
+ (if (equal key (caar alist))
+ (cdr alist)
+ (setcdr alist (imap-remassoc key (cdr alist)))
+ alist)))
+
+(defmacro imap-disable-multibyte ()
"Enable multibyte in the current buffer."
- (when (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil)))
-
-(defun imap-read-passwd (prompt &rest args)
- "Read a password using PROMPT.
-If ARGS, PROMPT is used as an argument to `format'."
- (let ((prompt (if args
- (apply 'format prompt args)
- prompt)))
- (funcall (if (or (fboundp 'read-passwd)
- (and (load "subr" t)
- (fboundp 'read-passwd))
- (and (load "passwd" t)
- (fboundp 'read-passwd)))
- 'read-passwd
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- 'ange-ftp-read-passwd)
- prompt)))
+ (unless (featurep 'xemacs)
+ '(set-buffer-multibyte nil)))
(defsubst imap-utf7-encode (string)
(if imap-use-utf7
(and string
(condition-case ()
(utf7-encode string t)
- (error (message
+ (error (message
"imap: Could not UTF7 encode `%s', using it unencoded..."
string)
string)))
\f
;; Server functions; stream stuff:
+(defun imap-log (string-or-buffer)
+ (when imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (if (bufferp string-or-buffer)
+ (insert-buffer-substring string-or-buffer)
+ (insert string-or-buffer)))))
+
(defun imap-kerberos4-stream-p (buffer)
(imap-capability 'AUTH=KERBEROS_V4 buffer))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "Opening Kerberos 4 IMAP connection with `%s'..." cmd)
+ (erase-buffer)
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
- (process (start-process
+ (process-connection-type imap-process-connection-type)
+ (process (start-process
name buffer shell-file-name shell-command-switch
(format-spec
cmd
(setq imap-client-eol "\n"
imap-calculate-literal-size-first t)
(while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
- ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
+ ;; 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))
t)
;; cyrus 1.6 imtest print "S: " before server greeting
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
(erase-buffer)
- (message "Kerberos 4 IMAP connection: %s" (or response "failed"))
+ (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
+ (if response (concat "done, " response) "failed"))
(if (and response (let ((case-fold-search nil))
(not (string-match "failed" response))))
(setq done process)
(if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
+ (imap-logout))
(delete-process process)
nil)))))
done))
-
+
(defun imap-gssapi-stream-p (buffer)
(imap-capability 'AUTH=GSSAPI buffer))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "Opening GSSAPI IMAP connection with `%s'..." cmd)
+ (erase-buffer)
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
- (process (start-process
+ (process-connection-type imap-process-connection-type)
+ (process (start-process
name buffer shell-file-name shell-command-switch
(format-spec
cmd
response)
(when process
(with-current-buffer buffer
- (setq imap-client-eol "\n")
+ (setq imap-client-eol "\n"
+ imap-calculate-literal-size-first t)
(while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
- ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
+ ;; 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))
t)
;; cyrus 1.6 imtest print "S: " before server greeting
(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
- "^\\(Authenticat.*\\)" nil t)
+ (concat "^\\(\\(Authenticat.*\\)\\|\\("
+ "Client authentication "
+ "finished.*\\)\\)")
+ nil t)
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(erase-buffer)
(message "GSSAPI IMAP connection: %s" (or response "failed"))
(if (and response (let ((case-fold-search nil))
(not (string-match "failed" response))))
(setq done process)
(if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
+ (imap-logout))
(delete-process process)
nil)))))
done))
nil)
(defun imap-ssl-open (name buffer server port)
- "Open a SSL connection to server."
+ "Open an SSL connection to SERVER."
(let ((cmds (if (listp imap-ssl-program) imap-ssl-program
(list imap-ssl-program)))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening SSL connection with `%s'..." cmd)
+ (erase-buffer)
(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)
- (ssl-program-name shell-file-name)
- (ssl-program-arguments
- (list shell-command-switch
- (format-spec cmd (format-spec-make
- ?s server
- ?p (number-to-string port)))))
+ (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 (setq process (ignore-errors (open-ssl-stream
- name buffer server port)))
+ (when (progn
+ (setq process (start-process
+ name buffer shell-file-name
+ shell-command-switch
+ (format-spec cmd
+ (format-spec-make
+ ?s server
+ ?p (number-to-string port)))))
+ (funcall set-process-query-on-exit-flag process nil)
+ process)
(with-current-buffer buffer
(goto-char (point-min))
(while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-max))
(forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process))))))
(progn
(message "imap: Opening SSL connection with `%s'...done" cmd)
done)
- (message "imap: Failed opening SSL connection")
+ (message "imap: Opening SSL connection with `%s'...failed" cmd)
nil)))
+(defun imap-tls-p (buffer)
+ nil)
+
+(defun imap-tls-open (name buffer server port)
+ (let* ((port (or port imap-default-tls-port))
+ (coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write)
+ (process (open-tls-stream name buffer server port)))
+ (when process
+ (while (and (memq (process-status process) '(open run))
+ ;; FIXME: Per the "blue moon" comment, the process/buffer
+ ;; handling here, and elsewhere in functions which open
+ ;; streams, looks confused. Obviously we can change buffers
+ ;; if a different process handler kicks in from
+ ;; `accept-process-output' or `sit-for' below, and TRT seems
+ ;; to be to `save-buffer' around those calls. (I wonder why
+ ;; `sit-for' is used with a non-zero wait.) -- fx
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (imap-parse-greeting)))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (imap-log buffer)
+ (when (memq (process-status process) '(open run))
+ process))))
+
(defun imap-network-p (buffer)
t)
(process (open-network-stream name buffer server port)))
(when process
(while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(when (memq (process-status process) '(open run))
process))))
nil)
(defun imap-shell-open (name buffer server port)
- (let ((cmds imap-shell-program)
+ (let ((cmds (if (listp imap-shell-program) imap-shell-program
+ (list imap-shell-program)))
cmd done)
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening IMAP connection with `%s'..." cmd)
(let* ((port (or port imap-default-port))
(coding-system-for-read imap-coding-system-for-read)
(coding-system-for-write imap-coding-system-for-write)
- (process (start-process
+ (process (start-process
name buffer shell-file-name shell-command-switch
(format-spec
cmd
?l imap-default-user)))))
(when process
(while (and (memq (process-status process) '(open run))
- (goto-char (point-min))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
+ (imap-log buffer)
(erase-buffer)
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
(when (memq (process-status process) '(open run))
(setq done process)))))
(if done
(progn
(message "imap: Opening IMAP connection with `%s'...done" cmd)
done)
- (message "imap: Failed opening IMAP connection")
+ (message "imap: Opening IMAP connection with `%s'...failed" cmd)
nil)))
(defun imap-starttls-p (buffer)
- (and (condition-case ()
- (require 'starttls)
- (error nil))
- (imap-capability 'STARTTLS buffer)))
+ (imap-capability 'STARTTLS buffer))
(defun imap-starttls-open (name buffer server port)
(let* ((port (or port imap-default-port))
(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)))
+ (process (starttls-open-stream name buffer server port))
+ done tls-info)
+ (message "imap: Connecting with STARTTLS...")
(when process
(while (and (memq (process-status process) '(open run))
- (goto-char (point-min))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (let ((imap-process process))
- (unwind-protect
- (progn
- (set-process-filter imap-process 'imap-arrival-filter)
- (when (and (eq imap-stream 'starttls)
- (imap-ok-p (imap-send-command-wait "STARTTLS")))
- (starttls-negotiate imap-process)))
- (set-process-filter imap-process nil)))
- (when (memq (process-status process) '(open run))
- process))))
-
+ (imap-send-command "STARTTLS")
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (imap-log buffer)
+ (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))
+
;; Server functions; authenticator stuff:
(defun imap-interactive-login (buffer loginfunc)
"Login to server in BUFFER.
LOGINFUNC is passed a username and a password, it should return t if
-it where sucessful authenticating itself to the server, nil otherwise.
+it where successful authenticating itself to the server, nil otherwise.
Returns t if login was successful, nil otherwise."
(with-current-buffer buffer
- (make-variable-buffer-local 'imap-username)
- (make-variable-buffer-local 'imap-password)
+ (make-local-variable 'imap-username)
+ (make-local-variable 'imap-password)
(let (user passwd ret)
;; (condition-case ()
(while (or (not user) (not passwd))
(setq user (or imap-username
- (read-from-minibuffer
- (concat "IMAP username for " imap-server ": ")
+ (read-from-minibuffer
+ (concat "imap: username for " imap-server
+ " (using stream `" (symbol-name imap-stream)
+ "'): ")
(or user imap-default-user))))
(setq passwd (or imap-password
- (imap-read-passwd
- (concat "IMAP password for " user "@"
- imap-server ": "))))
+ (read-passwd
+ (concat "imap: password for " user "@"
+ imap-server " (using authenticator `"
+ (symbol-name imap-auth) "'): "))))
(when (and user passwd)
(if (funcall loginfunc user passwd)
(progn
+ (message "imap: Login successful...")
(setq ret t
imap-username user)
- (if (and (not imap-password)
- (y-or-n-p "Store password for this session? "))
- (setq imap-password passwd)))
- (message "Login failed...")
+ (when (and (not imap-password)
+ (or imap-store-password
+ (y-or-n-p "imap: Store password for this IMAP session? ")))
+ (setq imap-password passwd)))
+ (message "imap: Login failed...")
(setq passwd nil)
+ (setq imap-password nil)
(sit-for 1))))
;; (quit (with-current-buffer buffer
;; (setq user nil
ret)))
(defun imap-gssapi-auth-p (buffer)
- (imap-capability 'AUTH=GSSAPI buffer))
+ (eq imap-stream 'gssapi))
(defun imap-gssapi-auth (buffer)
+ (message "imap: Authenticating using GSSAPI...%s"
+ (if (eq imap-stream 'gssapi) "done" "failed"))
(eq imap-stream 'gssapi))
(defun imap-kerberos4-auth-p (buffer)
- (imap-capability 'AUTH=KERBEROS_V4 buffer))
+ (and (imap-capability 'AUTH=KERBEROS_V4 buffer)
+ (eq imap-stream 'kerberos4)))
(defun imap-kerberos4-auth (buffer)
+ (message "imap: Authenticating using Kerberos 4...%s"
+ (if (eq imap-stream 'kerberos4) "done" "failed"))
(eq imap-stream 'kerberos4))
(defun imap-cram-md5-p (buffer)
(defun imap-cram-md5-auth (buffer)
"Login to server using the AUTH CRAM-MD5 method."
- (imap-interactive-login
- buffer
- (lambda (user passwd)
- (imap-ok-p
- (imap-send-command-wait
- (list
- "AUTHENTICATE CRAM-MD5"
- (lambda (challenge)
- (let* ((decoded (base64-decode-string challenge))
- (hash (rfc2104-hash 'md5 64 16 passwd decoded))
- (response (concat user " " hash))
- (encoded (base64-encode-string response)))
- encoded))))))))
+ (message "imap: Authenticating using CRAM-MD5...")
+ (let ((done (imap-interactive-login
+ buffer
+ (lambda (user passwd)
+ (imap-ok-p
+ (imap-send-command-wait
+ (list
+ "AUTHENTICATE CRAM-MD5"
+ (lambda (challenge)
+ (let* ((decoded (base64-decode-string challenge))
+ (hash (rfc2104-hash 'md5 64 16 passwd decoded))
+ (response (concat user " " hash))
+ (encoded (base64-encode-string response)))
+ encoded)))))))))
+ (if done
+ (message "imap: Authenticating using CRAM-MD5...done")
+ (message "imap: Authenticating using CRAM-MD5...failed"))))
(defun imap-login-p (buffer)
- (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))
+ (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."
- (imap-interactive-login buffer
+ (message "imap: Plaintext authentication...")
+ (imap-interactive-login buffer
(lambda (user passwd)
- (imap-ok-p (imap-send-command-wait
- (concat "LOGIN \"" user "\" \""
- passwd "\""))))))
+ (imap-ok-p (imap-send-command-wait
+ (concat "LOGIN \""
+ (imap-quote-specials user)
+ "\" \""
+ (imap-quote-specials passwd)
+ "\""))))))
(defun imap-anonymous-p (buffer)
t)
(defun imap-anonymous-auth (buffer)
+ (message "imap: Logging in anonymously...")
(with-current-buffer buffer
(imap-ok-p (imap-send-command-wait
- (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
+ (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
(system-name)) "\"")))))
-(defun imap-digest-md5-p (buffer)
+;;; 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 'digest-md5)
+ (require 'sasl)
(error nil))
- (imap-capability 'AUTH=DIGEST-MD5 buffer)))
+ (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 ()
+ (require 'digest-md5)
+ (error nil))))
(defun imap-digest-md5-auth (buffer)
"Login to server using the AUTH DIGEST-MD5 method."
+ (message "imap: Authenticating using DIGEST-MD5...")
(imap-interactive-login
buffer
(lambda (user passwd)
- (let ((tag
+ (let ((tag
(imap-send-command
(list
"AUTHENTICATE DIGEST-MD5"
(digest-md5-parse-digest-challenge
(base64-decode-string challenge))
(let* ((digest-uri
- (digest-md5-digest-uri
+ (digest-md5-digest-uri
"imap" (digest-md5-challenge 'realm)))
(response
- (digest-md5-digest-response
+ (digest-md5-digest-response
user passwd digest-uri)))
(base64-encode-string response 'no-line-break))))
)))
imap-current-message nil
imap-state 'initial
imap-process (condition-case ()
- (funcall (nth 2 (assq imap-stream
+ (funcall (nth 2 (assq imap-stream
imap-stream-alist))
"imap" buffer imap-server imap-port)
((error quit) nil)))
imap-process))))
(defun imap-open (server &optional port stream auth buffer)
- "Open a IMAP connection to host SERVER at PORT returning a buffer.
+ "Open an IMAP connection to host SERVER at PORT returning a buffer.
If PORT is unspecified, a default value is used (143 except
for SSL which use 993).
STREAM indicates the stream to use, see `imap-streams' for available
available authenticators. If nil, it choices the best stream the
server is capable of.
BUFFER can be a buffer or a name of a buffer, which is created if
-necessery. If nil, the buffer name is generated."
+necessary. If nil, the buffer name is generated."
(setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
(with-current-buffer (get-buffer-create buffer)
(if (imap-opened buffer)
(imap-close buffer))
- (mapcar 'make-variable-buffer-local imap-local-variables)
+ (mapc 'make-local-variable imap-local-variables)
(imap-disable-multibyte)
(buffer-disable-undo)
(setq imap-server (or server imap-server))
(setq imap-port (or port imap-port))
(setq imap-auth (or auth imap-auth))
(setq imap-stream (or stream imap-stream))
- (when (let ((imap-stream (or imap-stream imap-default-stream)))
- (imap-open-1 buffer))
- ;; Choose stream.
- (let (stream-changed)
- (when (null imap-stream)
- (let ((streams imap-streams))
- (while (setq stream (pop streams))
- (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
- (setq stream-changed (not (eq (or imap-stream
- imap-default-stream)
- stream))
- imap-stream stream
- streams nil)))
- (unless imap-stream
- (error "Couldn't figure out a stream for server"))))
- (when stream-changed
- (message "Reconnecting with %s..." imap-stream)
- (imap-close buffer)
- (imap-open-1 buffer)
- (setq imap-capability nil)))
- (if (imap-opened buffer)
- ;; Choose authenticator
- (when (and (null imap-auth) (not (eq imap-state 'auth)))
- (let ((auths imap-authenticators))
- (while (setq auth (pop auths))
- (if (funcall (nth 1 (assq auth imap-authenticator-alist))
- buffer)
- (setq imap-auth auth
- auths nil)))
- (unless imap-auth
- (error "Couldn't figure out authenticator for server"))))))
- (when (imap-opened buffer)
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
- buffer)))
+ (message "imap: Connecting to %s..." imap-server)
+ (if (null (let ((imap-stream (or imap-stream imap-default-stream)))
+ (imap-open-1 buffer)))
+ (progn
+ (message "imap: Connecting to %s...failed" imap-server)
+ nil)
+ (when (null imap-stream)
+ ;; Need to choose stream.
+ (let ((streams imap-streams))
+ (while (setq stream (pop streams))
+ ;; OK to use this stream?
+ (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
+ ;; Stream changed?
+ (if (not (eq imap-default-stream stream))
+ (with-current-buffer (get-buffer-create
+ (generate-new-buffer-name " *temp*"))
+ (mapc 'make-local-variable imap-local-variables)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (setq imap-server (or server imap-server))
+ (setq imap-port (or port imap-port))
+ (setq imap-auth (or auth imap-auth))
+ (message "imap: Reconnecting with stream `%s'..." stream)
+ (if (null (let ((imap-stream stream))
+ (imap-open-1 (current-buffer))))
+ (progn
+ (kill-buffer (current-buffer))
+ (message
+ "imap: Reconnecting with stream `%s'...failed"
+ stream))
+ ;; We're done, kill the first connection
+ (imap-close buffer)
+ (let ((name (if (stringp buffer)
+ buffer
+ (buffer-name buffer))))
+ (kill-buffer buffer)
+ (rename-buffer name)
+ ;; set the passed buffer to the current one,
+ ;; so that (imap-opened buffer) later will work
+ (setq buffer (current-buffer)))
+ (message "imap: Reconnecting with stream `%s'...done"
+ stream)
+ (setq imap-stream stream)
+ (setq imap-capability nil)
+ (setq streams nil)))
+ ;; We're done
+ (message "imap: Connecting to %s...done" imap-server)
+ (setq imap-stream stream)
+ (setq imap-capability nil)
+ (setq streams nil))))))
+ (when (imap-opened buffer)
+ (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
+ ;; (debug "opened+state+auth+buffer" (imap-opened buffer) imap-state imap-auth buffer)
+ (when imap-stream
+ buffer))))
+
+(defcustom imap-ping-server t
+ "If non-nil, check if IMAP is open.
+See the function `imap-ping-server'."
+ :version "23.1" ;; No Gnus
+ :group 'imap
+ :type 'boolean)
(defun imap-opened (&optional buffer)
"Return non-nil if connection to imap server in BUFFER is open.
(buffer-live-p buffer)
(with-current-buffer buffer
(and imap-process
- (memq (process-status imap-process) '(open run))))))
+ (memq (process-status imap-process) '(open run))
+ (if imap-ping-server
+ (imap-ping-server)
+ t)))))
+
+(defun imap-ping-server (&optional buffer)
+ "Ping the IMAP server in BUFFER with a \"NOOP\" command.
+Return non-nil if the server responds, and nil if it does not
+respond. If BUFFER is nil, the current buffer is used."
+ (condition-case ()
+ (imap-ok-p (imap-send-command-wait "NOOP" buffer))
+ (error nil)))
(defun imap-authenticate (&optional user passwd buffer)
"Authenticate to server in BUFFER, using current buffer if nil.
(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-variable-buffer-local 'imap-username)
- (make-variable-buffer-local 'imap-password)
- (if user (setq imap-username user))
- (if passwd (setq imap-password passwd))
- (if (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer)
- (setq imap-state 'auth)))))
+ (make-local-variable 'imap-username)
+ (make-local-variable 'imap-password)
+ (make-local-variable 'imap-last-authenticator)
+ (when user (setq imap-username user))
+ (when passwd (setq imap-password passwd))
+ (if imap-auth
+ (and (setq imap-last-authenticator
+ (assq imap-auth imap-authenticator-alist))
+ (funcall (nth 2 imap-last-authenticator) (current-buffer))
+ (setq imap-state 'auth))
+ ;; Choose authenticator.
+ (let ((auths imap-authenticators)
+ auth)
+ (while (setq auth (pop auths))
+ ;; OK to use authenticator?
+ (setq imap-last-authenticator
+ (assq auth imap-authenticator-alist))
+ (when (funcall (nth 1 imap-last-authenticator) (current-buffer))
+ (message "imap: Authenticating to `%s' using `%s'..."
+ imap-server auth)
+ (setq imap-auth auth)
+ (if (funcall (nth 2 imap-last-authenticator) (current-buffer))
+ (progn
+ (message "imap: Authenticating to `%s' using `%s'...done"
+ imap-server auth)
+ ;; set imap-state correctly on successful auth attempt
+ (setq imap-state 'auth)
+ ;; stop iterating through the authenticator list
+ (setq auths nil))
+ (message "imap: Authenticating to `%s' using `%s'...failed"
+ imap-server auth)))))
+ imap-state))))
(defun imap-close (&optional buffer)
"Close connection to server in BUFFER.
If BUFFER is nil, the current buffer is used."
(with-current-buffer (or buffer (current-buffer))
- (and (imap-opened)
- (not (imap-ok-p (imap-send-command-wait "LOGOUT")))
- (message "Server %s didn't let me log out" imap-server))
+ (when (imap-opened)
+ (condition-case nil
+ (imap-logout-wait)
+ (quit nil)))
(when (and imap-process
(memq (process-status imap-process) '(open run)))
(delete-process imap-process))
(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."
(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:
(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
(with-current-buffer (or buffer (current-buffer))
(let (result)
- (mapatoms
+ (mapatoms
(lambda (s)
(push (funcall func (if mailbox-decoder
(funcall mailbox-decoder (symbol-name s))
imap-current-mailbox
(setq imap-current-mailbox mailbox)
(if (imap-ok-p (imap-send-command-wait
- (concat (if examine "EXAMINE" "SELECT") " \""
+ (concat (if examine "EXAMINE" "SELECT") " \""
mailbox "\"")))
(progn
(setq imap-message-data (make-vector imap-message-prime 0)
;; Failed SELECT/EXAMINE unselects current mailbox
(setq imap-current-mailbox nil))))
-(defun imap-mailbox-select (mailbox &optional examine buffer)
+(defun imap-mailbox-select (mailbox &optional examine buffer)
(with-current-buffer (or buffer (current-buffer))
- (imap-utf7-decode
+ (imap-utf7-decode
(imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
(defun imap-mailbox-examine-1 (mailbox &optional buffer)
(with-current-buffer (or buffer (current-buffer))
- (imap-mailbox-select-1 mailbox 'exmine)))
+ (imap-mailbox-select-1 mailbox 'examine)))
(defun imap-mailbox-examine (mailbox &optional buffer)
"Examine MAILBOX on server in BUFFER."
- (imap-mailbox-select mailbox 'exmine buffer))
+ (imap-mailbox-select mailbox 'examine buffer))
(defun imap-mailbox-unselect (&optional buffer)
"Close current folder in BUFFER, without expunging articles."
(when (or (eq imap-state 'auth)
(and (imap-capability 'UNSELECT)
(imap-ok-p (imap-send-command-wait "UNSELECT")))
- (and (imap-ok-p
+ (and (imap-ok-p
(imap-send-command-wait (concat "EXAMINE \""
imap-current-mailbox
"\"")))
imap-state 'auth)
t)))
-(defun imap-mailbox-expunge (&optional buffer)
+(defun imap-mailbox-expunge (&optional asynch buffer)
"Expunge articles in current folder in BUFFER.
+If ASYNCH, do not wait for successful completion of the command.
If BUFFER is nil the current buffer is assumed."
(with-current-buffer (or buffer (current-buffer))
(when (and imap-current-mailbox (not (eq imap-state 'examine)))
- (imap-ok-p (imap-send-command-wait "EXPUNGE")))))
+ (if asynch
+ (imap-send-command "EXPUNGE")
+ (imap-ok-p (imap-send-command-wait "EXPUNGE"))))))
-(defun imap-mailbox-close (&optional buffer)
+(defun imap-mailbox-close (&optional asynch buffer)
"Expunge articles and close current folder in BUFFER.
+If ASYNCH, do not wait for successful completion of the command.
If BUFFER is nil the current buffer is assumed."
(with-current-buffer (or buffer (current-buffer))
- (when (and imap-current-mailbox
- (imap-ok-p (imap-send-command-wait "CLOSE")))
- (setq imap-current-mailbox nil
- imap-message-data nil
- imap-state 'auth)
+ (when imap-current-mailbox
+ (if asynch
+ (imap-add-callback (imap-send-command "CLOSE")
+ `(lambda (tag status)
+ (message "IMAP mailbox `%s' closed... %s"
+ imap-current-mailbox status)
+ (when (eq ,imap-current-mailbox
+ imap-current-mailbox)
+ ;; Don't wipe out data if another mailbox
+ ;; was selected...
+ (setq imap-current-mailbox nil
+ imap-message-data nil
+ imap-state 'auth))))
+ (when (imap-ok-p (imap-send-command-wait "CLOSE"))
+ (setq imap-current-mailbox nil
+ imap-message-data nil
+ imap-state 'auth)))
t)))
(defun imap-mailbox-create-1 (mailbox)
(imap-send-command-wait (list "RENAME \"" oldname "\" "
"\"" newname "\""))))))
-(defun imap-mailbox-lsub (&optional root reference add-delimiter buffer)
+(defun imap-mailbox-lsub (&optional root reference add-delimiter buffer)
"Return a list of subscribed mailboxes on server in BUFFER.
If ROOT is non-nil, only list matching mailboxes. If ADD-DELIMITER is
non-nil, a hierarchy delimiter is added to root. REFERENCE is a
(imap-mailbox-map-1 (lambda (mailbox)
(imap-mailbox-put 'lsub nil mailbox)))
(when (imap-ok-p
- (imap-send-command-wait
+ (imap-send-command-wait
(concat "LSUB \"" reference "\" \"" (imap-utf7-encode root)
(and add-delimiter (imap-mailbox-get-1 'delimiter root))
"%\"")))
(imap-mailbox-map-1 (lambda (mailbox)
(imap-mailbox-put 'list nil mailbox)))
(when (imap-ok-p
- (imap-send-command-wait
+ (imap-send-command-wait
(concat "LIST \"" reference "\" \"" (imap-utf7-encode root)
(and add-delimiter (imap-mailbox-get-1 'delimiter root))
"%\"")))
(nreverse out)))))
(defun imap-mailbox-subscribe (mailbox &optional buffer)
- "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
+ "Send the SUBSCRIBE command on the MAILBOX to server in BUFFER.
Returns non-nil if successful."
(with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \""
+ (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \""
(imap-utf7-encode mailbox)
"\"")))))
(defun imap-mailbox-unsubscribe (mailbox &optional buffer)
- "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
+ "Send the SUBSCRIBE command on the MAILBOX to server in BUFFER.
Returns non-nil if successful."
(with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE "
+ (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE "
(imap-utf7-encode mailbox)
"\"")))))
(defun imap-mailbox-status (mailbox items &optional buffer)
"Get status items ITEM in MAILBOX from server in BUFFER.
ITEMS can be a symbol or a list of symbols, valid symbols are one of
-the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
-or 'unseen. If ITEMS is a list of symbols, a list of values is
-returned, if ITEMS is a symbol only it's value is returned."
+the STATUS data items -- i.e. `messages', `recent', `uidnext', `uidvalidity',
+or `unseen'. If ITEMS is a list of symbols, a list of values is
+returned, if ITEMS is a symbol only its value is returned."
(with-current-buffer (or buffer (current-buffer))
- (when (imap-ok-p
+ (when (imap-ok-p
(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))
items)
(imap-mailbox-get items mailbox)))))
+(defun imap-mailbox-status-asynch (mailbox items &optional buffer)
+ "Send status item request ITEM on MAILBOX to server in BUFFER.
+ITEMS can be a symbol or a list of symbols, valid symbols are one of
+the STATUS data items -- i.e. 'messages, 'recent, 'uidnext, 'uidvalidity
+or 'unseen. The IMAP command tag is returned."
+ (with-current-buffer (or buffer (current-buffer))
+ (imap-send-command (list "STATUS \""
+ (imap-utf7-encode mailbox)
+ "\" "
+ (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."
+ "Get ACL on MAILBOX from server in BUFFER."
(let ((mailbox (imap-utf7-encode mailbox)))
(with-current-buffer (or buffer (current-buffer))
(when (imap-ok-p
rights))))))
(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
- "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
+ "Remove any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
(let ((mailbox (imap-utf7-encode mailbox)))
(with-current-buffer (or buffer (current-buffer))
(imap-ok-p
(mapconcat
(lambda (item)
(if (consp item)
- (format "%d:%d"
- (car item) (cdr item))
+ (format "%d:%d"
+ (car item) (cdr item))
(format "%d" item)))
(if (and (listp range) (not (listp (cdr range))))
(list range) ;; make (1 . 2) into ((1 . 2))
(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
+ (when (imap-ok-p (imap-send-command-wait
(format "%sFETCH %s %s" (if nouidfetch "" "UID ")
(if (listp uids)
(imap-list-to-message-set uids)
(imap-message-get uid receive)))
uids)
(imap-message-get uids receive))))))
-
+
(defun imap-message-put (uid propname value &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(if imap-message-data
propname)))
(defun imap-message-map (func propname &optional buffer)
- "Map a function across each mailbox in `imap-message-data', returning a list."
+ "Map a function across each message in `imap-message-data', returning a list."
(with-current-buffer (or buffer (current-buffer))
(let (result)
(mapatoms
`(with-current-buffer (or ,buffer (current-buffer))
(imap-message-get ,uid 'BODY)))
+;; FIXME: Should this try to use CHARSET? -- fx
(defun imap-search (predicate &optional buffer)
(with-current-buffer (or buffer (current-buffer))
(imap-mailbox-put 'search 'dummy)
(when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
(if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
- (error "Missing SEARCH response to a SEARCH command")
+ (progn
+ (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...")
+ nil)
(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)))))
(concat "UID STORE " articles
" +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
+;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/65317/focus=65343
+;; Signal an error if we'd get an integer overflow.
+;;
+;; FIXME: Identify relevant calls to `string-to-number' and replace them with
+;; `imap-string-to-integer'.
+(defun imap-string-to-integer (string &optional base)
+ (let ((number (string-to-number string base)))
+ (if (> number most-positive-fixnum)
+ (error
+ (format "String %s cannot be converted to a Lisp integer" number))
+ number)))
+
+(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
+ "Like `imap-fetch', but DTRT with Exchange 2007 bug.
+However, UIDS here is a cons, where the car is the canonical form
+of the UIDS specification, and the cdr is the one which works with
+Exchange 2007 or, potentially, other buggy servers.
+See `imap-enable-exchange-bug-workaround'."
+ ;; The first time we get here for a given, we'll try the canonical
+ ;; form. If we get the known error from the buggy server, set the
+ ;; flag buffer-locally (to account for connections to multiple
+ ;; servers), then re-try with the alternative UIDS spec. We don't
+ ;; unconditionally use the alternative form, since the
+ ;; currently-used alternatives are seriously inefficient with some
+ ;; servers (although they are valid).
+ ;;
+ ;; FIXME: Maybe it would be cleaner to have a flag to not signal
+ ;; the error (which otherwise gives a message), and test
+ ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of
+ ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
+ ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not
+ ;; to do the same?
+ (condition-case data
+ ;; Binding `debug-on-error' allows us to get the error from
+ ;; `imap-parse-response' -- it's normally caught by Emacs around
+ ;; execution of a process filter.
+ (let ((debug-on-error t))
+ (imap-fetch (if imap-enable-exchange-bug-workaround
+ (cdr uids)
+ (car uids))
+ props receive nouidfetch buffer))
+ (error
+ (if (and (not imap-enable-exchange-bug-workaround)
+ ;; This is the Exchange 2007 response. It may be more
+ ;; robust just to check for a BAD response to the
+ ;; attempted fetch.
+ (string-match "The specified message set is invalid"
+ (cadr data)))
+ (with-current-buffer (or buffer (current-buffer))
+ (set (make-local-variable 'imap-enable-exchange-bug-workaround)
+ t)
+ (imap-fetch (cdr uids) props receive nouidfetch))
+ (signal (car data) (cdr data))))))
+
(defun imap-message-copyuid-1 (mailbox)
(if (imap-capability 'UIDPLUS)
(list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch "*" "UID")
+ (and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
(defun imap-message-copy (articles mailbox
&optional dont-create no-copyuid buffer)
- "Copy ARTICLES (a string message set) to MAILBOX on server in
-BUFFER, creating mailbox if it doesn't exist. If dont-create is
-non-nil, it will not create a mailbox. On success, return a list with
+ "Copy ARTICLES to MAILBOX on server in BUFFER.
+ARTICLES is a string message set. Create mailbox if it doesn't exist,
+unless DONT-CREATE is non-nil. On success, return a list with
the UIDVALIDITY of the mailbox the article(s) was copied to as the
-first element, rest of list contain the saved articles' UIDs."
+first element. The rest of list contains the saved articles' UIDs."
(when articles
(with-current-buffer (or buffer (current-buffer))
(let ((mailbox (imap-utf7-encode mailbox)))
(if (imap-ok-p (imap-send-command-wait cmd))
t
(when (and (not dont-create)
- (imap-mailbox-get-1 'trycreate mailbox))
- (imap-mailbox-create-1 mailbox)
+ ;; removed because of buggy Oracle server
+ ;; that doesn't send TRYCREATE tags (which
+ ;; is a MUST according to specifications):
+ ;;(imap-mailbox-get-1 'trycreate mailbox)
+ (imap-mailbox-create-1 mailbox))
(imap-ok-p (imap-send-command-wait cmd)))))
(or no-copyuid
(imap-message-copyuid-1 mailbox)))))))
-
+
+;; FIXME: Amalgamate with imap-message-copyuid-1, using an extra arg, since it
+;; shares most of the code? -- fx
(defun imap-message-appenduid-1 (mailbox)
(if (imap-capability 'UIDPLUS)
(imap-mailbox-get-1 'appenduid mailbox)
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch "*" "UID")
+ (and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
(let ((mailbox (imap-utf7-encode mailbox)))
(with-current-buffer (or buffer (current-buffer))
(and (let ((imap-current-target-mailbox mailbox))
- (imap-ok-p
- (imap-send-command-wait
+ (imap-ok-p
+ (imap-send-command-wait
(list "APPEND \"" mailbox "\" " article))))
(imap-message-appenduid-1 mailbox)))))
-
+
(defun imap-body-lines (body)
"Return number of lines in article by looking at the mime bodystructure BODY."
(if (listp body)
(and from
(concat (aref from 0)
(if (aref from 0) " <")
- (aref from 2)
- "@"
+ (aref from 2)
+ "@"
(aref from 3)
(if (aref from 0) ">"))))
\f
;; Internal functions.
+(defun imap-add-callback (tag func)
+ (setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
+
(defun imap-send-command-1 (cmdstr)
(setq cmdstr (concat cmdstr imap-client-eol))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
+ (imap-log cmdstr)
(process-send-string imap-process cmdstr))
(defun imap-send-command (command &optional buffer)
(replace-match eol)))
(if (not calcfirst)
(setq size (buffer-size))))
- (setq cmdstr
+ (setq cmdstr
(concat cmdstr (format "{%d}" size))))
(unwind-protect
(progn
(imap-send-command-1 cmdstr)
(setq cmdstr nil)
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil);; abort command if no cont-req
+ (setq command nil) ;; abort command if no cont-req
(let ((process imap-process)
(stream imap-stream)
(eol imap-client-eol))
(with-current-buffer cmd
- (and imap-log
- (with-current-buffer (get-buffer-create
- imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring cmd)))
+ (imap-log cmd)
(process-send-region process (point-min)
(point-max)))
(process-send-string process imap-client-eol))))
(imap-send-command-1 cmdstr)
(setq cmdstr nil)
(unwind-protect
- (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil);; abort command if no cont-req
- (setq command (cons (funcall cmd imap-continuation)
- command)))
+ (setq command
+ (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
+ nil ;; abort command if no cont-req
+ (cons (funcall cmd imap-continuation)
+ command)))
(setq imap-continuation nil)))
(t
(error "Unknown command type"))))
(defun imap-wait-for-tag (tag &optional buffer)
(with-current-buffer (or buffer (current-buffer))
- (while (and (null imap-continuation)
- (< imap-reached-tag tag))
- (or (and (not (memq (process-status imap-process) '(open run)))
- (sit-for 1))
- (accept-process-output imap-process 1)))
- (or (assq tag imap-failed-tags)
- (if imap-continuation
- 'INCOMPLETE
- 'OK))))
+ (let (imap-have-messaged)
+ (while (and (null imap-continuation)
+ (memq (process-status imap-process) '(open run))
+ (< imap-reached-tag tag))
+ (let ((len (/ (buffer-size) 1024))
+ message-log-max)
+ (unless (< len 10)
+ (setq imap-have-messaged t)
+ (message "imap read: %dk" len))
+ (accept-process-output imap-process
+ (truncate imap-read-timeout)
+ (truncate (* (- imap-read-timeout
+ (truncate imap-read-timeout))
+ 1000)))))
+ ;; A process can die _before_ we have processed everything it
+ ;; has to say. Moreover, this can happen in between the call to
+ ;; accept-process-output and the call to process-status in an
+ ;; iteration of the loop above.
+ (when (and (null imap-continuation)
+ (< imap-reached-tag tag))
+ (accept-process-output imap-process 0 0))
+ (when imap-have-messaged
+ (message ""))
+ (and (memq (process-status imap-process) '(open run))
+ (or (assq tag imap-failed-tags)
+ (if imap-continuation
+ 'INCOMPLETE
+ 'OK))))))
(defun imap-sentinel (process string)
(delete-process process))
(defun imap-arrival-filter (proc string)
"IMAP process filter."
- (with-current-buffer (process-buffer proc)
- (goto-char (point-max))
- (insert string)
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert string)))
- (let (end)
- (goto-char (point-min))
- (while (setq end (imap-find-next-line))
- (save-restriction
- (narrow-to-region (point-min) end)
- (delete-backward-char (length imap-server-eol))
- (goto-char (point-min))
- (unwind-protect
- (cond ((eq imap-state 'initial)
- (imap-parse-greeting))
- ((or (eq imap-state 'auth)
- (eq imap-state 'nonauth)
- (eq imap-state 'selected)
- (eq imap-state 'examine))
- (imap-parse-response))
- (t
- (message "Unknown state %s in arrival filter"
- imap-state)))
- (delete-region (point-min) (point-max))))))))
+ ;; Sometimes, we are called even though the process has died.
+ ;; Better abstain from doing stuff in that case.
+ (when (buffer-name (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-max))
+ (insert string)
+ (imap-log string)
+ (let (end)
+ (goto-char (point-min))
+ (while (setq end (imap-find-next-line))
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (delete-char (- (length imap-server-eol)))
+ (goto-char (point-min))
+ (unwind-protect
+ (cond ((eq imap-state 'initial)
+ (imap-parse-greeting))
+ ((or (eq imap-state 'auth)
+ (eq imap-state 'nonauth)
+ (eq imap-state 'selected)
+ (eq imap-state 'examine))
+ (imap-parse-response))
+ (t
+ (message "Unknown state %s in arrival filter"
+ imap-state)))
+ (delete-region (point-min) (point-max)))))))))
\f
;; Imap parser.
(defsubst imap-parse-astring ()
(or (imap-parse-string)
- (buffer-substring (point)
+ (buffer-substring (point)
(if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
(goto-char (1- (match-end 0)))
(end-of-line)
;;
;; addr-adl = nstring
;; ; Holds route from [RFC-822] route-addr if
-;; ; non-NIL
+;; ; non-nil
;;
;; addr-host = nstring
-;; ; NIL indicates [RFC-822] group syntax.
+;; ; nil indicates [RFC-822] group syntax.
;; ; Otherwise, holds [RFC-822] domain name
;;
;; addr-mailbox = nstring
-;; ; NIL indicates end of [RFC-822] group; if
-;; ; non-NIL and addr-host is NIL, holds
+;; ; nil indicates end of [RFC-822] group; if
+;; ; non-nil and addr-host is nil, holds
;; ; [RFC-822] group name.
;; ; Otherwise, holds [RFC-822] local-part
;; ; after removing [RFC-822] quoting
;;
;; addr-name = nstring
-;; ; If non-NIL, holds phrase from [RFC-822]
+;; ; If non-nil, holds phrase from [RFC-822]
;; ; mailbox after removing [RFC-822] quoting
;;
(when (eq (char-after) ?\))
(imap-forward)
(nreverse addresses)))
- (assert (imap-parse-nil))))
+ ;; 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
;; resp-cond-bye = "BYE" SP resp-text
(defun imap-parse-greeting ()
- "Parse a IMAP greeting."
+ "Parse an IMAP greeting."
(cond ((looking-at "\\* OK ")
(setq imap-state 'nonauth))
((looking-at "\\* PREAUTH ")
;; resp-cond-bye = "BYE" SP resp-text
;;
;; mailbox-data = "FLAGS" SP flag-list /
-;; "LIST" SP mailbox-list /
+;; "LIST" SP mailbox-list /
;; "LSUB" SP mailbox-list /
;; "SEARCH" *(SP nz-number) /
;; "STATUS" SP mailbox SP "("
(FLAGS (imap-mailbox-put 'flags (imap-parse-flag-list)))
(LIST (imap-parse-data-list 'list))
(LSUB (imap-parse-data-list 'lsub))
- (SEARCH (imap-mailbox-put
- 'search
+ (SEARCH (imap-mailbox-put
+ 'search
(read (concat "(" (buffer-substring (point) (point-max)) ")"))))
(STATUS (imap-parse-status))
- (CAPABILITY (setq imap-capability
- (read (concat "(" (upcase (buffer-substring
- (point) (point-max)))
- ")"))))
+ (CAPABILITY (setq imap-capability
+ (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))
(search-forward "]")))
(imap-forward))
(setq text (buffer-substring (point) (point-max)))
- (push (list token status code text)
+ (push (list token status code text)
imap-failed-tags))))
(BAD (progn
(setq imap-reached-tag (max imap-reached-tag token))
(push (list token status code text) imap-failed-tags)
(error "Internal error, tag %s status %s code %s text %s"
token status code text))))
- (t (message "Garbage: %s" (buffer-string))))))))))
+ (t (message "Garbage: %s" (buffer-string))))
+ (when (assq token imap-callbacks)
+ (funcall (cdr (assq token imap-callbacks)) token status)
+ (setq imap-callbacks
+ (imap-remassoc token imap-callbacks)))))))))
;; resp-text = ["[" resp-text-code "]" SP] text
;;
;; resp-text-code = "ALERT" /
;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
-;; "NEWNAME" SP string SP string /
+;; "NEWNAME" SP string SP string /
;; "PARSE" /
-;; "PERMANENTFLAGS" SP "("
+;; "PERMANENTFLAGS" SP "("
;; [flag-perm *(SP flag-perm)] ")" /
-;; "READ-ONLY" /
-;; "READ-WRITE" /
-;; "TRYCREATE" /
-;; "UIDNEXT" SP nz-number /
+;; "READ-ONLY" /
+;; "READ-WRITE" /
+;; "TRYCREATE" /
+;; "UIDNEXT" SP nz-number /
;; "UIDVALIDITY" SP nz-number /
;; "UNSEEN" SP nz-number /
;; resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
;; ; delimits between two numbers inclusive.
;; ; Example: 2,4:7,9,12:* is 2,4,5,6,7,9,12,13,
;; ; 14,15 for a mailbox with 15 messages.
-;;
+;;
;; sequence-num = nz-number / "*"
;; ; * is the largest number in use. For message
;; ; sequence numbers, it is the number of messages
;; resp-text-atom = 1*<any ATOM-CHAR except "]">
(defun imap-parse-resp-text-code ()
+ ;; xxx next line for stalker communigate pro 3.3.1 bug
+ (when (looking-at " \\[")
+ (imap-forward))
(when (eq (char-after) ?\[)
(imap-forward)
(cond ((search-forward "PERMANENTFLAGS " nil t)
(imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
- ((search-forward "UIDNEXT " nil t)
- (imap-mailbox-put 'uidnext (read (current-buffer))))
+ ((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
+ (imap-mailbox-put 'uidnext (match-string 1)))
((search-forward "UNSEEN " nil t)
- (imap-mailbox-put 'unseen (read (current-buffer))))
+ (imap-mailbox-put 'first-unseen (read (current-buffer))))
((looking-at "UIDVALIDITY \\([0-9]+\\)")
(imap-mailbox-put 'uidvalidity (match-string 1)))
((search-forward "READ-ONLY" nil t)
;; "BODY" ["STRUCTURE"] SPACE body /
;; "BODY" section ["<" number ">"] SPACE nstring /
;; "UID" SPACE uniqueid) ")"
-;;
+;;
;; date_time ::= <"> date_day_fixed "-" date_month "-" date_year
;; SPACE time SPACE zone <">
-;;
+;;
;; section ::= "[" [section_text / (nz_number *["." nz_number]
;; ["." (section_text / "MIME")])] "]"
-;;
+;;
;; section_text ::= "HEADER" / "HEADER.FIELDS" [".NOT"]
;; SPACE header_list / "TEXT"
-;;
+;;
;; header_fld_name ::= astring
-;;
+;;
;; header_list ::= "(" 1#header_fld_name ")"
(defsubst imap-parse-header-list ()
(nreverse strlist))))
(defsubst imap-parse-fetch-body-section ()
- (let ((section
+ (let ((section
(buffer-substring (point) (1- (re-search-forward "[] ]" nil t)))))
(if (eq (char-before) ? )
(prog1
(defun imap-parse-fetch (response)
(when (eq (char-after) ?\()
- (let (uid flags envelope internaldate rfc822 rfc822header rfc822text
- rfc822size body bodydetail bodystructure)
- (while (not (eq (char-after) ?\)))
+ (let (uid flags envelope internaldate rfc822 rfc822header rfc822text
+ rfc822size body bodydetail bodystructure flags-empty)
+ ;; Courier can insert spurious blank characters which will
+ ;; confuse `read', so skip past them.
+ (while (let ((moved (skip-chars-forward " \t")))
+ (prog1 (not (eq (char-after) ?\)))
+ (unless (= moved 0) (backward-char))))
(imap-forward)
(let ((token (read (current-buffer))))
(imap-forward)
(cond ((eq token 'UID)
- (setq uid (ignore-errors (read (current-buffer)))))
+ (setq uid (condition-case ()
+ (read (current-buffer))
+ (error))))
((eq token 'FLAGS)
- (setq flags (imap-parse-flag-list)))
+ (setq flags (imap-parse-flag-list))
+ (if (not flags)
+ (setq flags-empty 't)))
((eq token 'ENVELOPE)
(setq envelope (imap-parse-envelope)))
((eq token 'INTERNALDATE)
(when uid
(setq imap-current-message uid)
(imap-message-put uid 'UID uid)
- (and flags (imap-message-put uid 'FLAGS flags))
+ (and (or flags flags-empty) (imap-message-put uid 'FLAGS flags))
(and envelope (imap-message-put uid 'ENVELOPE envelope))
(and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
(and rfc822 (imap-message-put uid 'RFC822 rfc822))
;; mailbox-data = ...
;; "STATUS" SP mailbox SP "("
-;; [status-att SP number
+;; [status-att SP number
;; *(SP status-att SP number)] ")"
;; ...
;;
(defun imap-parse-status ()
(let ((mailbox (imap-parse-mailbox)))
- (when (and mailbox (search-forward "(" nil t))
- (while (not (eq (char-after) ?\)))
- (let ((token (read (current-buffer))))
- (cond ((eq token 'MESSAGES)
+ (if (eq (char-after) ? )
+ (forward-char))
+ (when (and mailbox (eq (char-after) ?\())
+ (while (and (not (eq (char-after) ?\)))
+ (or (forward-char) t)
+ (looking-at "\\([A-Za-z]+\\) "))
+ (let ((token (upcase (match-string 1))))
+ (goto-char (match-end 0))
+ (cond ((string= token "MESSAGES")
(imap-mailbox-put 'messages (read (current-buffer)) mailbox))
- ((eq token 'RECENT)
+ ((string= token "RECENT")
(imap-mailbox-put 'recent (read (current-buffer)) mailbox))
- ((eq token 'UIDNEXT)
- (imap-mailbox-put 'uidnext (read (current-buffer)) mailbox))
- ((eq token 'UIDVALIDITY)
- (and (looking-at " \\([0-9]+\\)")
- (imap-mailbox-put 'uidvalidity (match-string 1) mailbox)
- (goto-char (match-end 1))))
- ((eq token 'UNSEEN)
+ ((string= token "UIDNEXT")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidnext (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UIDVALIDITY")
+ (and (looking-at "[0-9]+")
+ (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
+ (goto-char (match-end 0))))
+ ((string= token "UNSEEN")
(imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
(t
- (message "Unknown status data %s in mailbox %s ignored"
- token mailbox))))))))
+ (message "Unknown status data %s in mailbox %s ignored"
+ token mailbox)
+ (read (current-buffer)))))))))
;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
;; rights)
;; ; revisions of this specification.
(defun imap-parse-flag-list ()
- (let ((str (buffer-substring (point) (search-forward ")" nil t)))
- pos)
- (while (setq pos (string-match "\\\\" str (and pos (+ 2 pos))))
- (setq str (replace-match "\\\\" nil t str)))
- ;; xxx ugly. rewrite not to use `read' at all.
- (when (= (length (symbol-name (read "A?A"))) 1)
- (while (setq pos (string-match "\\?" str (and pos (+ 2 pos))))
- (setq str (replace-match "\\?" nil t str))))
- (mapcar 'symbol-name (read str))))
+ (let (flag-list start)
+ (assert (eq (char-after) ?\() nil "In imap-parse-flag-list 1")
+ (while (and (not (eq (char-after) ?\)))
+ (setq start (progn
+ (imap-forward)
+ ;; next line for Courier IMAP bug.
+ (skip-chars-forward " ")
+ (point)))
+ (> (skip-chars-forward "^ )" (point-at-eol)) 0))
+ (push (buffer-substring start (point)) flag-list))
+ (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list 2")
+ (imap-forward)
+ (nreverse flag-list)))
;; envelope = "(" env-date SP env-subject SP env-from SP env-sender SP
;; env-reply-to SP env-to SP env-cc SP env-bcc SP
(defun imap-parse-envelope ()
(when (eq (char-after) ?\()
(imap-forward)
- (vector (prog1 (imap-parse-nstring);; date
+ (vector (prog1 (imap-parse-nstring) ;; date
(imap-forward))
- (prog1 (imap-parse-nstring);; subject
+ (prog1 (imap-parse-nstring) ;; subject
(imap-forward))
- (prog1 (imap-parse-address-list);; from
+ (prog1 (imap-parse-address-list) ;; from
(imap-forward))
- (prog1 (imap-parse-address-list);; sender
+ (prog1 (imap-parse-address-list) ;; sender
(imap-forward))
- (prog1 (imap-parse-address-list);; reply-to
+ (prog1 (imap-parse-address-list) ;; reply-to
(imap-forward))
- (prog1 (imap-parse-address-list);; to
+ (prog1 (imap-parse-address-list) ;; to
(imap-forward))
- (prog1 (imap-parse-address-list);; cc
+ (prog1 (imap-parse-address-list) ;; cc
(imap-forward))
- (prog1 (imap-parse-address-list);; bcc
+ (prog1 (imap-parse-address-list) ;; bcc
(imap-forward))
- (prog1 (imap-parse-nstring);; in-reply-to
+ (prog1 (imap-parse-nstring) ;; in-reply-to
(imap-forward))
- (prog1 (imap-parse-nstring);; message-id
+ (prog1 (imap-parse-nstring) ;; message-id
(imap-forward)))))
;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil
(defsubst imap-parse-string-list ()
- (cond ((eq (char-after) ?\();; body-fld-param
+ (cond ((eq (char-after) ?\() ;; body-fld-param
(let (strlist str)
(imap-forward)
(while (setq str (imap-parse-string))
(while (eq (char-after) ?\ )
(imap-forward)
(push (imap-parse-body-extension) b-e))
- (assert (eq (char-after) ?\)))
+ (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
(imap-forward)
(nreverse b-e))
(or (imap-parse-number)
(defsubst imap-parse-body-ext ()
(let (ext)
- (when (eq (char-after) ?\ );; body-fld-dsp
+ (when (eq (char-after) ?\ ) ;; body-fld-dsp
(imap-forward)
(let (dsp)
(if (eq (char-after) ?\()
(imap-forward)
(push (imap-parse-string-list) dsp)
(imap-forward))
- (assert (imap-parse-nil)))
+ ;; 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
+ (when (eq (char-after) ?\ ) ;; body-fld-lang
(imap-forward)
(if (eq (char-after) ?\()
(push (imap-parse-string-list) ext)
(push (imap-parse-nstring) ext))
- (while (eq (char-after) ?\ );; body-extension
+ (while (eq (char-after) ?\ ) ;; body-extension
(imap-forward)
(setq ext (append (imap-parse-body-extension) ext)))))
ext))
(let (subbody)
(while (and (eq (char-after) ?\()
(setq subbody (imap-parse-body)))
- ;; buggy stalker communigate pro 3.0 insert a SPC between
+ ;; buggy stalker communigate pro 3.0 inserts a SPC between
;; parts in multiparts
(when (and (eq (char-after) ?\ )
(eq (char-after (1+ (point))) ?\())
(imap-forward))
(push subbody body))
(imap-forward)
- (push (imap-parse-string) body);; media-subtype
- (when (eq (char-after) ?\ );; body-ext-mpart:
+ (push (imap-parse-string) body) ;; media-subtype
+ (when (eq (char-after) ?\ ) ;; body-ext-mpart:
(imap-forward)
- (if (eq (char-after) ?\();; body-fld-param
+ (if (eq (char-after) ?\() ;; body-fld-param
(push (imap-parse-string-list) body)
(push (and (imap-parse-nil) nil) body))
(setq body
- (append (imap-parse-body-ext) body)));; body-ext-...
- (assert (eq (char-after) ?\)))
+ (append (imap-parse-body-ext) body))) ;; body-ext-...
+ (assert (eq (char-after) ?\)) nil "In imap-parse-body")
(imap-forward)
(nreverse body))
- (push (imap-parse-string) body);; media-type
+ (push (imap-parse-string) body) ;; media-type
(imap-forward)
- (push (imap-parse-string) body);; media-subtype
+ (push (imap-parse-string) body) ;; media-subtype
(imap-forward)
;; next line for Sun SIMS bug
(and (eq (char-after) ? ) (imap-forward))
- (if (eq (char-after) ?\();; body-fld-param
+ (if (eq (char-after) ?\() ;; body-fld-param
(push (imap-parse-string-list) body)
(push (and (imap-parse-nil) nil) body))
(imap-forward)
- (push (imap-parse-nstring) body);; body-fld-id
+ (push (imap-parse-nstring) body) ;; body-fld-id
(imap-forward)
- (push (imap-parse-nstring) body);; body-fld-desc
+ (push (imap-parse-nstring) body) ;; body-fld-desc
(imap-forward)
- (push (imap-parse-string) body);; body-fld-enc
+ ;; Next `or' for Sun SIMS bug. It regards body-fld-enc as a
+ ;; nstring and returns nil instead of defaulting back to 7BIT
+ ;; as the standard says.
+ ;; Exchange (2007, at least) does this as well.
+ (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
(imap-forward)
- (push (imap-parse-number) body);; body-fld-octets
+ ;; Exchange 2007 can return -1, contrary to the spec...
+ (if (eq (char-after) ?-)
+ (progn
+ (skip-chars-forward "-0-9")
+ (push nil body))
+ (push (imap-parse-number) body)) ;; body-fld-octets
- ;; ok, we're done parsing the required parts, what comes now is one
- ;; of three things:
+ ;; Ok, we're done parsing the required parts, what comes now is one of
+ ;; three things:
;;
;; envelope (then we're parsing body-type-msg)
;; body-fld-lines (then we're parsing body-type-text)
;; body-ext-1part (then we're parsing body-type-basic)
;;
- ;; the problem is that the two first are in turn optionally followed
+ ;; The problem is that the two first are in turn optionally followed
;; by the third. So we parse the first two here (if there are any)...
(when (eq (char-after) ?\ )
(imap-forward)
(let (lines)
- (cond ((eq (char-after) ?\();; body-type-msg:
- (push (imap-parse-envelope) body);; envelope
+ (cond ((eq (char-after) ?\() ;; body-type-msg:
+ (push (imap-parse-envelope) body) ;; envelope
(imap-forward)
- (push (imap-parse-body) body);; body
+ (push (imap-parse-body) body) ;; body
;; buggy stalker communigate pro 3.0 doesn't print
;; number of lines in message/rfc822 attachment
(if (eq (char-after) ?\))
(push 0 body)
(imap-forward)
(push (imap-parse-number) body))) ;; body-fld-lines
- ((setq lines (imap-parse-number)) ;; body-type-text:
- (push lines body)) ;; body-fld-lines
+ ((setq lines (imap-parse-number)) ;; body-type-text:
+ (push lines body)) ;; body-fld-lines
(t
- (backward-char))))) ;; no match...
+ (backward-char))))) ;; no match...
;; ...and then parse the third one here...
- (when (eq (char-after) ?\ );; body-ext-1part:
+ (when (eq (char-after) ?\ ) ;; body-ext-1part:
(imap-forward)
- (push (imap-parse-nstring) body);; body-fld-md5
- (setq body (append (imap-parse-body-ext) body)));; body-ext-1part..
-
- (assert (eq (char-after) ?\)))
+ (push (imap-parse-nstring) body) ;; body-fld-md5
+ (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
+
+ (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))
- (mapcar (lambda (f) (trace-function-background f imap-debug))
- '(
- imap-read-passwd
- 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
- )))
-
+ (buffer-disable-undo (get-buffer-create imap-debug-buffer))
+ (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-ping-server
+ 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-fetch-safe
+ 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)
;;; imap.el ends here