;;; imap.el --- imap library
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
(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.
(while (or (not user) (not passwd))
(setq user (or imap-username
(read-from-minibuffer
- (concat "IMAP username for " imap-server
+ (concat "imap: username for " imap-server
" (using stream `" (symbol-name imap-stream)
"'): ")
(or user imap-default-user))))
(setq passwd (or imap-password
(read-passwd
- (concat "IMAP password for " user "@"
+ (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)
(when (and (not imap-password)
(or imap-store-password
- (y-or-n-p "Store password for this session? ")))
+ (y-or-n-p "imap: Store password for this IMAP session? ")))
(setq imap-password passwd)))
- (message "Login failed...")
+ (message "imap: Login failed...")
(setq passwd nil)
(setq imap-password nil)
(sit-for 1))))
buffer
(buffer-name buffer))))
(kill-buffer buffer)
- (rename-buffer name))
+ (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 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))))
(eq imap-state 'examine))
(make-local-variable 'imap-username)
(make-local-variable 'imap-password)
- (if user (setq imap-username user))
- (if passwd (setq imap-password passwd))
+ (make-local-variable 'imap-last-authenticator)
+ (when user (setq imap-username user))
+ (when passwd (setq imap-password passwd))
(if imap-auth
- (and (funcall (nth 2 (assq imap-auth
- imap-authenticator-alist)) (current-buffer))
+ (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?
- (when (funcall (nth 1 (assq auth imap-authenticator-alist)) (current-buffer))
+ (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 (assq auth imap-authenticator-alist)) (current-buffer))
+ (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)))))
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
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'."
- ;; We don't unconditionally use the alternative (valid) form, since
- ;; this is said to be significantly inefficient. 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.
+ ;; 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
- (imap-fetch (if imap-enable-exchange-bug-workaround
- (cdr uids)
- (car uids))
- props receive nouidfetch buffer)
+ ;; 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)
- (string-match
- "The specified message set is invalid"
- (cadr data)))
+ ;; 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)
+ (set (make-local-variable 'imap-enable-exchange-bug-workaround)
t)
(imap-fetch (cdr uids) props receive nouidfetch))
(signal (car data) (cdr data))))))
(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"))))
(while (and (null imap-continuation)
(memq (process-status imap-process) '(open run))
(< imap-reached-tag tag))
- (let ((len (/ (point-max) 1024))
+ (let ((len (/ (buffer-size) 1024))
message-log-max)
(unless (< len 10)
(setq imap-have-messaged t)
imap-list-to-message-set
imap-fetch-asynch
imap-fetch
+ imap-fetch-safe
imap-message-put
imap-message-get
imap-message-map
projects / gnus / blobdiff