X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fimap.el;h=489fecf27d32430f6e5b5d8bf581536ea951a854;hb=08ee2f3ea941c7a0fdd3b67a4c518847435c823c;hp=1c112f8564c21a3e2bef622da8a13b42bcbe4c84;hpb=21fdea004a85252c95fa32faa56e2fc4cf8e9c07;p=elisp%2Fgnus.git-

diff --git a/lisp/imap.el b/lisp/imap.el
index 1c112f8..489fecf 100644
--- a/lisp/imap.el
+++ b/lisp/imap.el
@@ -75,11 +75,11 @@
 ;;
 ;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
 ;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
-;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS)
-;; (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.
+;; (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.
 ;;
 ;; Without the work of John McClary Prevost and Jim Radford this library
 ;; would not have seen the light of day.  Many thanks.
@@ -151,31 +151,69 @@
   (autoload 'utf7-decode "utf7")
   (autoload 'format-spec "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.
 
-(defvar imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
-				 "imtest -kp %s %p")
+(defgroup imap nil
+  "Low-level IMAP issues."
+  :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.")
+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))
 
-(defvar imap-gssapi-program '("imtest -m gssapi -u %l -p %p %s")
+(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.")
-
-(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")
+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
-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.")
@@ -188,7 +226,7 @@ stdin and return responses to stdout.")
 (defvar imap-fetch-data-hook nil
   "Hooks called after receiving each FETCH response.")
 
-(defvar imap-streams '(gssapi 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
@@ -196,6 +234,7 @@ stdin and return responses to stdout.")
     (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.
 
@@ -214,7 +253,7 @@ stream.")
   "Priority of authenticators to consider when authenticating to server.")
 
 (defvar imap-authenticator-alist 
-  '((gssapi     imap-gssapi-auth-p    imap-gssapia-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)
@@ -257,6 +296,7 @@ encoded mailboxes which doesn't translate into ISO-8859-1.")
 				 imap-failed-tags
 				 imap-tag
 				 imap-process
+				 imap-calculate-literal-size-first
 				 imap-mailbox-data))
 
 ;; Internal variables.
@@ -267,6 +307,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-calculate-literal-size-first nil)
 (defvar imap-state 'closed 
   "IMAP state.
 Valid states are `closed', `initial', `nonauth', `auth', `selected'
@@ -325,10 +366,12 @@ human readable response text (a string).")
 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*"
-  "Random debug spew.")
+  "Name of buffer for random debug spew.
+For example: (setq imap-debug \"*imap-debug*\")")
 
 
 ;; Utility functions:
@@ -392,6 +435,7 @@ If ARGS, PROMPT is used as an argument to `format'."
 	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
@@ -405,7 +449,8 @@ If ARGS, PROMPT is used as an argument to `format'."
 	     response)
 	(when process
 	  (with-current-buffer buffer
-	    (setq imap-client-eol "\n")
+	    (setq imap-client-eol "\n"
+		  imap-calculate-literal-size-first t)
 	    (while (and (memq (process-status process) '(open run))
 			(goto-char (point-min))
                         ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
@@ -432,7 +477,8 @@ If ARGS, PROMPT is used as an argument to `format'."
 		   (goto-char (point-max))
 		   (insert-buffer-substring buffer)))
 	    (erase-buffer)
-	    (message "Kerberos 4 IMAP connection: %s" (or response "failed"))
+	    (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)
@@ -466,6 +512,10 @@ If ARGS, PROMPT is used as an argument to `format'."
 	    (setq imap-client-eol "\n")
 	    (while (and (memq (process-status process) '(open run))
 			(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)
@@ -543,7 +593,7 @@ If ARGS, PROMPT is used as an argument to `format'."
 	(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)
@@ -566,16 +616,61 @@ If ARGS, PROMPT is used as an argument to `format'."
       (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))
+		      (goto-char (point-min))
+		      (not (imap-parse-greeting)))
+	    (accept-process-output process 1)
+	    (sit-for 1))
+	  (erase-buffer)
+	  (and imap-log
+	       (with-current-buffer (get-buffer-create imap-log)
+		 (buffer-disable-undo)
+		 (goto-char (point-max))
+		 (insert-buffer-substring 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)
-  (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))
 	 (process (as-binary-process
-		   (starttls-open-stream name buffer server port))))
+		   (starttls-open-stream name buffer server port)))
+	 done)
+    (message "imap: Connecting with STARTTLS...")
     (when process
       (while (and (memq (process-status process) '(open run))
 		  (goto-char (point-min))
@@ -596,7 +691,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))
-	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:
 
@@ -642,12 +743,16 @@ Returns t if login was successful, nil otherwise."
   (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)
+  (message "imap: Authenticating using Kerberos 4...%s"
+	   (if (eq imap-stream 'kerberos4) "done" "failed"))
   (eq imap-stream 'kerberos4))
 
 (defun imap-cram-md5-p (buffer)
@@ -655,30 +760,38 @@ Returns t if login was successful, nil otherwise."
 
 (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-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))))))))
+  (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)
-  (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."
+  (message "imap: Plaintext authentication...")
   (imap-interactive-login buffer 
 			  (lambda (user passwd)
 			    (imap-ok-p (imap-send-command-wait 
@@ -689,19 +802,21 @@ Returns t if login was successful, nil otherwise."
   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)
-  (and (condition-case ()
+  (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
+       (condition-case ()
 	   (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."
+  (message "imap: Authenticating using DIGEST-MD5...")
   (imap-interactive-login
    buffer
    (lambda (user passwd)
@@ -767,37 +882,44 @@ necessery.  If nil, the buffer name is generated."
     (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)))
@@ -819,7 +941,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))
-    (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))
@@ -1142,6 +1267,18 @@ returned, if ITEMS is a symbol only it's value is returned."
 	       (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 ")
@@ -1355,7 +1492,6 @@ on failure."
   "Return number of lines in article by looking at the mime bodystructure BODY."
   (if (listp body)
       (if (stringp (car body))
-	  ;; upcase for bug in courier imap server
 	  (cond ((and (string= (upcase (car body)) "TEXT")
 		      (numberp (nth 7 body)))
 		 (nth 7 body))
@@ -1398,9 +1534,21 @@ on failure."
 	(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)
@@ -1411,11 +1559,6 @@ on failure."
 			     (stream imap-stream)
 			     (eol imap-client-eol))
 			 (with-current-buffer cmd
-			   (when (not (equal eol "\r\n"))
-			     ;; XXX modifies buffer!
-			     (goto-char (point-min))
-			     (while (search-forward "\r\n" nil t)
-			       (replace-match eol)))
 			   (and imap-log
 				(with-current-buffer (get-buffer-create
 						      imap-log)
@@ -1447,7 +1590,12 @@ on failure."
 		(< 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
@@ -1843,6 +1991,9 @@ Return nil if no complete line has arrived."
 ;;   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)
@@ -2063,11 +2214,15 @@ Return nil if no complete line has arrived."
 ;;                       ; 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
@@ -2125,7 +2280,10 @@ Return nil if no complete line has arrived."
 	   (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)))
@@ -2256,6 +2414,11 @@ Return nil if no complete line has arrived."
 	  (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
@@ -2284,7 +2447,10 @@ Return nil if no complete line has arrived."
 	(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
 
@@ -2305,12 +2471,16 @@ Return nil if no complete line has arrived."
 		   (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
-		   (backward-char)))));; no match...
+		   (backward-char)))))                 ;; no match...
 
 	;; ...and then parse the third one here...