;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
(eval-when-compile (require 'cl))
(eval-and-compile
- (autoload 'open-ssl-stream "ssl")
(autoload 'base64-decode-string "base64")
(autoload 'base64-encode-string "base64")
(autoload 'starttls-open-stream "starttls")
(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)'.
(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)))
-
(defsubst imap-utf7-encode (string)
(if imap-use-utf7
(and string
(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))
(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))
(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 nil)
process)
- (when (setq process (condition-case ()
- (open-ssl-stream name buffer server port)
- (error)))
+ (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)))))
+ (process-kill-without-query process)
+ process)
(with-current-buffer buffer
(goto-char (point-min))
(while (and (memq (process-status process) '(open run))
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)
(when process
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
+ (goto-char (point-max))
+ (forward-line -1)
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
(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-local-variable 'imap-username)
(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
- (imap-read-passwd
+ (read-passwd
(concat "IMAP password for " user "@"
imap-server " (using authenticator `"
(symbol-name imap-auth) "'): "))))
(defun imap-gssapi-auth-p (buffer)
(and (imap-capability 'AUTH=GSSAPI buffer)
- (eq imap-state 'gssapi)))
+ (eq imap-stream 'gssapi)))
(defun imap-gssapi-auth (buffer)
(message "imap: Authenticating using GSSAPI...%s"
(defun imap-kerberos4-auth-p (buffer)
(and (imap-capability 'AUTH=KERBEROS_V4 buffer)
- (eq imap-state 'kerberos4)))
+ (eq imap-stream 'kerberos4)))
(defun imap-kerberos4-auth (buffer)
(message "imap: Authenticating using Kerberos 4...%s"
t)
(defun imap-anonymous-auth (buffer)
- (message "imap: Loging in anonymously...")
+ (message "imap: Logging in anonymously...")
(with-current-buffer buffer
(imap-ok-p (imap-send-command-wait
(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
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)
(when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
;; Stream changed?
(if (not (eq imap-default-stream stream))
- (with-temp-buffer
+ (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 imap-server)
- (setq imap-port imap-port)
- (setq imap-auth imap-auth)
+ (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))))
- (message "imap: Reconnecting with stream `%s'...failed"
- stream)
+ (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"
- imap-stream)
+ stream)
(setq imap-stream stream)
(setq imap-capability nil)
(setq streams nil)))
(setq streams nil))))))
(when (imap-opened buffer)
(setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
- (when imap-stream
+ (when imap-stream
buffer))))
(defun imap-opened (&optional buffer)
(if user (setq imap-username user))
(if passwd (setq imap-password passwd))
(if imap-auth
- (and (funcall (nth 2 (assq imap-auth
+ (and (funcall (nth 2 (assq imap-auth
imap-authenticator-alist)) buffer)
(setq imap-state 'auth))
;; Choose authenticator.
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."
+returned, if ITEMS is a symbol only its value is returned."
(with-current-buffer (or buffer (current-buffer))
(when (imap-ok-p
(imap-send-command-wait (list "STATUS \""
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 -- ie '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)
+ "\" "
+ (format "%s"
+ (if (listp items)
+ items
+ (list items)))))))
+
(defun imap-mailbox-acl-get (&optional mailbox buffer)
"Get ACL on mailbox from server in BUFFER."
(let ((mailbox (imap-utf7-encode mailbox)))
;; 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 "("
;; [flag-perm *(SP flag-perm)] ")" /
;; "READ-ONLY" /
;; "READ-WRITE" /
-;; "TRYCREATE" /
+;; "TRYCREATE" /
;; "UIDNEXT" SP nz-number /
;; "UIDVALIDITY" SP nz-number /
;; "UNSEEN" SP nz-number /
(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)
(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 (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))))))))
+ token mailbox)
+ (read (current-buffer)))))))))
;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
;; rights)
(buffer-disable-undo (get-buffer-create imap-debug-buffer))
(mapcar (lambda (f) (trace-function-background f imap-debug-buffer))
'(
- imap-read-passwd
imap-utf7-encode
imap-utf7-decode
imap-error-text
projects / gnus / blobdiff