;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
-;; Author: Simon Josefsson <jas@pdc.kth.se>
+;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, 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
;; explanatory for someone that know IMAP. All functions have
;; additional documentation on how to invoke them.
;;
-;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented
+;; 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'), RFC2971 (ID). It also
+;; 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.
;;
;; 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.
;; - 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
+ ;; 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")
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))
(defcustom imap-process-connection-type nil
"*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
-The `process-connection-type' variable control type of device
+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 a IMAP server is
-opened, changing it after that has no effect."
+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)
:type 'boolean)
(defcustom imap-log nil
- "If non-nil, a imap session trace is placed in *imap-log* buffer.
+ "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 *imap-log*
-buffer. It is not written to disk, however. Do not enable this
-variable unless you are comfortable with that."
+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, random debug spews are placed in *imap-debug* buffer.
+ "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 *imap-debug*
-buffer. It is not written to disk, however. Do not enable this
-variable unless you are comfortable with that."
+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)
:type 'string)
(defcustom imap-read-timeout (if (string-match
- "windows-nt\\|os/2\\|emx\\|cygwin"
+ "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
1.0
0.1)
:group 'imap)
(defcustom imap-store-password nil
- "If non-nil, store session password without promting."
+ "If non-nil, store session password without prompting."
:group 'imap
:type 'boolean)
(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
"IMAP state.
"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.")
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-enable-exchange-bug-workaround nil
+ "Send FETCH UID commands as *:* instead of *.
+
+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:
(defun imap-remassoc (key alist)
- "Delete by side effect any elements of LIST whose car is `equal' to KEY.
-The modified LIST is returned. If the first member
-of LIST has a car that is `equal' to KEY, there is no way to remove it
+ "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
(setcdr alist (imap-remassoc key (cdr alist)))
alist)))
-(defsubst imap-disable-multibyte ()
+(defmacro imap-disable-multibyte ()
"Enable multibyte in the current buffer."
- (when (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil)))
+ (unless (featurep 'xemacs)
+ '(set-buffer-multibyte nil)))
(defsubst imap-utf7-encode (string)
(if imap-use-utf7
\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))
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
(erase-buffer)
(message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
(if response (concat "done, " response) "failed"))
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (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))
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)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (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))))))
(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))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (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))))
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (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))))
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (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)))))
(not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(when (and (setq tls-info (starttls-negotiate process))
(memq (process-status process) '(open run)))
(setq done process)))
(while (or (not user) (not passwd))
(setq user (or imap-username
&nb
projects / gnus / blobdiff