;; explanatory for someone that know IMAP. All functions have
;; additional documentation on how to invoke them.
;;
-;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
-;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
+;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), 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'). It also take advantage
-;; the UNSELECT extension in Cyrus IMAPD.
+;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731
+;; (with use of external program `imtest'), RFC2971 (ID). 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.
;; 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.
+;; o Send strings as literal if they contain, e.g., ".
;;
;; Revision history:
;;
(autoload 'utf7-decode "utf7")
(autoload 'format-spec "format-spec")
(autoload 'format-spec-make "format-spec")
- (autoload 'open-tls-stream "tls")
- ;; 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)))))
+ (autoload 'open-tls-stream "tls"))
;; User variables.
:type '(repeat string))
(defcustom imap-process-connection-type nil
- "*Value for `process-connection-type' to use for Kerberos4 and GSSAPI."
+ "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
+The `process-connection-type' variable control 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.."
:group 'imap
:type 'boolean)
imap-current-target-mailbox
imap-message-data
imap-capability
+ imap-id
imap-namespace
imap-state
imap-reached-tag
(defvar imap-capability nil
"Capability for server.")
+(defvar imap-id nil
+ "Identity of server.
+See RFC 2971.")
+
(defvar imap-namespace nil
"Namespace for current server.")
(while (and (memq (process-status process) '(open run))
(set-buffer buffer) ;; XXX "blue moon" nntp.el bug
(goto-char (point-min))
+ ;; Athena IMTEST can output SSL verify errors
+ (or (while (looking-at "^verify error:num=")
+ (forward-line))
+ t)
+ (or (while (looking-at "^TLS connection established")
+ (forward-line))
+ t)
;; cyrus 1.6.x (13? < x <= 22) queries capabilities
(or (while (looking-at "^C:")
(forward-line))
(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))
- done)
+ done tls-info)
(message "imap: Connecting with STARTTLS...")
(when process
(while (and (memq (process-status process) '(open run))
(buffer-disable-undo)
(goto-char (point-max))
(insert-buffer-substring buffer)))
- (message "imap: STARTTLS info: %s" (starttls-negotiate process))
- (when (memq (process-status process) '(open run))
+ (when (and (setq tls-info (starttls-negotiate process))
+ (memq (process-status process) '(open run)))
(setq done process)))
+ (if (stringp tls-info)
+ (message "imap: STARTTLS info: %s" tls-info))
(message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
done))
(setq imap-password passwd)))
(message "Login failed...")
(setq passwd nil)
+ (setq imap-password nil)
(sit-for 1))))
;; (quit (with-current-buffer buffer
;; (setq user nil
ret)))
(defun imap-gssapi-auth-p (buffer)
- (and (imap-capability 'AUTH=GSSAPI buffer)
- (eq imap-stream 'gssapi)))
+ (eq imap-stream 'gssapi))
(defun imap-gssapi-auth (buffer)
(message "imap: Authenticating using GSSAPI...%s"
(memq (intern (upcase (symbol-name identifier))) imap-capability)
imap-capability)))
+(defun imap-id (&optional list-of-values buffer)
+ "Identify client to server in BUFFER, and return server identity.
+LIST-OF-VALUES is `nil', or a plist with identifier and value
+strings to send to the server to identify the client.
+
+Return a list of identifiers which server in BUFFER support, or
+nil if it doesn't support ID or returns no information.
+
+If BUFFER is nil, the current buffer is assumed."
+ (with-current-buffer (or buffer (current-buffer))
+ (when (and (imap-capability 'ID)
+ (imap-ok-p (imap-send-command-wait
+ (if (null list-of-values)
+ "ID NIL"
+ (concat "ID (" (mapconcat (lambda (el)
+ (concat "\"" el "\""))
+ list-of-values
+ " ") ")")))))
+ imap-id)))
+
(defun imap-namespace (&optional buffer)
"Return a namespace hierarchy at server in BUFFER.
If BUFFER is nil, the current buffer is assumed."
(imap-send-command-wait (list "STATUS \""
(imap-utf7-encode mailbox)
"\" "
- (format "%s"
- (if (listp items)
- items
- (list items))))))
+ (upcase
+ (format "%s"
+ (if (listp items)
+ items
+ (list items)))))))
(if (listp items)
(mapcar (lambda (item)
(imap-mailbox-get item mailbox))
(read (concat "(" (upcase (buffer-substring
(point) (point-max)))
")"))))
+ (ID (setq imap-id (read (buffer-substring (point)
+ (point-max)))))
(ACL (imap-parse-acl))
(t (case (prog1 (read (current-buffer))
(imap-forward))
;; next line for Courier IMAP bug.
(skip-chars-forward " ")
(point)))
- (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
+ (> (skip-chars-forward "^ )" (point-at-eol)) 0))
(push (buffer-substring start (point)) flag-list))
(assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
(imap-forward)
projects / gnus / blobdiff