* imap.el: Support for ID IMAP extension (RFC 2971).

(imap-local-variables): Add imap-id.
(imap-id): New variable.
(imap-id): New function.
(imap-parse-response): Parse untagged ID response.
* nnimap.el (nnimap-id): New variable.
(nnimap-open-connection): Use it.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0a82c4a..917a25d 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2003-11-09  Simon Josefsson  <jas@extundo.com>
+
+       * imap.el: Support for ID IMAP extension (RFC 2971).
+       (imap-local-variables): Add imap-id.
+       (imap-id): New variable.
+       (imap-id): New function.
+       (imap-parse-response): Parse untagged ID response.
+       * nnimap.el (nnimap-id): New variable.
+       (nnimap-open-connection): Use it.
+
 2003-12-28  Simon Josefsson  <jas@extundo.com>
 
        * gnus-score.el (gnus-score-edit-all-score): New.

diff --git a/lisp/imap.el b/lisp/imap.el
index 3ff0ffb..485c903 100644 (file)
--- a/lisp/imap.el
+++ b/lisp/imap.el
@@ -73,13 +73,13 @@
 ;; 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.
@@ -339,6 +339,7 @@ for doing the actual authentication.")
                                 imap-current-target-mailbox
                                 imap-message-data
                                 imap-capability
+                                imap-id
                                 imap-namespace
                                 imap-state
                                 imap-reached-tag
@@ -394,6 +395,10 @@ and `examine'.")
 (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.")
 
@@ -1108,6 +1113,26 @@ If BUFFER is nil, the current buffer is assumed."
        (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."
@@ -2071,6 +2096,8 @@ Return nil if no complete line has arrived."
                               (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))

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index cf33d13..1e170d8 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -402,6 +402,43 @@ just like \"ticked\" articles, in other IMAP clients.")
 If this is 'imap-mailbox-lsub, then use a server-side subscription list to
 restrict visible folders.")
 
+(defcustom nnimap-id nil
+  "Plist with client identity to send to server upon login.
+Nil means no information is sent, symbol `no' to disable ID query
+alltogheter, or plist with identifier-value pairs to send to
+server.  RFC 2971 describes the list as follows:
+
+   Any string may be sent as a field, but the following are defined to
+   describe certain values that might be sent.  Implementations are free
+   to send none, any, or all of these.  Strings are not case-sensitive.
+   Field strings MUST NOT be longer than 30 octets.  Value strings MUST
+   NOT be longer than 1024 octets.  Implementations MUST NOT send more
+   than 30 field-value pairs.
+
+     name            Name of the program
+     version         Version number of the program
+     os              Name of the operating system
+     os-version      Version of the operating system
+     vendor          Vendor of the client/server
+     support-url     URL to contact for support
+     address         Postal address of contact/vendor
+     date            Date program was released, specified as a date-time
+                       in IMAP4rev1
+     command         Command used to start the program
+     arguments       Arguments supplied on the command line, if any
+                       if any
+     environment     Description of environment, i.e., UNIX environment
+                       variables or Windows registry settings
+
+   Implementations MUST NOT send the same field name more than once.
+
+An example plist would be '(\"name\" \"Gnus\" \"version\" gnus-version-number
+\"os\" system-configuration \"vendor\" \"GNU\")."
+  :group 'nnimap
+  :type '(choice (const :tag "No information" nil)
+                (const :tag "Disable ID query" no)
+                (plist :key-type string :value-type string)))
+
 (defcustom nnimap-debug nil
   "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
   :group 'nnimap
@@ -731,6 +768,7 @@ If EXAMINE is non-nil the group is selected read-only."
          (prog1
              (push (list server nnimap-server-buffer)
                    nnimap-server-buffer-alist)
+           (imap-id nnimap-id nnimap-server-buffer)
            (nnimap-possibly-change-server server))
        (imap-close nnimap-server-buffer)
        (kill-buffer nnimap-server-buffer)