projects / elisp / gnus.git- / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
* nnshimbun.el (nnshimbun-request-expire-articles): Prefer the group parameter
[elisp/gnus.git-] / lisp / imap.el
diff --git a/lisp/imap.el b/lisp/imap.el
index 7460431..3e4d91e 100644 (file)
--- a/lisp/imap.el
+++ b/lisp/imap.el
@@ -1,5 +1,6 @@
 ;;; imap.el --- imap library
 ;;; imap.el --- imap library
-;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <jas@pdc.kth.se>
 ;; Keywords: mail
 
 ;; Author: Simon Josefsson <jas@pdc.kth.se>
 ;; Keywords: mail
@@ -74,7 +75,9 @@
 ;;
 ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
 ;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
 ;;
 ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
 ;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
-;; (NAMESPACE), RFC2359 (UIDPLUS), and the kerberos V4 part of RFC1731
+;; (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.
 ;;
 ;; (with use of external program `imtest').  It also take advantage
 ;; the UNSELECT extension in Cyrus IMAPD.
 ;;
@@ -122,7 +125,6 @@
 ;; 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 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 Cyrus IMAPd 1.6.x `imtest' support in the imtest wrapper
 ;;
 ;; Revision history:
 ;;
 ;;
 ;; Revision history:
 ;;
@@ -135,39 +137,84 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
 ;;; Code:
 
 (eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
+
+(require 'base64)
+
 (eval-and-compile
   (autoload 'open-ssl-stream "ssl")
 (eval-and-compile
   (autoload 'open-ssl-stream "ssl")
-  (autoload 'base64-decode-string "base64")
-  (autoload 'base64-encode-string "base64")
   (autoload 'starttls-open-stream "starttls")
   (autoload 'starttls-negotiate "starttls")
   (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 '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 'format-spec-make "format-spec")
+  ;; 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"))
 
 ;; User variables.
 
 
 ;; User variables.
 
-(defvar imap-imtest-program "imtest -kp %s %p"
-  "How to call program for Kerberos 4 authentication.
-%s is replaced with server and %p with port to connect to.  The
-program should accept IMAP commands on stdin and return responses to
-stdout.")
-
-(defvar imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p"
-                          "openssl s_client -ssl2 -connect %s:%p"
-                          "s_client -ssl3 -connect %s:%p"
-                          "s_client -ssl2 -connect %s:%p")
+(defgroup imap nil
+  "Low-level IMAP issues."
+  :version "21.1"
+  :group 'mail)
+
+(defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
+                                   "imtest -kp %s %p")
+  "List of strings containing commands for Kerberos 4 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
+IMAP commands on stdin and return responses to stdout.  Each entry in
+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")
+  "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
+IMAP commands on stdin and return responses to stdout.  Each entry in
+the list is tried until a successful connection is made."
+  :group 'imap
+  :type '(repeat string))
+
+(defcustom imap-ssl-program '("openssl s_client -ssl3 -connect %s:%p"
+                             "openssl s_client -ssl2 -connect %s:%p"
+                             "s_client -ssl3 -connect %s:%p"
+                             "s_client -ssl2 -connect %s:%p")
   "A string, or list of strings, containing commands for SSL connections.
 Within a string, %s is replaced with the server address and %p with
 port number on server.  The program should accept IMAP commands on
   "A string, or list of strings, containing commands for SSL connections.
 Within a string, %s is replaced with the server address and %p with
 port number on server.  The program should accept IMAP commands on
-stdin and return responses to stdout.")
+stdin and return responses to stdout.  Each entry in the list is tried
+until a successful connection is made."
+  :group 'imap
+  :type '(choice string
+                (repeat string)))
+
+(defcustom imap-shell-program '("ssh %s imapd"
+                               "rsh %s imapd"
+                               "ssh %g ssh %s imapd"
+                               "rsh %g rsh %s imapd")
+  "A list of strings, containing commands for IMAP connection.
+Within a string, %s is replaced with the server address, %p with port
+number on server, %g with `imap-shell-host', and %l with
+`imap-default-user'.  The program should read IMAP commands from stdin
+and write IMAP response to stdout. Each entry in the list is tried
+until a successful connection is made."
+  :group 'imap
+  :type '(repeat string))
+
+(defvar imap-shell-host "gateway"
+  "Hostname of rlogin proxy.")
 
 (defvar imap-default-user (user-login-name)
   "Default username to use.")
 
 (defvar imap-default-user (user-login-name)
   "Default username to use.")
@@ -180,34 +227,42 @@ stdin and return responses to stdout.")
 (defvar imap-fetch-data-hook nil
   "Hooks called after receiving each FETCH response.")
 
 (defvar imap-fetch-data-hook nil
   "Hooks called after receiving each FETCH response.")
 
-(defvar imap-streams '(kerberos4 starttls ssl network)
+(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
   "Priority of streams to consider when opening connection to server.")
 
 (defvar imap-stream-alist
   "Priority of streams to consider when opening connection to server.")
 
 (defvar imap-stream-alist
-  '((kerberos4 imap-kerberos4s-p imap-kerberos4-open)
-    (ssl       imap-ssl-p        imap-ssl-open)
-    (network   imap-network-p    imap-network-open)
-    (starttls  imap-starttls-p   imap-starttls-open))
+  '((gssapi    imap-gssapi-stream-p    imap-gssapi-open)
+    (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
+    (ssl       imap-ssl-p              imap-ssl-open)
+    (network   imap-network-p          imap-network-open)
+    (shell     imap-shell-p            imap-shell-open)
+    (starttls  imap-starttls-p         imap-starttls-open))
   "Definition of network streams.
 
   "Definition of network streams.
 
-(NAME CHECK OPEN)
+\(NAME CHECK OPEN)
 
 NAME names the stream, CHECK is a function returning non-nil if the
 server support the stream and OPEN is a function for opening the
 stream.")
 
 
 NAME names the stream, CHECK is a function returning non-nil if the
 server support the stream and OPEN is a function for opening the
 stream.")
 
-(defvar imap-authenticators '(kerberos4 digest-md5 cram-md5 login anonymous)
+(defvar imap-authenticators '(gssapi 
+                             kerberos4
+                             digest-md5
+                             cram-md5
+                             login
+                             anonymous)
   "Priority of authenticators to consider when authenticating to server.")
 
 (defvar imap-authenticator-alist 
   "Priority of authenticators to consider when authenticating to server.")
 
 (defvar imap-authenticator-alist 
-  '((kerberos4  imap-kerberos4a-p imap-kerberos4-auth)
-    (cram-md5   imap-cram-md5-p   imap-cram-md5-auth)
-    (login      imap-login-p      imap-login-auth)
-    (anonymous  imap-anonymous-p  imap-anonymous-auth)
-    (digest-md5 imap-digest-md5-p imap-digest-md5-auth))
+  '((gssapi     imap-gssapi-auth-p    imap-gssapi-auth)
+    (kerberos4  imap-kerberos4-auth-p imap-kerberos4-auth)
+    (cram-md5   imap-cram-md5-p       imap-cram-md5-auth)
+    (login      imap-login-p          imap-login-auth)
+    (anonymous  imap-anonymous-p      imap-anonymous-auth)
+    (digest-md5 imap-digest-md5-p     imap-digest-md5-auth))
   "Definition of authenticators.
 
   "Definition of authenticators.
 
-(NAME CHECK AUTHENTICATE)
+\(NAME CHECK AUTHENTICATE)
 
 NAME names the authenticator.  CHECK is a function returning non-nil if
 the server support the authenticator and AUTHENTICATE is a function
 
 NAME names the authenticator.  CHECK is a function returning non-nil if
 the server support the authenticator and AUTHENTICATE is a function
@@ -224,8 +279,6 @@ encoded mailboxes which doesn't translate into ISO-8859-1.")
 (defconst imap-default-port 143)
 (defconst imap-default-ssl-port 993)
 (defconst imap-default-stream 'network)
 (defconst imap-default-port 143)
 (defconst imap-default-ssl-port 993)
 (defconst imap-default-stream 'network)
-(defconst imap-coding-system-for-read 'binary)
-(defconst imap-coding-system-for-write 'binary)
 (defconst imap-local-variables '(imap-server
                                 imap-port
                                 imap-client-eol
 (defconst imap-local-variables '(imap-server
                                 imap-port
                                 imap-client-eol
@@ -244,6 +297,7 @@ encoded mailboxes which doesn't translate into ISO-8859-1.")
                                 imap-failed-tags
                                 imap-tag
                                 imap-process
                                 imap-failed-tags
                                 imap-tag
                                 imap-process
+                                imap-calculate-literal-size-first
                                 imap-mailbox-data))
 
 ;; Internal variables.
                                 imap-mailbox-data))
 
 ;; Internal variables.
@@ -254,6 +308,7 @@ encoded mailboxes which doesn't translate into ISO-8859-1.")
 (defvar imap-port nil)
 (defvar imap-username nil)
 (defvar imap-password nil)
 (defvar imap-port nil)
 (defvar imap-username nil)
 (defvar imap-password nil)
+(defvar imap-calculate-literal-size-first nil)
 (defvar imap-state 'closed 
   "IMAP state.
 Valid states are `closed', `initial', `nonauth', `auth', `selected'
 (defvar imap-state 'closed 
   "IMAP state.
 Valid states are `closed', `initial', `nonauth', `auth', `selected'
@@ -312,19 +367,16 @@ human readable response text (a string).")
 The actually value is really the text on the continuation line.")
 
 (defvar imap-log nil
 The actually value is really the text on the continuation line.")
 
 (defvar imap-log nil
-  "Imap session trace.")
+  "Name of buffer for imap session trace.
+For example: (setq imap-log \"*imap-log*\")")
 
 (defvar imap-debug nil                 ;"*imap-debug*"
 
 (defvar imap-debug nil                 ;"*imap-debug*"
-  "Random debug spew.")
+  "Name of buffer for random debug spew.
+For example: (setq imap-debug \"*imap-debug*\")")
 
 \f
 ;; Utility functions:
 
 
 \f
 ;; Utility functions:
 
-(defsubst imap-disable-multibyte ()
-  "Enable multibyte in the current buffer."
-  (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'."
 (defun imap-read-passwd (prompt &rest args)
   "Read a password using PROMPT.
 If ARGS, PROMPT is used as an argument to `format'."
@@ -376,46 +428,125 @@ If ARGS, PROMPT is used as an argument to `format'."
 \f
 ;; Server functions; stream stuff:
 
 \f
 ;; Server functions; stream stuff:
 
-(defun imap-kerberos4s-p (buffer)
+(defun imap-kerberos4-stream-p (buffer)
   (imap-capability 'AUTH=KERBEROS_V4 buffer))
 
 (defun imap-kerberos4-open (name buffer server port)
   (imap-capability 'AUTH=KERBEROS_V4 buffer))
 
 (defun imap-kerberos4-open (name buffer server port)
-  (message "Opening Kerberized IMAP connection...")
-  (let* ((port (or port imap-default-port))
-        (coding-system-for-read imap-coding-system-for-read)
-        (coding-system-for-write imap-coding-system-for-write)
-        (process (start-process 
-                  name buffer shell-file-name shell-command-switch
-                  (format-spec
-                   imap-imtest-program
-                   (format-spec-make ?s server ?p (number-to-string port))))))
-    (when process
-      (with-current-buffer buffer
-       (setq imap-client-eol "\n")
-       ;; Result of authentication is a string: __Full privacy protection__
-       (while (and (memq (process-status process) '(open run))
-                   (goto-char (point-min))
-                   (not (and (imap-parse-greeting)
-                             (re-search-forward "__\\(.*\\)__\n" nil t))))
-         (accept-process-output process 1)
-         (sit-for 1))
-       (and imap-log
-            (with-current-buffer (get-buffer-create imap-log)
-              (imap-disable-multibyte)
-              (buffer-disable-undo)
-              (goto-char (point-max))
-              (insert-buffer-substring buffer)))
-       (let ((response (match-string 1)))
-         (erase-buffer)
-         (message "Kerberized IMAP connection: %s" response)
-         (if (and response (let ((case-fold-search nil))
-                             (not (string-match "failed" response))))
-             process
-           (if (memq (process-status process) '(open run))
-               (imap-send-command-wait "LOGOUT"))
-           (delete-process process)
-           nil))))))
+  (let ((cmds imap-kerberos4-program)
+       cmd done)
+    (while (and (not done) (setq cmd (pop cmds)))
+      (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd)
+      (erase-buffer)
+      (let* ((port (or port imap-default-port))
+            (process (as-binary-process
+                      (start-process
+                       name buffer shell-file-name shell-command-switch
+                       (format-spec
+                        cmd
+                        (format-spec-make
+                         ?s server
+                         ?p (number-to-string port)
+                         ?l imap-default-user)))))
+            response)
+       (when process
+         (with-current-buffer buffer
+           (setq imap-client-eol "\n"
+                 imap-calculate-literal-size-first t)
+           (while (and (memq (process-status process) '(open run))
+                       (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:")
+                             (forward-line))
+                           t)
+                       ;; cyrus 1.6 imtest print "S: " before server greeting
+                       (or (not (looking-at "S: "))
+                           (forward-char 3)
+                           t)
+                       (not (and (imap-parse-greeting)
+                                 ;; success in imtest < 1.6:
+                                 (or (re-search-forward
+                                      "^__\\(.*\\)__\n" nil t)
+                                     ;; success in imtest 1.6:
+                                     (re-search-forward
+                                      "^\\(Authenticat.*\\)" nil t))
+                                 (setq response (match-string 1)))))
+             (accept-process-output process 1)
+             (sit-for 1))
+           (and imap-log
+                (with-current-buffer (get-buffer-create imap-log)
+                  (buffer-disable-undo)
+                  (goto-char (point-max))
+                  (insert-buffer-substring buffer)))
+           (erase-buffer)
+           (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
+                    (if response (concat "done, " response) "failed"))
+           (if (and response (let ((case-fold-search nil))
+                               (not (string-match "failed" response))))
+               (setq done process)
+             (if (memq (process-status process) '(open run))
+                 (imap-send-command-wait "LOGOUT"))
+             (delete-process process)
+             nil)))))
+    done))
   
   
+(defun imap-gssapi-stream-p (buffer)
+  (imap-capability 'AUTH=GSSAPI buffer))
+
+(defun imap-gssapi-open (name buffer server port)
+  (let ((cmds imap-gssapi-program)
+       cmd done)
+    (while (and (not done) (setq cmd (pop cmds)))
+      (message "Opening GSSAPI IMAP connection with `%s'..." cmd)
+      (let* ((port (or port imap-default-port))
+            (process (as-binary-process
+                      (start-process
+                       name buffer shell-file-name shell-command-switch
+                       (format-spec
+                        cmd
+                        (format-spec-make
+                         ?s server
+                         ?p (number-to-string port)
+                         ?l imap-default-user)))))
+            response)
+       (when process
+         (with-current-buffer buffer
+           (setq imap-client-eol "\n"
+                 imap-calculate-literal-size-first t)
+           (while (and (memq (process-status process) '(open run))
+                       (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:")
+                             (forward-line))
+                           t)
+                       ;; cyrus 1.6 imtest print "S: " before server greeting
+                       (or (not (looking-at "S: "))
+                           (forward-char 3)
+                           t)
+                       (not (and (imap-parse-greeting)
+                                 ;; success in imtest 1.6:
+                                 (re-search-forward
+                                  "^\\(Authenticat.*\\)" nil t)
+                                 (setq response (match-string 1)))))
+             (accept-process-output process 1)
+             (sit-for 1))
+           (and imap-log
+                (with-current-buffer (get-buffer-create imap-log)
+                  (buffer-disable-undo)
+                  (goto-char (point-max))
+                  (insert-buffer-substring buffer)))
+           (erase-buffer)
+           (message "GSSAPI IMAP connection: %s" (or response "failed"))
+           (if (and response (let ((case-fold-search nil))
+                               (not (string-match "failed" response))))
+               (setq done process)
+             (if (memq (process-status process) '(open run))
+                 (imap-send-command-wait "LOGOUT"))
+             (delete-process process)
+             nil)))))
+    done))
+
 (defun imap-ssl-p (buffer)
   nil)
 
 (defun imap-ssl-p (buffer)
   nil)
 
@@ -424,11 +555,10 @@ If ARGS, PROMPT is used as an argument to `format'."
   (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
                (list imap-ssl-program)))
        cmd done)
   (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
                (list imap-ssl-program)))
        cmd done)
+    (ignore-errors (require 'ssl))
     (while (and (not done) (setq cmd (pop cmds)))
       (message "imap: Opening SSL connection with `%s'..." cmd)
       (let* ((port (or port imap-default-ssl-port))
     (while (and (not done) (setq cmd (pop cmds)))
       (message "imap: Opening SSL connection with `%s'..." cmd)
       (let* ((port (or port imap-default-ssl-port))
-            (coding-system-for-read imap-coding-system-for-read)
-            (coding-system-for-write imap-coding-system-for-write)
             (ssl-program-name shell-file-name)
             (ssl-program-arguments
              (list shell-command-switch
             (ssl-program-name shell-file-name)
             (ssl-program-arguments
              (list shell-command-switch
@@ -436,11 +566,22 @@ If ARGS, PROMPT is used as an argument to `format'."
                                      ?s server
                                      ?p (number-to-string port)))))
             process)
                                      ?s server
                                      ?p (number-to-string port)))))
             process)
-       (when (setq process (ignore-errors (open-ssl-stream
-                                           name buffer server port)))
+       (when (setq process
+                   (ignore-errors
+                     (cond ((eq system-type 'windows-nt)
+                            (let (selective-display
+                                  (coding-system-for-write 'binary)
+                                  (coding-system-for-read 'raw-text-dos)
+                                  (output-coding-system 'binary)
+                                  (input-coding-system 'raw-text-dos))
+                              (open-ssl-stream name buffer server port)))
+                           (t
+                            (as-binary-process
+                             (open-ssl-stream name buffer server port))))))
          (with-current-buffer buffer
            (goto-char (point-min))
            (while (and (memq (process-status process) '(open run))
          (with-current-buffer buffer
            (goto-char (point-min))
            (while (and (memq (process-status process) '(open run))
+                       (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                        (goto-char (point-max))
                        (forward-line -1)
                        (not (imap-parse-greeting)))
                        (goto-char (point-max))
                        (forward-line -1)
                        (not (imap-parse-greeting)))
@@ -448,7 +589,6 @@ If ARGS, PROMPT is used as an argument to `format'."
              (sit-for 1))
            (and imap-log
                 (with-current-buffer (get-buffer-create imap-log)
              (sit-for 1))
            (and imap-log
                 (with-current-buffer (get-buffer-create imap-log)
-                  (imap-disable-multibyte)
                   (buffer-disable-undo)
                   (goto-char (point-max))
                   (insert-buffer-substring buffer)))
                   (buffer-disable-undo)
                   (goto-char (point-max))
                   (insert-buffer-substring buffer)))
@@ -459,7 +599,7 @@ If ARGS, PROMPT is used as an argument to `format'."
        (progn
          (message "imap: Opening SSL connection with `%s'...done" cmd)
          done)
        (progn
          (message "imap: Opening SSL connection with `%s'...done" cmd)
          done)
-      (message "imap: Failed opening SSL connection")
+         (message "imap: Opening SSL connection with `%s'...failed" cmd)
       nil)))
 
 (defun imap-network-p (buffer)
       nil)))
 
 (defun imap-network-p (buffer)
@@ -467,37 +607,81 @@ If ARGS, PROMPT is used as an argument to `format'."
 
 (defun imap-network-open (name buffer server port)
   (let* ((port (or port imap-default-port))
 
 (defun imap-network-open (name buffer server port)
   (let* ((port (or port imap-default-port))
-        (coding-system-for-read imap-coding-system-for-read)
-        (coding-system-for-write imap-coding-system-for-write)
-        (process (open-network-stream name buffer server port)))
+        (process (open-network-stream-as-binary name buffer server port)))
     (when process
       (while (and (memq (process-status process) '(open run))
     (when process
       (while (and (memq (process-status process) '(open run))
+                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                  (goto-char (point-min))
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
        (sit-for 1))
       (and imap-log
           (with-current-buffer (get-buffer-create imap-log)
                  (goto-char (point-min))
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
        (sit-for 1))
       (and imap-log
           (with-current-buffer (get-buffer-create imap-log)
-            (imap-disable-multibyte)
             (buffer-disable-undo)
             (goto-char (point-max))
             (insert-buffer-substring buffer)))
       (when (memq (process-status process) '(open run))
        process))))
 
             (buffer-disable-undo)
             (goto-char (point-max))
             (insert-buffer-substring buffer)))
       (when (memq (process-status process) '(open run))
        process))))
 
+(defun imap-shell-p (buffer)
+  nil)
+
+(defun imap-shell-open (name buffer server port)
+  (let ((cmds imap-shell-program)
+       cmd done)
+    (while (and (not done) (setq cmd (pop cmds)))
+      (message "imap: Opening IMAP connection with `%s'..." cmd)
+      (setq imap-client-eol "\n")
+      (let* ((port (or port imap-default-port))
+            (process (as-binary-process
+                      (start-process
+                       name buffer shell-file-name shell-command-switch
+                       (format-spec
+                        cmd
+                        (format-spec-make
+                         ?s server
+                         ?g imap-shell-host
+                         ?p (number-to-string port)
+                         ?l imap-default-user))))))
+       (when process
+         (while (and (memq (process-status process) '(open run))
+                     (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+                     (goto-char (point-min))
+                     (not (imap-parse-greeting)))
+           (accept-process-output process 1)
+           (sit-for 1))
+         (and imap-log
+              (with-current-buffer (get-buffer-create imap-log)
+                (buffer-disable-undo)
+                (goto-char (point-max))
+                (insert-buffer-substring buffer)))
+         (erase-buffer)
+         (when (memq (process-status process) '(open run))
+           (setq done process)))))
+    (if done
+       (progn
+         (message "imap: Opening IMAP connection with `%s'...done" cmd)
+         done)
+      (message "imap: Opening IMAP connection with `%s'...failed" cmd)
+      nil)))
+
 (defun imap-starttls-p (buffer)
 (defun imap-starttls-p (buffer)
-  (and (condition-case ()
-          (require 'starttls)
-        (error nil))
-       (imap-capability 'STARTTLS buffer)))
+  (and (imap-capability 'STARTTLS buffer)
+       (condition-case ()
+          (progn
+            (require 'starttls)
+            (call-process "starttls"))
+        (error nil))))
 
 (defun imap-starttls-open (name buffer server port)
   (let* ((port (or port imap-default-port))
 
 (defun imap-starttls-open (name buffer server port)
   (let* ((port (or port imap-default-port))
-        (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)))
+        (process (as-binary-process
+                  (starttls-open-stream name buffer server port)))
+        done)
+    (message "imap: Connecting with STARTTLS...")
     (when process
       (while (and (memq (process-status process) '(open run))
     (when process
       (while (and (memq (process-status process) '(open run))
+                 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
                  (goto-char (point-min))
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
                  (goto-char (point-min))
                  (not (imap-parse-greeting)))
        (accept-process-output process 1)
@@ -516,7 +700,13 @@ If ARGS, PROMPT is used as an argument to `format'."
                (starttls-negotiate imap-process)))
          (set-process-filter imap-process nil)))
       (when (memq (process-status process) '(open run))
                (starttls-negotiate imap-process)))
          (set-process-filter imap-process nil)))
       (when (memq (process-status process) '(open run))
-       process))))
+       (setq done process)))
+    (if done
+       (progn
+         (message "imap: Connecting with STARTTLS...done")
+         done)
+      (message "imap: Connecting with STARTTLS...failed")
+      nil)))
   
 ;; Server functions; authenticator stuff:
 
   
 ;; Server functions; authenticator stuff:
 
@@ -558,10 +748,20 @@ Returns t if login was successful, nil otherwise."
       ;;                      passwd nil))))
       ret)))
 
       ;;                      passwd nil))))
       ret)))
 
-(defun imap-kerberos4a-p (buffer)
+(defun imap-gssapi-auth-p (buffer)
+  (imap-capability 'AUTH=GSSAPI buffer))
+
+(defun imap-gssapi-auth (buffer)
+  (message "imap: Authenticating using GSSAPI...%s"
+          (if (eq imap-stream 'gssapi) "done" "failed"))
+  (eq imap-stream 'gssapi))
+
+(defun imap-kerberos4-auth-p (buffer)
   (imap-capability 'AUTH=KERBEROS_V4 buffer))
 
 (defun imap-kerberos4-auth (buffer)
   (imap-capability 'AUTH=KERBEROS_V4 buffer))
 
 (defun imap-kerberos4-auth (buffer)
+  (message "imap: Authenticating using Kerberos 4...%s"
+          (if (eq imap-stream 'kerberos4) "done" "failed"))
   (eq imap-stream 'kerberos4))
 
 (defun imap-cram-md5-p (buffer)
   (eq imap-stream 'kerberos4))
 
 (defun imap-cram-md5-p (buffer)
@@ -569,25 +769,38 @@ Returns t if login was successful, nil otherwise."
 
 (defun imap-cram-md5-auth (buffer)
   "Login to server using the AUTH CRAM-MD5 method."
 
 (defun imap-cram-md5-auth (buffer)
   "Login to server using the AUTH CRAM-MD5 method."
-  (imap-interactive-login
-   buffer
-   (lambda (user passwd)
-     (imap-ok-p
-      (imap-send-command-wait
-       (list
-       "AUTHENTICATE CRAM-MD5"
-       (lambda (challenge)
-         (let* ((decoded (base64-decode-string challenge))
-                (hash (rfc2104-hash 'md5 64 16 passwd decoded))
-                (response (concat user " " hash))
-                (encoded (base64-encode-string response)))
-           encoded))))))))
+  (message "imap: Authenticating using CRAM-MD5...")
+  (let ((done (imap-interactive-login
+              buffer
+              (lambda (user passwd)
+                (imap-ok-p
+                 (imap-send-command-wait
+                  (list
+                   "AUTHENTICATE CRAM-MD5"
+                   (lambda (challenge)
+                     (let* ((decoded (base64-decode-string challenge))
+                            (hash-function
+                             (if (and (featurep 'xemacs)
+                                      (>= (function-max-args 'md5) 4))
+                                 (lambda (object &optional start end)
+                                   (md5 object start end 'binary))
+                               'md5))
+                            (hash (rfc2104-hash hash-function 64 16
+                                                passwd decoded))
+                            (response (concat user " " hash))
+                            (encoded (base64-encode-string response)))
+                       encoded)))))))))
+    (if done
+       (message "imap: Authenticating using CRAM-MD5...done")
+      (message "imap: Authenticating using CRAM-MD5...failed"))))
 
 (defun imap-login-p (buffer)
 
 (defun imap-login-p (buffer)
-  (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer)))
+  (and (not (imap-capability 'LOGINDISABLED buffer))
+       (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
 
 (defun imap-login-auth (buffer)
   "Login to server using the LOGIN command."
 
 (defun imap-login-auth (buffer)
   "Login to server using the LOGIN command."
+  (message "imap: Plaintext authentication...")
   (imap-interactive-login buffer 
                          (lambda (user passwd)
                            (imap-ok-p (imap-send-command-wait 
   (imap-interactive-login buffer 
                          (lambda (user passwd)
                            (imap-ok-p (imap-send-command-wait 
@@ -598,19 +811,21 @@ Returns t if login was successful, nil otherwise."
   t)
 
 (defun imap-anonymous-auth (buffer)
   t)
 
 (defun imap-anonymous-auth (buffer)
+  (message "imap: Loging in anonymously...")
   (with-current-buffer buffer
     (imap-ok-p (imap-send-command-wait
                (concat "LOGIN anonymous \"" (concat (user-login-name) "@" 
                                                     (system-name)) "\"")))))
 
 (defun imap-digest-md5-p (buffer)
   (with-current-buffer buffer
     (imap-ok-p (imap-send-command-wait
                (concat "LOGIN anonymous \"" (concat (user-login-name) "@" 
                                                     (system-name)) "\"")))))
 
 (defun imap-digest-md5-p (buffer)
-  (and (condition-case ()
+  (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
+       (condition-case ()
           (require 'digest-md5)
           (require 'digest-md5)
-        (error nil))
-       (imap-capability 'AUTH=DIGEST-MD5 buffer)))
+        (error nil))))
 
 (defun imap-digest-md5-auth (buffer)
   "Login to server using the AUTH DIGEST-MD5 method."
 
 (defun imap-digest-md5-auth (buffer)
   "Login to server using the AUTH DIGEST-MD5 method."
+  (message "imap: Authenticating using DIGEST-MD5...")
   (imap-interactive-login
    buffer
    (lambda (user passwd)
   (imap-interactive-login
    buffer
    (lambda (user passwd)
@@ -619,16 +834,11 @@ Returns t if login was successful, nil otherwise."
             (list
              "AUTHENTICATE DIGEST-MD5"
              (lambda (challenge)
             (list
              "AUTHENTICATE DIGEST-MD5"
              (lambda (challenge)
-               (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))))
-            )))
+               (base64-encode-string
+                (sasl-digest-md5-digest-response
+                 (base64-decode-string challenge)
+                 user passwd "imap" imap-server)
+                'no-line-break))))))
        (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
           nil
         (setq imap-continuation nil)
        (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
           nil
         (setq imap-continuation nil)
@@ -675,43 +885,50 @@ necessery.  If nil, the buffer name is generated."
     (if (imap-opened buffer)
        (imap-close buffer))
     (mapcar 'make-variable-buffer-local imap-local-variables)
     (if (imap-opened buffer)
        (imap-close buffer))
     (mapcar 'make-variable-buffer-local imap-local-variables)
-    (imap-disable-multibyte)
+    (set-buffer-multibyte nil)
     (buffer-disable-undo)
     (setq imap-server (or server imap-server))
     (setq imap-port (or port imap-port))
     (setq imap-auth (or auth imap-auth))
     (setq imap-stream (or stream imap-stream))
     (buffer-disable-undo)
     (setq imap-server (or server imap-server))
     (setq imap-port (or port imap-port))
     (setq imap-auth (or auth imap-auth))
     (setq imap-stream (or stream imap-stream))
-    (when (let ((imap-stream (or imap-stream imap-default-stream)))
-           (imap-open-1 buffer))
-      ;; Choose stream.
-      (let (stream-changed)
-       (when (null imap-stream)
-         (let ((streams imap-streams))
-           (while (setq stream (pop streams))
-             (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
-                 (setq stream-changed (not (eq (or imap-stream 
-                                                   imap-default-stream)
-                                               stream))
-                       imap-stream stream
-                       streams nil)))
-           (unless imap-stream
-             (error "Couldn't figure out a stream for server"))))
-       (when stream-changed
-         (message "Reconnecting with %s..." imap-stream)
-         (imap-close buffer)
-         (imap-open-1 buffer)
-         (setq imap-capability nil)))
-      (if (imap-opened buffer)
-         ;; Choose authenticator
-         (when (null imap-auth)
-           (let ((auths imap-authenticators))
-             (while (setq auth (pop auths))
-               (if (funcall (nth 1 (assq auth imap-authenticator-alist)) 
-                            buffer)
-                   (setq imap-auth auth
-                         auths nil)))
-             (unless imap-auth
-               (error "Couldn't figure out authenticator for server"))))))
+    (message "imap: Connecting to %s..." imap-server)
+    (if (let ((imap-stream (or imap-stream imap-default-stream)))
+         (imap-open-1 buffer))
+       ;; Choose stream.
+       (let (stream-changed)
+         (message "imap: Connecting to %s...done" imap-server)
+         (when (null imap-stream)
+           (let ((streams imap-streams))
+             (while (setq stream (pop streams))
+               (if (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
+                   (setq stream-changed (not (eq (or imap-stream 
+                                                     imap-default-stream)
+                                                 stream))
+                         imap-stream stream
+                         streams nil)))
+             (unless imap-stream
+               (error "Couldn't figure out a stream for server"))))
+         (when stream-changed
+           (message "imap: Reconnecting with stream `%s'..." imap-stream)
+           (imap-close buffer)
+           (if (imap-open-1 buffer)
+               (message "imap: Reconnecting with stream `%s'...done"
+                        imap-stream)
+             (message "imap: Reconnecting with stream `%s'...failed" 
+                      imap-stream))
+           (setq imap-capability nil))
+         (if (imap-opened buffer)
+             ;; Choose authenticator
+             (when (and (null imap-auth) (not (eq imap-state 'auth)))
+               (let ((auths imap-authenticators))
+                 (while (setq auth (pop auths))
+                   (if (funcall (nth 1 (assq auth imap-authenticator-alist)) 
+                                buffer)
+                       (setq imap-auth auth
+                             auths nil)))
+                 (unless imap-auth
+                   (error "Couldn't figure out authenticator for server"))))))
+      (message "imap: Connecting to %s...failed" imap-server))
     (when (imap-opened buffer)
       (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
       buffer)))
     (when (imap-opened buffer)
       (setq imap-mailbox-data (make-vector imap-mailbox-prime 0))
       buffer)))
@@ -733,7 +950,10 @@ user and optionally stored in the buffer.  If USER and/or PASSWD is
 specified, the user will not be questioned and the username and/or
 password is remembered in the buffer."
   (with-current-buffer (or buffer (current-buffer))
 specified, the user will not be questioned and the username and/or
 password is remembered in the buffer."
   (with-current-buffer (or buffer (current-buffer))
-    (when (eq imap-state 'nonauth)
+    (if (not (eq imap-state 'nonauth))
+       (or (eq imap-state 'auth)
+           (eq imap-state 'select)
+           (eq imap-state 'examine))
       (make-variable-buffer-local 'imap-username)
       (make-variable-buffer-local 'imap-password)
       (if user (setq imap-username user))
       (make-variable-buffer-local 'imap-username)
       (make-variable-buffer-local 'imap-password)
       (if user (setq imap-username user))
@@ -855,6 +1075,10 @@ If EXAMINE is non-nil, do a read-only select."
     (imap-utf7-decode 
      (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
 
     (imap-utf7-decode 
      (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
 
+(defun imap-mailbox-examine-1 (mailbox &optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (imap-mailbox-select-1 mailbox 'exmine)))
+
 (defun imap-mailbox-examine (mailbox &optional buffer)
   "Examine MAILBOX on server in BUFFER."
   (imap-mailbox-select mailbox 'exmine buffer))
 (defun imap-mailbox-examine (mailbox &optional buffer)
   "Examine MAILBOX on server in BUFFER."
   (imap-mailbox-select mailbox 'exmine buffer))
@@ -1001,9 +1225,9 @@ returned, if ITEMS is a symbol only it's value is returned."
                                                   (list items))))))
       (if (listp items)
          (mapcar (lambda (item)
                                                   (list items))))))
       (if (listp items)
          (mapcar (lambda (item)
-                   (imap-mailbox-get-1 item mailbox))
+                   (imap-mailbox-get item mailbox))
                  items)
                  items)
-       (imap-mailbox-get-1 items mailbox)))))
+       (imap-mailbox-get items mailbox)))))
 
 (defun imap-mailbox-acl-get (&optional mailbox buffer)
   "Get ACL on mailbox from server in BUFFER."
 
 (defun imap-mailbox-acl-get (&optional mailbox buffer)
   "Get ACL on mailbox from server in BUFFER."
@@ -1052,6 +1276,18 @@ returned, if ITEMS is a symbol only it's value is returned."
               (list list))
             ","))
 
               (list list))
             ","))
 
+(defun imap-range-to-message-set (range)
+  (mapconcat
+   (lambda (item)
+     (if (consp item)
+         (format "%d:%d"
+                 (car item) (cdr item))
+       (format "%d" item)))
+   (if (and (listp range) (not (listp (cdr range))))
+       (list range) ;; make (1 . 2) into ((1 . 2))
+     range)
+   ","))
+
 (defun imap-fetch-asynch (uids props &optional nouidfetch buffer)
   (with-current-buffer (or buffer (current-buffer))
     (imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
 (defun imap-fetch-asynch (uids props &optional nouidfetch buffer)
   (with-current-buffer (or buffer (current-buffer))
     (imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
@@ -1193,7 +1429,7 @@ is non-nil return theese properties."
     (let ((old-mailbox imap-current-mailbox)
          (state imap-state)
          (imap-message-data (make-vector 2 0)))
     (let ((old-mailbox imap-current-mailbox)
          (state imap-state)
          (imap-message-data (make-vector 2 0)))
-      (when (imap-mailbox-examine mailbox)
+      (when (imap-mailbox-examine-1 mailbox)
        (prog1
            (and (imap-fetch "*" "UID")
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
        (prog1
            (and (imap-fetch "*" "UID")
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
@@ -1222,8 +1458,11 @@ first element, rest of list contain the saved articles' UIDs."
              (if (imap-ok-p (imap-send-command-wait cmd))
                  t
                (when (and (not dont-create)
              (if (imap-ok-p (imap-send-command-wait cmd))
                  t
                (when (and (not dont-create)
-                          (imap-mailbox-get-1 'trycreate mailbox))
-                 (imap-mailbox-create-1 mailbox)
+                          ;; removed because of buggy Oracle server
+                          ;; that doesn't send TRYCREATE tags (which
+                          ;; is a MUST according to specifications):
+                          ;;(imap-mailbox-get-1 'trycreate mailbox)
+                          (imap-mailbox-create-1 mailbox))
                  (imap-ok-p (imap-send-command-wait cmd)))))
            (or no-copyuid
                (imap-message-copyuid-1 mailbox)))))))
                  (imap-ok-p (imap-send-command-wait cmd)))))
            (or no-copyuid
                (imap-message-copyuid-1 mailbox)))))))
@@ -1234,7 +1473,7 @@ first element, rest of list contain the saved articles' UIDs."
     (let ((old-mailbox imap-current-mailbox)
          (state imap-state)
          (imap-message-data (make-vector 2 0)))
     (let ((old-mailbox imap-current-mailbox)
          (state imap-state)
          (imap-message-data (make-vector 2 0)))
-      (when (imap-mailbox-examine mailbox)
+      (when (imap-mailbox-examine-1 mailbox)
        (prog1
            (and (imap-fetch "*" "UID")
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
        (prog1
            (and (imap-fetch "*" "UID")
                 (list (imap-mailbox-get-1 'uidvalidity mailbox)
@@ -1265,10 +1504,10 @@ on failure."
   "Return number of lines in article by looking at the mime bodystructure BODY."
   (if (listp body)
       (if (stringp (car body))
   "Return number of lines in article by looking at the mime bodystructure BODY."
   (if (listp body)
       (if (stringp (car body))
-         (cond ((and (string= (car body) "TEXT")
+         (cond ((and (string= (upcase (car body)) "TEXT")
                      (numberp (nth 7 body)))
                 (nth 7 body))
                      (numberp (nth 7 body)))
                 (nth 7 body))
-               ((and (string= (car body) "MESSAGE")
+               ((and (string= (upcase (car body)) "MESSAGE")
                      (numberp (nth 9 body)))
                 (nth 9 body))
                (t 0))
                      (numberp (nth 9 body)))
                 (nth 9 body))
                (t 0))
@@ -1292,7 +1531,6 @@ on failure."
   (setq cmdstr (concat cmdstr imap-client-eol))
   (and imap-log
        (with-current-buffer (get-buffer-create imap-log)
   (setq cmdstr (concat cmdstr imap-client-eol))
   (and imap-log
        (with-current-buffer (get-buffer-create imap-log)
-        (imap-disable-multibyte)
         (buffer-disable-undo)
         (goto-char (point-max))
         (insert cmdstr)))
         (buffer-disable-undo)
         (goto-char (point-max))
         (insert cmdstr)))
@@ -1308,9 +1546,21 @@ on failure."
        (cond ((stringp cmd)
               (setq cmdstr (concat cmdstr cmd)))
              ((bufferp cmd)
        (cond ((stringp cmd)
               (setq cmdstr (concat cmdstr cmd)))
              ((bufferp cmd)
-              (setq cmdstr 
-                    (concat cmdstr (format "{%d}" (with-current-buffer cmd
-                                                    (buffer-size)))))
+              (let ((eol imap-client-eol)
+                    (calcfirst imap-calculate-literal-size-first)
+                    size)
+                (with-current-buffer cmd
+                  (if calcfirst
+                      (setq size (buffer-size)))
+                  (when (not (equal eol "\r\n"))
+                    ;; XXX modifies buffer!
+                    (goto-char (point-min))
+                    (while (search-forward "\r\n" nil t)
+                      (replace-match eol)))
+                  (if (not calcfirst)
+                      (setq size (buffer-size))))
+                (setq cmdstr 
+                      (concat cmdstr (format "{%d}" size))))
               (unwind-protect
                   (progn
                     (imap-send-command-1 cmdstr)
               (unwind-protect
                   (progn
                     (imap-send-command-1 cmdstr)
@@ -1318,17 +1568,12 @@ on failure."
                     (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
                         (setq command nil);; abort command if no cont-req
                       (let ((process imap-process)
                     (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
                         (setq command nil);; abort command if no cont-req
                       (let ((process imap-process)
-                            (stream imap-stream))
+                            (stream imap-stream)
+                            (eol imap-client-eol))
                         (with-current-buffer cmd
                         (with-current-buffer cmd
-                          (when (eq stream 'kerberos4)
-                            ;; XXX modifies buffer!
-                            (goto-char (point-min))
-                            (while (search-forward "\r\n" nil t)
-                              (replace-match "\n")))
                           (and imap-log
                                (with-current-buffer (get-buffer-create
                                                      imap-log)
                           (and imap-log
                                (with-current-buffer (get-buffer-create
                                                      imap-log)
-                                 (imap-disable-multibyte)
                                  (buffer-disable-undo)
                                  (goto-char (point-max))
                                  (insert-buffer-substring cmd)))
                                  (buffer-disable-undo)
                                  (goto-char (point-max))
                                  (insert-buffer-substring cmd)))
@@ -1357,7 +1602,12 @@ on failure."
                (< imap-reached-tag tag))
       (or (and (not (memq (process-status imap-process) '(open run)))
               (sit-for 1))
                (< imap-reached-tag tag))
       (or (and (not (memq (process-status imap-process) '(open run)))
               (sit-for 1))
-         (accept-process-output imap-process 1)))
+         (let ((len (/ (point-max) 1024))
+               message-log-max)
+           (unless (< len 10)
+             (message "imap read: %dk" len))
+           (accept-process-output imap-process 1))))
+    (message "")
     (or (assq tag imap-failed-tags)
        (if imap-continuation
            'INCOMPLETE
     (or (assq tag imap-failed-tags)
        (if imap-continuation
            'INCOMPLETE
@@ -1386,7 +1636,6 @@ Return nil if no complete line has arrived."
     (insert string)
     (and imap-log
         (with-current-buffer (get-buffer-create imap-log)
     (insert string)
     (and imap-log
         (with-current-buffer (get-buffer-create imap-log)
-          (imap-disable-multibyte)
           (buffer-disable-undo)
           (goto-char (point-max))
           (insert string)))
           (buffer-disable-undo)
           (goto-char (point-max))
           (insert string)))
@@ -1754,6 +2003,9 @@ Return nil if no complete line has arrived."
 ;;   resp-text-atom  = 1*<any ATOM-CHAR except "]">
 
 (defun imap-parse-resp-text-code ()
 ;;   resp-text-atom  = 1*<any ATOM-CHAR except "]">
 
 (defun imap-parse-resp-text-code ()
+  ;; xxx next line for stalker communigate pro 3.3.1 bug
+  (when (looking-at " \\[")
+    (imap-forward))
   (when (eq (char-after) ?\[)
     (imap-forward)
     (cond ((search-forward "PERMANENTFLAGS " nil t)
   (when (eq (char-after) ?\[)
     (imap-forward)
     (cond ((search-forward "PERMANENTFLAGS " nil t)
@@ -1974,11 +2226,15 @@ Return nil if no complete line has arrived."
 ;;                       ; revisions of this specification.
 
 (defun imap-parse-flag-list ()
 ;;                       ; revisions of this specification.
 
 (defun imap-parse-flag-list ()
-  (let ((str (buffer-substring (point) (search-forward ")" nil t)))
-       pos)
-    (while (setq pos (string-match "\\\\" str (and pos (+ 2 pos))))
-      (setq str (replace-match "\\\\" nil t str)))
-    (mapcar 'symbol-name (read str))))
+  (let (flag-list start)
+    (assert (eq (char-after) ?\())
+    (while (and (not (eq (char-after) ?\)))
+               (setq start (progn (imap-forward) (point)))
+               (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
+      (push (buffer-substring start (point)) flag-list))
+    (assert (eq (char-after) ?\)))
+    (imap-forward)
+    (nreverse flag-list)))
 
 ;;   envelope        = "(" env-date SP env-subject SP env-from SP env-sender SP
 ;;                     env-reply-to SP env-to SP env-cc SP env-bcc SP
 
 ;;   envelope        = "(" env-date SP env-subject SP env-from SP env-sender SP
 ;;                     env-reply-to SP env-to SP env-cc SP env-bcc SP
@@ -2036,7 +2292,10 @@ Return nil if no complete line has arrived."
           (imap-forward)
           (while (setq str (imap-parse-string))
             (push str strlist)
           (imap-forward)
           (while (setq str (imap-parse-string))
             (push str strlist)
-            (imap-forward))
+            ;; buggy stalker communigate pro 3.0 doesn't print SPC
+            ;; between body-fld-param's sometimes
+            (or (eq (char-after) ?\")
+                (imap-forward)))
           (nreverse strlist)))
        ((imap-parse-nil)
         nil)))
           (nreverse strlist)))
        ((imap-parse-nil)
         nil)))
@@ -2167,6 +2426,11 @@ Return nil if no complete line has arrived."
          (let (subbody)
            (while (and (eq (char-after) ?\()
                        (setq subbody (imap-parse-body)))
          (let (subbody)
            (while (and (eq (char-after) ?\()
                        (setq subbody (imap-parse-body)))
+             ;; buggy stalker communigate pro 3.0 insert a SPC between
+             ;; parts in multiparts
+             (when (and (eq (char-after) ?\ )
+                        (eq (char-after (1+ (point))) ?\())
+               (imap-forward))
              (push subbody body))
            (imap-forward)
            (push (imap-parse-string) body);; media-subtype
              (push subbody body))
            (imap-forward)
            (push (imap-parse-string) body);; media-subtype
@@ -2195,7 +2459,10 @@ Return nil if no complete line has arrived."
        (imap-forward)
        (push (imap-parse-nstring) body);; body-fld-desc
        (imap-forward)
        (imap-forward)
        (push (imap-parse-nstring) body);; body-fld-desc
        (imap-forward)
-       (push (imap-parse-string) body);; body-fld-enc
+       ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
+       ;; nstring and return NIL instead of defaulting back to 7BIT
+       ;; as the standard says.
+       (push (or (imap-parse-nstring) "7BIT") body);; body-fld-enc
        (imap-forward)
        (push (imap-parse-number) body);; body-fld-octets
 
        (imap-forward)
        (push (imap-parse-number) body);; body-fld-octets
 
@@ -2216,12 +2483,16 @@ Return nil if no complete line has arrived."
                   (push (imap-parse-envelope) body);; envelope
                   (imap-forward)
                   (push (imap-parse-body) body);; body
                   (push (imap-parse-envelope) body);; envelope
                   (imap-forward)
                   (push (imap-parse-body) body);; body
-                  (imap-forward)
-                  (push (imap-parse-number) body));; body-fld-lines
-                 ((setq lines (imap-parse-number));; body-type-text:
-                  (push lines body));; body-fld-lines
+                  ;; buggy stalker communigate pro 3.0 doesn't print
+                  ;; number of lines in message/rfc822 attachment
+                  (if (eq (char-after) ?\))
+                      (push 0 body)
+                    (imap-forward)
+                    (push (imap-parse-number) body))) ;; body-fld-lines
+                 ((setq lines (imap-parse-number))    ;; body-type-text:
+                  (push lines body))                  ;; body-fld-lines
                  (t
                  (t
-                  (backward-char)))));; no match...
+                  (backward-char)))))                 ;; no match...
 
        ;; ...and then parse the third one here...
 
 
        ;; ...and then parse the third one here...
 
@@ -2275,6 +2546,7 @@ Return nil if no complete line has arrived."
            imap-current-mailbox-p
            imap-mailbox-select-1
            imap-mailbox-select
            imap-current-mailbox-p
            imap-mailbox-select-1
            imap-mailbox-select
+           imap-mailbox-examine-1
            imap-mailbox-examine
            imap-mailbox-unselect
            imap-mailbox-expunge
            imap-mailbox-examine
            imap-mailbox-unselect
            imap-mailbox-expunge