;;; imap.el --- imap library
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; 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:
(eval-when-compile (require 'cl))
(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
(autoload 'sasl-find-mechanism "sasl")
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 *.
+Enabling this appears to be required for some servers (e.g.,
+Microsoft Exchange) which otherwise would trigger a response 'BAD
+The specified message set is invalid.'.")
+
\f
;; Utility functions:
(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.
If BUFFER is nil then the current buffer is used."
(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.
(if passwd (setq imap-password passwd))
(if imap-auth
(and (funcall (nth 2 (assq imap-auth
- imap-authenticator-alist)) buffer)
+ imap-authenticator-alist)) (current-buffer))
(setq imap-state 'auth))
;; Choose authenticator.
(let ((auths imap-authenticators)
auth)
(while (setq auth (pop auths))
;; OK to use authenticator?
- (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
+ (when (funcall (nth 1 (assq auth imap-authenticator-alist)) (current-buffer))
(message "imap: Authenticating to `%s' using `%s'..."
imap-server auth)
(setq imap-auth auth)
- (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
+ (if (funcall (nth 2 (assq auth imap-authenticator-alist)) (current-buffer))
(progn
(message "imap: Authenticating to `%s' using `%s'...done"
imap-server auth)
(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-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
+ (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch "*" "UID")
+ (and (imap-fetch
+ (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
imap-open-1
imap-open
imap-opened
+ imap-ping-server
imap-authenticate
imap-close
imap-capability
(provide 'imap)
-;;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7
+;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7
;;; imap.el ends here
projects / gnus / blobdiff