* gnus.el (gnus-group-short-name, gnus-group-prefixed-p): new functions

[gnus] / lisp / imap.el

diff --git a/lisp/imap.el b/lisp/imap.el
index 37a913e..0492044 100644 (file)
--- a/lisp/imap.el
+++ b/lisp/imap.el
@@ -1,5 +1,5 @@
 ;;; 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>
@@ -152,6 +152,7 @@
   (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)
@@ -178,7 +179,12 @@ the list is tried until a successful connection is made."
   :group 'imap
   :type '(repeat string))
 
-(defcustom imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
+(defcustom imap-gssapi-program (list
+                               (concat "gsasl --client --connect %s:%p "
+                                       "--imap --application-data "
+                                       "--mechanism GSSAPI "
+                                       "--authentication-id %l")
+                               "imtest -m gssapi -u %l -p %p %s")
   "List of strings containing commands for GSSAPI (krb5) authentication.
 %s is replaced with server hostname, %p with port to connect to, and
 %l with the value of `imap-default-user'.  The program should accept
@@ -246,17 +252,28 @@ encoded mailboxes which doesn't translate into ISO-8859-1."
   :group 'imap
   :type 'string)
 
+(defcustom imap-read-timeout (if (string-match
+                                 "windows-nt\\|os/2\\|emx\\|cygwin"
+                                 (symbol-name system-type))
+                                1.0
+                              0.1)
+  "*How long to wait between checking for the end of output.
+Shorter values mean quicker response, but is more CPU intensive."
+  :type 'number
+  :group 'imap)
+
 ;; Various variables.
 
 (defvar imap-fetch-data-hook nil
   "Hooks called after receiving each FETCH response.")
 
-(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
+(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
   "Priority of streams to consider when opening connection to server.")
 
 (defvar imap-stream-alist
   '((gssapi    imap-gssapi-stream-p    imap-gssapi-open)
     (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
+    (tls       imap-tls-p              imap-tls-open)
     (ssl       imap-ssl-p              imap-ssl-open)
     (network   imap-network-p          imap-network-open)
     (shell     imap-shell-p            imap-shell-open)
@@ -299,6 +316,7 @@ for doing the actual authentication.")
 
 (defconst imap-default-port 143)
 (defconst imap-default-ssl-port 993)
+(defconst imap-default-tls-port 993)
 (defconst imap-default-stream 'network)
 (defconst imap-coding-system-for-read 'binary)
 (defconst imap-coding-system-for-write 'binary)
@@ -416,22 +434,6 @@ sure of changing the value of `foo'."
   (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
@@ -561,7 +563,7 @@ If ARGS, PROMPT is used as an argument to `format'."
                        (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                        (goto-char (point-min))
                        ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
-                       (or (while (looking-at "^C:")
+                       (or (while (looking-at "^C:")
                              (forward-line))
                            t)
                        ;; cyrus 1.6 imtest print "S: " before server greeting
@@ -571,7 +573,10 @@ If ARGS, PROMPT is used as an argument to `format'."
                        (not (and (imap-parse-greeting)
                                  ;; success in imtest 1.6:
                                  (re-search-forward
-                                  "^\\(Authenticat.*\\)" nil t)
+                                  (concat "^\\(\\(Authenticat.*\\)\\|\\("
+                                          "Client authentication "
+                                          "finished.*\\)\\)")
+                                  nil t)
                                  (setq response (match-string 1)))))
              (accept-process-output process 1)
              (sit-for 1))
@@ -642,6 +647,31 @@ If ARGS, PROMPT is used as an argument to `format'."
       (message "imap: Opening SSL connection with `%s'...failed" cmd)
       nil)))
 
+(defun imap-tls-p (buffer)
+  nil)
+
+(defun imap-tls-open (name buffer server port)
+  (let* ((port (or port imap-default-tls-port))
+        (coding-system-for-read imap-coding-system-for-read)
+        (coding-system-for-write imap-coding-system-for-write)
+        (process (open-tls-stream name buffer server port)))
+    (when process
+      (while (and (memq (process-status process) '(open run))
+                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+                 (goto-char (point-max))
+                 (forward-line -1)
+           &nbs