;;; imap.el --- imap library
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002
+;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
;;
;; 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.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.
+;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
+;; LOGINDISABLED) (with use of external library starttls.el and
+;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731
+;; (with use of external program `imtest'). It also take advantage
+;; the UNSELECT extension in Cyrus IMAPD.
;;
;; Without the work of John McClary Prevost and Jim Radford this library
;; would not have seen the light of day. Many thanks.
;; => "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.
;; o Don't use `read' at all (important places already fixed)
;; o Accept list of articles instead of message set string in most
(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")
+ ;; Avoid use gnus-point-at-eol so we're independent of Gnus. These
+ ;; days we have point-at-eol anyhow.
+ (if (fboundp 'point-at-eol)
+ (defalias 'imap-point-at-eol 'point-at-eol)
+ (defun imap-point-at-eol ()
+ (save-excursion
+ (end-of-line)
+ (point)))))
;; User variables.
-(defvar imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
- "imtest -kp %s %p")
+(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"
+ "imtest -kp %s %p")
"List of strings containing commands for Kerberos 4 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
-IMAP commands on stdin and return responses to stdout.")
+IMAP commands on stdin and return responses to stdout. Each entry in
+the list is tried until a successful connection is made."
+ :group 'imap
+ :type '(repeat string))
-(defvar imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
+(defcustom imap-gssapi-program '("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
-IMAP commands on stdin and return responses to stdout.")
-
-(defvar 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")
+IMAP commands on stdin and return responses to stdout. Each entry in
+the list is tried until a successful connection is made."
+ :group 'imap
+ :type '(repeat string))
+
+(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
-stdin and return responses to stdout.")
-
-(defvar imap-default-user (user-login-name)
- "Default username to use.")
-
-(defvar imap-error nil
- "Error codes from the last command.")
+stdin and return responses to stdout. Each entry in the list is tried
+until a successful connection is made."
+ :group 'imap
+ :type '(choice string
+ (repeat string)))
+
+(defcustom imap-shell-program '("ssh %s imapd"
+ "rsh %s imapd"
+ "ssh %g ssh %s imapd"
+ "rsh %g rsh %s imapd")
+ "A list of strings, containing commands for IMAP connection.
+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
+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 and GSSAPI."
+ :group 'imap
+ :type 'boolean)
+
+(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)
+
+(defcustom imap-log nil
+ "If non-nil, a imap session trace is placed in *imap-log* buffer."
+ :group 'imap
+ :type 'boolean)
+
+(defcustom imap-debug nil
+ "If non-nil, random debug spews are placed in *imap-debug* buffer."
+ :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)
;; Various variables.
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
-(defvar imap-streams '(gssapi kerberos4 starttls ssl network)
+(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
"Priority of streams to consider when opening connection to server.")
(defvar imap-stream-alist
(kerberos4 imap-kerberos4-stream-p imap-kerberos4-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
anonymous)
"Priority of authenticators to consider when authenticating to server.")
-(defvar imap-authenticator-alist
- '((gssapi imap-gssapi-auth-p imap-gssapia-auth)
+(defvar imap-authenticator-alist
+ '((gssapi imap-gssapi-auth-p imap-gssapi-auth)
(kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth)
(cram-md5 imap-cram-md5-p imap-cram-md5-auth)
(login imap-login-p imap-login-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.")
;; Internal constants. Change theese and die.
imap-failed-tags
imap-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-state 'closed
+(defvar imap-calculate-literal-size-first nil)
+(defvar imap-state 'closed
"IMAP state.
Valid states are `closed', `initial', `nonauth', `auth', `selected'
and `examine'.")
(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
"Non-nil indicates that the server emitted a continuation request.
The actually value is really the text on the continuation line.")
-(defvar imap-log nil
- "Imap session trace.")
-
-(defvar imap-debug nil ;"*imap-debug*"
- "Random debug spew.")
+(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.")
\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
+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)))
+
(defsubst imap-disable-multibyte ()
"Enable multibyte in the current buffer."
(when (fboundp 'set-buffer-multibyte)
(and string
(condition-case ()
(utf7-encode string t)
- (error (message
+ (error (message
"imap: Could not UTF7 encode `%s', using it unencoded..."
string)
string)))
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
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
+ ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
(or (while (looking-at "^C:")
(forward-line))
t)
(accept-process-output process 1)
(sit-for 1))
(and imap-log
- (with-current-buffer (get-buffer-create 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 "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-send-command "LOGOUT"))
(delete-process process)
nil)))))
done))
-
+
(defun imap-gssapi-stream-p (buffer)
(imap-capability 'AUTH=GSSAPI 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:")
+ (forward-line))
+ t)
;; cyrus 1.6 imtest print "S: " before server greeting
(or (not (looking-at "S: "))
(forward-char 3)
(accept-process-output process 1)
(sit-for 1))
(and imap-log
- (with-current-buffer (get-buffer-create imap-log)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(not (string-match "failed" response))))
(setq done process)
(if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
+ (imap-send-command "LOGOUT"))
(delete-process process)
nil)))))
done))
(let ((cmds (if (listp imap-ssl-program) imap-ssl-program
(list imap-ssl-program)))
cmd done)
+ (condition-case ()
+ (require 'ssl)
+ (error))
(while (and (not done) (setq cmd (pop cmds)))
(message "imap: Opening SSL connection with `%s'..." cmd)
(let* ((port (or port imap-default-ssl-port))
?s server
?p (number-to-string port)))))
process)
- (when (setq process (ignore-errors (open-ssl-stream
- name buffer server port)))
+ (when (setq process (condition-case ()
+ (open-ssl-stream name buffer server port)
+ (error)))
(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)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(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-network-p (buffer)
(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)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(imap-disable-multibyte)
(buffer-disable-undo)
(goto-char (point-max))
(when (memq (process-status process) '(open run))
process))))
+(defun imap-shell-p (buffer)
+ nil)
+
+(defun imap-shell-open (name buffer server port)
+ (let ((cmds imap-shell-program)
+ cmd done)
+ (while (and (not done) (setq cmd (pop cmds)))
+ (message "imap: Opening IMAP connection with `%s'..." cmd)
+ (setq imap-client-eol "\n")
+ (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
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?s server
+ ?g imap-shell-host
+ ?p (number-to-string port)
+ ?l imap-default-user)))))
+ (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-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring buffer)))
+ (erase-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: 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)
+ (message "imap: Connecting with STARTTLS...")
(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)
+ (with-current-buffer (get-buffer-create imap-log-buffer)
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
(starttls-negotiate imap-process)))
(set-process-filter imap-process nil)))
(when (memq (process-status process) '(open run))
- process))))
-
+ (setq done process)))
+ (if done
+ (progn
+ (message "imap: Connecting with STARTTLS...done")
+ done)
+ (message "imap: Connecting with STARTTLS...failed")
+ nil)))
+
;; Server functions; authenticator stuff:
(defun imap-interactive-login (buffer loginfunc)
it where sucessful 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 ": "))))
+ (concat "IMAP password for " user "@"
+ imap-server " (using authenticator `"
+ (symbol-name imap-auth) "'): "))))
(when (and user passwd)
(if (funcall loginfunc user passwd)
(progn
ret)))
(defun imap-gssapi-auth-p (buffer)
- (imap-capability 'AUTH=GSSAPI buffer))
+ (and (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-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 "\" \""
+ (imap-ok-p (imap-send-command-wait
+ (concat "LOGIN \"" user "\" \""
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)
- (and (condition-case ()
+ (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
+ (condition-case ()
(require 'digest-md5)
- (error nil))
- (imap-capability 'AUTH=DIGEST-MD5 buffer)))
+ (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)))
(with-current-buffer (get-buffer-create buffer)
(if (imap-opened buffer)
(imap-close buffer))
- (mapcar 'make-variable-buffer-local imap-local-variables)
+ (mapcar '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 (null imap-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*"))
+ (mapcar '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)
+ (kill-buffer buffer)
+ (rename-buffer 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)))
+ (when imap-stream
+ buffer))))
(defun imap-opened (&optional buffer)
"Return non-nil if connection to imap server in BUFFER is open.
specified, the user will not be questioned and the username and/or
password is remembered in the buffer."
(with-current-buffer (or buffer (current-buffer))
- (when (eq imap-state 'nonauth)
- (make-variable-buffer-local 'imap-username)
- (make-variable-buffer-local 'imap-password)
+ (if (not (eq imap-state 'nonauth))
+ (or (eq imap-state 'auth)
+ (eq imap-state 'select)
+ (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))
- (if (funcall (nth 2 (assq imap-auth imap-authenticator-alist)) buffer)
- (setq imap-state 'auth)))))
+ (if imap-auth
+ (and (funcall (nth 2 (assq imap-auth
+ imap-authenticator-alist)) 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)
+ (message "imap: Authenticating to `%s' using `%s'..."
+ imap-server auth)
+ (setq imap-auth auth)
+ (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
+ (progn
+ (message "imap: Authenticating to `%s' using `%s'...done"
+ imap-server auth)
+ &
projects / gnus / blobdiff