;; 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.
(eval-and-compile
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
+ (autoload 'digest-md5-parse-digest-challenge "digest-md5")
+ (autoload 'digest-md5-digest-response "digest-md5")
+ (autoload 'digest-md5-digest-uri "digest-md5")
+ (autoload 'digest-md5-challenge "digest-md5")
(autoload 'rfc2104-hash "rfc2104")
(autoload 'md5 "md5")
(autoload 'utf7-encode "utf7")
(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 'sasl-digest-md5-digest-response "sasl"))
+ (autoload 'open-tls-stream "tls"))
;; User variables.
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.")
(list
"AUTHENTICATE DIGEST-MD5"
(lambda (challenge)
- (base64-encode-string
- (sasl-digest-md5-digest-response
- (base64-decode-string challenge)
- user passwd "imap" imap-server)
- 'no-line-break))))))
+ (digest-md5-parse-digest-challenge
+ (base64-decode-string challenge))
+ (let* ((digest-uri
+ (digest-md5-digest-uri
+ "imap" (digest-md5-challenge 'realm)))
+ (response
+ (digest-md5-digest-response
+ user passwd digest-uri)))
+ (base64-encode-string response 'no-line-break))))
+ )))
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
nil
(setq imap-continuation nil)
(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."
(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)