;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; 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-when-compile (require 'cl))
(eval-and-compile
- (autoload 'base64-decode-string "base64")
- (autoload 'base64-encode-string "base64")
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
(autoload 'digest-md5-parse-digest-challenge "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 'open-tls-stream "tls"))
;; User variables.
:type 'number
:group 'imap)
+(defcustom imap-store-password nil
+ "If non-nil, store session password without promting."
+ :group 'imap
+ :type 'boolean)
+
;; Various variables.
(defvar imap-fetch-data-hook nil
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.")
(progn
(setq ret t
imap-username user)
- (if (and (not imap-password)
- (y-or-n-p "Store password for this session? "))
- (setq imap-password passwd)))
+ (when (and (not imap-password)
+ (or imap-store-password
+ (y-or-n-p "Store password for this session? ")))
+ (setq imap-password passwd)))
(message "Login failed...")
(setq passwd nil)
(setq imap-password 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))
(defun imap-parse-flag-list ()
(let (flag-list start)
- (assert (eq (char-after) ?\() t "In imap-parse-flag-list")
+ (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
(while (and (not (eq (char-after) ?\)))
(setq start (progn
(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")
+ (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
(imap-forward)
(nreverse flag-list)))
(while (eq (char-after) ?\ )
(imap-forward)
(push (imap-parse-body-extension) b-e))
- (assert (eq (char-after) ?\)) t "In imap-parse-body-extension")
+ (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
(imap-forward)
(nreverse b-e))
(or (imap-parse-number)
(push (and (imap-parse-nil) nil) body))
(setq body
(append (imap-parse-body-ext) body))) ;; body-ext-...
- (assert (eq (char-after) ?\)) t "In imap-parse-body")
+ (assert (eq (char-after) ?\)) nil "In imap-parse-body")
(imap-forward)
(nreverse body))
(push (imap-parse-nstring) body) ;; body-fld-md5
(setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
- (assert (eq (char-after) ?\)) t "In imap-parse-body 2")
+ (assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
(imap-forward)
(nreverse body)))))
projects / elisp / gnus.git- / blobdiff