X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=4a7783649e4e11ae6c883d5a4a0476b95ccfbf44;hb=9ee26ffc92b6bb276f970bae0e66e069227fb286;hp=7d2c9a70516dafb69c15c509d08d9dbfab191d21;hpb=a02678aaa90c0a682674058a2b26f731924b1971;p=gnus

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 7d2c9a705..4a7783649 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -32,7 +32,12 @@
 (eval-when-compile
   (require 'cl))
 
+(require 'nnheader)
+(require 'gnus-util)
+(require 'gnus)
+(require 'nnoo)
 (require 'netrc)
+(require 'parse-time)
 
 (nnoo-declare nnimap)
 
@@ -57,12 +62,27 @@ Values are `ssl' and `network'.")
 (defvoo nnimap-inbox nil
   "The mail box where incoming mail arrives and should be split out of.")
 
-(defvoo nnimap-expunge-inbox nil
-  "If non-nil, expunge the inbox after fetching mail.
+(defvoo nnimap-authenticator nil
+  "How nnimap authenticate itself to the server.
+Possible choices are nil (use default methods) or `anonymous'.")
+
+(defvoo nnimap-fetch-partial-articles nil
+  "If non-nil, nnimap will fetch partial articles.
+If t, nnimap will fetch only the first part.  If a string, it
+will fetch all parts that have types that match that string.  A
+likely value would be \"text/\" to automatically fetch all
+textual parts.")
+
+(defvoo nnimap-expunge t
+  "If non-nil, expunge articles after deleting them.
 This is always done if the server supports UID EXPUNGE, but it's
 not done by default on servers that doesn't support that command.")
 
+
 (defvoo nnimap-connection-alist nil)
+
+(defvoo nnimap-current-infos nil)
+
 (defvar nnimap-process nil)
 
 (defvar nnimap-status-string "")
@@ -71,7 +91,7 @@ not done by default on servers that doesn't support that command.")
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap
-  group process commands capabilities)
+  group process commands capabilities select-result newlinep)
 
 (defvar nnimap-object nil)
 
@@ -91,7 +111,7 @@ not done by default on servers that doesn't support that command.")
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 
-(defun nnimap-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (when (nnimap-possibly-change-group group server)
@@ -119,7 +139,7 @@ not done by default on servers that doesn't support that command.")
 
 (defun nnimap-transform-headers ()
   (goto-char (point-min))
-  (let (article bytes lines)
+  (let (article bytes lines size)
     (block nil
       (while (not (eobp))
 	(while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
@@ -130,6 +150,12 @@ not done by default on servers that doesn't support that command.")
 	      bytes (nnimap-get-length)
 	      lines nil)
 	(beginning-of-line)
+	(setq size
+	      (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
+				      (line-end-position)
+				      t)
+		   (match-string 1)))
+	(beginning-of-line)
 	(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
 	  (let ((structure (ignore-errors (read (current-buffer)))))
 	    (while (and (consp structure)
@@ -139,7 +165,8 @@ not done by default on servers that doesn't support that command.")
 	(delete-region (line-beginning-position) (line-end-position))
 	(insert (format "211 %s Article retrieved." article))
 	(forward-line 1)
-	(insert (format "Bytes: %d\n" bytes))
+	(when size
+	  (insert (format "Chars: %s\n" size)))
 	(when lines
 	  (insert (format "Lines: %s\n" lines)))
 	(re-search-forward "^\r$")
@@ -167,7 +194,7 @@ not done by default on servers that doesn't support that command.")
 	 result))
       (mapconcat #'identity (nreverse result) ",")))))
 
-(defun nnimap-open-server (server &optional defs)
+(deffoo nnimap-open-server (server &optional defs)
   (if (nnimap-server-opened server)
       t
     (unless (assq 'nnimap-address defs)
@@ -190,64 +217,83 @@ not done by default on servers that doesn't support that command.")
     (current-buffer)))
 
 (defun nnimap-open-shell-stream (name buffer host port)
-  (let ((process (start-process name buffer shell-file-name
-				shell-command-switch
-				(format-spec
-				 nnimap-shell-program
-				 (format-spec-make
-				  ?s host
-				  ?p port)))))
-    process))
+  (let ((process-connection-type nil))
+    (start-process name buffer shell-file-name
+		   shell-command-switch
+		   (format-spec
+		    nnimap-shell-program
+		    (format-spec-make
+		     ?s host
+		     ?p port)))))
+
+(defun nnimap-credentials (address ports)
+  (let (port credentials)
+    ;; Request the credentials from all ports, but only query on the
+    ;; last port if all the previous ones have failed.
+    (while (and (null credentials)
+		(setq port (pop ports)))
+      (setq credentials
+	    (auth-source-user-or-password
+	     '("login" "password") address port nil (null ports))))
+    credentials))
 
 (defun nnimap-open-connection (buffer)
   (with-current-buffer (nnimap-make-process-buffer buffer)
     (let* ((coding-system-for-read 'binary)
 	   (coding-system-for-write 'binary)
-	   (credentials
+	   (ports
 	    (cond
 	     ((eq nnimap-stream 'network)
-	      (open-network-stream "*nnimap*" (current-buffer) nnimap-address
-				   (or nnimap-server-port
-				       (if (netrc-find-service-number "imap")
-					   "imap"
-					 "143")))
-	      (auth-source-user-or-password
-	       '("login" "password") nnimap-address "imap" nil t))
-	     ((eq nnimap-stream 'stream)
+	      (open-network-stream
+	       "*nnimap*" (current-buffer) nnimap-address
+	       (or nnimap-server-port
+		   (if (netrc-find-service-number "imap")
+		       "imap"
+		     "143")))
+	      '("143" "imap"))
+	     ((eq nnimap-stream 'shell)
 	      (nnimap-open-shell-stream
 	       "*nnimap*" (current-buffer) nnimap-address
 	       (or nnimap-server-port "imap"))
-	      (auth-source-user-or-password
-	       '("login" "password") nnimap-address "imap" nil t))
+	      '("imap"))
 	     ((eq nnimap-stream 'ssl)
-	      (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
-			       (or nnimap-server-port
-				   (if (netrc-find-service-number "imaps")
-				       "imaps"
-				     "993")))
-	      (or
-	       (auth-source-user-or-password
-		'("login" "password") nnimap-address "imap")
-	       (auth-source-user-or-password
-		'("login" "password") nnimap-address "imaps" nil t))))))
+	      (open-tls-stream
+	       "*nnimap*" (current-buffer) nnimap-address
+	       (or nnimap-server-port
+		   (if (netrc-find-service-number "imaps")
+		       "imaps"
+		     "993")))
+	      '("143" "993" "imap" "imaps"))))
+	   connection-result login-result credentials)
       (setf (nnimap-process nnimap-object)
 	    (get-buffer-process (current-buffer)))
-      (unless credentials
-	(delete-process (nnimap-process nnimap-object)))
       (when (and (nnimap-process nnimap-object)
 		 (memq (process-status (nnimap-process nnimap-object))
 		       '(open run)))
 	(gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
-	(let ((result (nnimap-command "LOGIN %S %S"
-				      (car credentials) (cadr credentials))))
-	  (if (not (car result))
-	      (progn
+	(when (setq connection-result (nnimap-wait-for-connection))
+	  (unless (equal connection-result "PREAUTH")
+	    (if (not (setq credentials
+			   (if (eq nnimap-authenticator 'anonymous)
+			       (list "anonymous"
+				     (message-make-address))
+			     (nnimap-credentials
+			      nnimap-address
+			      (if nnimap-server-port
+				  (cons (format "%s" nnimap-server-port) ports)
+				ports)))))
+		(setq nnimap-object nil)
+	      (setq login-result (nnimap-command "LOGIN %S %S"
+						 (car credentials)
+						 (cadr credentials)))
+	      (unless (car login-result)
 		(delete-process (nnimap-process nnimap-object))
-		nil)
+		(setq nnimap-object nil))))
+	  (when nnimap-object
 	    (setf (nnimap-capabilities nnimap-object)
 		  (mapcar
 		   #'upcase
-		   (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+		   (or (nnimap-find-parameter "CAPABILITY" (cdr login-result))
 		       (nnimap-find-parameter
 			"CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
 	    (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
@@ -266,24 +312,25 @@ not done by default on servers that doesn't support that command.")
 	(setq result (cdr (cadr elem))))))
     result))
 
-(defun nnimap-close-server (&optional server)
+(deffoo nnimap-close-server (&optional server)
   t)
 
-(defun nnimap-request-close ()
+(deffoo nnimap-request-close ()
   t)
 
-(defun nnimap-server-opened (&optional server)
+(deffoo nnimap-server-opened (&optional server)
   (and (nnoo-current-server-p 'nnimap server)
        nntp-server-buffer
        (gnus-buffer-live-p nntp-server-buffer)
        (nnimap-find-connection nntp-server-buffer)))
 
-(defun nnimap-status-message (&optional server)
+(deffoo nnimap-status-message (&optional server)
   nnimap-status-string)
 
-(defun nnimap-request-article (article &optional group server to-buffer)
+(deffoo nnimap-request-article (article &optional group server to-buffer)
   (with-current-buffer nntp-server-buffer
-    (let ((result (nnimap-possibly-change-group group server)))
+    (let ((result (nnimap-possibly-change-group group server))
+	  parts)
       (when (stringp article)
 	(setq article (nnimap-find-article-by-message-id group article)))
       (when (and result
@@ -291,15 +338,27 @@ not done by default on servers that doesn't support that command.")
 	(erase-buffer)
 	(with-current-buffer (nnimap-buffer)
 	  (erase-buffer)
+	  (when nnimap-fetch-partial-articles
+	    (if (eq nnimap-fetch-partial-articles t)
+		(setq parts '(1))
+	      (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
+	      (goto-char (point-min))
+	      (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
+		(let ((structure (ignore-errors (read (current-buffer)))))
+		  (setq parts (nnimap-find-wanted-parts structure))))))
 	  (setq result
 		(nnimap-command
 		 (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
 		     "UID FETCH %d BODY.PEEK[]"
 		   "UID FETCH %d RFC822.PEEK")
-		 article)))
+		 article))
+	  ;; Check that we really got an article.
+	  (goto-char (point-min))
+	  (unless (looking-at "\\* [0-9]+ FETCH")
+	    (setq result nil)))
 	(let ((buffer (nnimap-find-process-buffer (current-buffer))))
 	  (when (car result)
-	    (with-current-buffer to-buffer
+	    (with-current-buffer (or to-buffer nntp-server-buffer)
 	      (insert-buffer-substring buffer)
 	      (goto-char (point-min))
 	      (let ((bytes (nnimap-get-length)))
@@ -308,24 +367,85 @@ not done by default on servers that doesn't support that command.")
 		(goto-char (+ (point) bytes))
 		(delete-region (point) (point-max))
 		(nnheader-ms-strip-cr))
-	      t)))))))
-
-(defun nnimap-request-group (group &optional server dont-check)
-  (with-current-buffer nntp-server-buffer
-    (let ((result (nnimap-possibly-change-group group server))
-	  articles)
+	      (cons group article))))))))
+
+(defun nnimap-find-wanted-parts (structure)
+  (message-flatten-list (nnimap-find-wanted-parts-1 structure "")))
+
+(defun nnimap-find-wanted-parts-1 (structure prefix)
+  (let ((num 1)
+	parts)
+    (while (consp (car structure))
+      (let ((sub (pop structure)))
+	(if (consp (car sub))
+	    (push (nnimap-find-wanted-parts-1
+		   sub (if (string= prefix "")
+			   (number-to-string num)
+			 (format "%s.%s" prefix num)))
+		  parts)
+	  (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))))
+	    (when (string-match nnimap-fetch-partial-articles type)
+	      (push (if (string= prefix "")
+			(number-to-string num)
+		      (format "%s.%s" prefix num))
+		    parts)))
+	  (incf num))))
+    (nreverse parts)))
+
+(deffoo nnimap-request-group (group &optional server dont-check info)
+  (let ((result (nnimap-possibly-change-group group server))
+	articles active marks high low)
+    (with-current-buffer nntp-server-buffer
       (when result
-	(setq articles (nnimap-get-flags "1:*"))
-	(erase-buffer)
-	(insert
-	 (format
-	  "211 %d %d %d %S\n"
-	  (length articles)
-	  (or (caar articles) 0)
-	  (or (caar (last articles)) 0)
-	  group))
+	(if (and dont-check
+		 (setq active (nth 2 (assoc group nnimap-current-infos))))
+	    (insert (format "211 %d %d %d %S\n"
+			    (- (cdr active) (car active))
+			    (car active)
+			    (cdr active)
+			    group))
+	  (with-current-buffer (nnimap-buffer)
+	    (erase-buffer)
+	    (let ((group-sequence
+		   (nnimap-send-command "SELECT %S" (utf7-encode group t)))
+		  (flag-sequence
+		   (nnimap-send-command "UID FETCH 1:* FLAGS")))
+	      (nnimap-wait-for-response flag-sequence)
+	      (setq marks
+		    (nnimap-flags-to-marks
+		     (nnimap-parse-flags
+		      (list (list group-sequence flag-sequence 1 group)))))
+	      (when info
+		(nnimap-update-infos marks (list info)))
+	      (goto-char (point-max))
+	      (cond
+	       (marks
+		(setq high (nth 3 (car marks))
+		      low (nth 4 (car marks))))
+	       ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
+		(setq high (1- (string-to-number (match-string 1)))
+		      low 1)))))
+	  (erase-buffer)
+	  (insert
+	   (format
+	    "211 %d %d %d %S\n" (1+ (- high low)) low high group)))
 	t))))
 
+(deffoo nnimap-request-create-group (group &optional server args)
+  (when (nnimap-possibly-change-group nil server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
+
+(deffoo nnimap-request-delete-group (group &optional force server)
+  (when (nnimap-possibly-change-group nil server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
+
+(deffoo nnimap-request-expunge-group (group &optional server)
+  (when (nnimap-possibly-change-group group server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "EXPUNGE")))))
+
 (defun nnimap-get-flags (spec)
   (let ((articles nil)
 	elems)
@@ -341,27 +461,28 @@ not done by default on servers that doesn't support that command.")
 	      articles)))
     (nreverse articles)))
 
-(defun nnimap-close-group (group &optional server)
+(deffoo nnimap-close-group (group &optional server)
   t)
 
 (deffoo nnimap-request-move-article (article group server accept-form
 					     &optional last internal-move-group)
-  (when (nnimap-possibly-change-group group server)
-    ;; If the move is internal (on the same server), just do it the easy
-    ;; way.
-    (let ((message-id (message-field-value "message-id")))
-      (if internal-move-group
-	  (let ((result
-		 (with-current-buffer (nnimap-buffer)
-		   (nnimap-command "UID COPY %d %S"
-				   article
-				   (utf7-encode internal-move-group t)))))
-	    (when (car result)
-	      (nnimap-delete-article article)
-	      (cons internal-move-group
-		    (nnimap-find-article-by-message-id
-		     internal-move-group message-id))))
-	(with-temp-buffer
+  (with-temp-buffer
+    (when (nnimap-request-article article group server (current-buffer))
+      ;; If the move is internal (on the same server), just do it the easy
+      ;; way.
+      (let ((message-id (message-field-value "message-id")))
+	(if internal-move-group
+	    (let ((result
+		   (with-current-buffer (nnimap-buffer)
+		     (nnimap-command "UID COPY %d %S"
+				     article
+				     (utf7-encode internal-move-group t)))))
+	      (when (car result)
+		(nnimap-delete-article article)
+		(cons internal-move-group
+		      (nnimap-find-article-by-message-id
+		       internal-move-group message-id))))
+	  ;; Move the article to a different method.
 	  (let ((result (eval accept-form)))
 	    (when result
 	      (nnimap-delete-article article)
@@ -369,14 +490,71 @@ not done by default on servers that doesn't support that command.")
 
 (deffoo nnimap-request-expire-articles (articles group &optional server force)
   (cond
+   ((null articles)
+    nil)
    ((not (nnimap-possibly-change-group group server))
     articles)
-   (force
+   ((and force
+	 (eq nnmail-expiry-target 'delete))
     (unless (nnimap-delete-article articles)
       (message "Article marked for deletion, but not expunged."))
     nil)
    (t
-    articles)))
+    (let ((deletable-articles
+	   (if force
+	       articles
+	     (gnus-sorted-intersection
+	      articles
+	      (nnimap-find-expired-articles group)))))
+      (if (null deletable-articles)
+	  articles
+	(if (eq nnmail-expiry-target 'delete)
+	    (nnimap-delete-article deletable-articles)
+	  (setq deletable-articles
+		(nnimap-process-expiry-targets
+		 deletable-articles group server)))
+	;; Return the articles we didn't delete.
+	(gnus-sorted-complement articles deletable-articles))))))
+
+(defun nnimap-process-expiry-targets (articles group server)
+  (let ((deleted-articles nil))
+    (dolist (article articles)
+      (let ((target nnmail-expiry-target))
+	(with-temp-buffer
+	  (when (nnimap-request-article article group server (current-buffer))
+	    (message "Expiring article %s:%d" group article)
+	    (when (functionp target)
+	      (setq target (funcall target group)))
+	    (when (and target
+		       (not (eq target 'delete)))
+	      (if (or (gnus-request-group target t)
+		      (gnus-request-create-group target))
+		  (nnmail-expiry-target-group target group)
+		(setq target nil)))
+	    (when target
+	      (push article deleted-articles))))))
+    ;; Change back to the current group again.
+    (nnimap-possibly-change-group group server)
+    (setq deleted-articles (nreverse deleted-articles))
+    (nnimap-delete-article deleted-articles)
+    deleted-articles))
+
+(defun nnimap-find-expired-articles (group)
+  (let ((cutoff (nnmail-expired-article-p group nil nil)))
+    (with-current-buffer (nnimap-buffer)
+      (let ((result
+	     (nnimap-command
+	      "UID SEARCH SENTBEFORE %s"
+	      (format-time-string
+	       (format "%%d-%s-%%Y"
+		       (upcase
+			(car (rassoc (nth 4 (decode-time cutoff))
+				     parse-time-months))))
+	       cutoff))))
+	(and (car result)
+	     (delete 0 (mapcar #'string-to-number
+			       (cdr (assoc "SEARCH" (cdr result))))))))))
+
 
 (defun nnimap-find-article-by-message-id (group message-id)
   (when (nnimap-possibly-change-group group nil)
@@ -394,10 +572,17 @@ not done by default on servers that doesn't support that command.")
   (with-current-buffer (nnimap-buffer)
     (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)"
 		    (nnimap-article-ranges articles))
-    (when (member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s"
-			   (nnimap-article-ranges articles))
-      t)))
+    (cond
+     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+      (nnimap-command "UID EXPUNGE %s"
+		      (nnimap-article-ranges articles))
+      t)
+     (nnimap-expunge
+      (nnimap-command "EXPUNGE")
+      t)
+     (t (gnus-message 7 (concat "nnimap: nnimap-expunge is not set and the "
+                                "server doesn't support UIDPLUS, so we won't "
+                                "delete this article now"))))))
 
 (deffoo nnimap-request-scan (&optional group server)
   (when (and (nnimap-possibly-change-group nil server)
@@ -413,7 +598,7 @@ not done by default on servers that doesn't support that command.")
 	(push flag flags)))
     flags))
 
-(defun nnimap-request-set-mark (group actions &optional server)
+(deffoo nnimap-request-set-mark (group actions &optional server)
   (when (nnimap-possibly-change-group group server)
     (let (sequence)
       (with-current-buffer (nnimap-buffer)
@@ -432,7 +617,8 @@ not done by default on servers that doesn't support that command.")
 				(mapconcat #'identity flags " ")))))))
 	;; Wait for the last command to complete to avoid later
 	;; syncronisation problems with the stream.
-	(nnimap-wait-for-response sequence)))))
+	(when sequence
+	  (nnimap-wait-for-response sequence))))))
 
 (deffoo nnimap-request-accept-article (group &optional server last)
   (when (nnimap-possibly-change-group nil server)
@@ -445,7 +631,10 @@ not done by default on servers that doesn't support that command.")
 			"APPEND %S {%d}" (utf7-encode group t)
 			(length message)))
 	(process-send-string (get-buffer-process (current-buffer)) message)
-	(process-send-string (get-buffer-process (current-buffer)) "\r\n")
+	(process-send-string (get-buffer-process (current-buffer))
+			     (if (nnimap-newlinep nnimap-object)
+				 "\n"
+			       "\r\n"))
 	(let ((result (nnimap-get-response sequence)))
 	  (when result
 	    (cons group
@@ -467,7 +656,7 @@ not done by default on servers that doesn't support that command.")
 	  (push (car (last line)) groups)))
       (nreverse groups))))
 
-(defun nnimap-request-list (&optional server)
+(deffoo nnimap-request-list (&optional server)
   (nnimap-possibly-change-group nil server)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
@@ -510,7 +699,7 @@ not done by default on servers that doesn't support that command.")
 				  (or highest exists)))))))))
 	t))))
 
-(defun nnimap-retrieve-group-data-early (server infos)
+(deffoo nnimap-retrieve-group-data-early (server infos)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       ;; QRESYNC handling isn't implemented.
@@ -550,8 +739,9 @@ not done by default on servers that doesn't support that command.")
 		    sequences))))
 	sequences))))
 
-(defun nnimap-finish-retrieve-group-infos (server infos sequences)
-  (when (nnimap-possibly-change-group nil server)
+(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
+  (when (and sequences
+	     (nnimap-possibly-change-group nil server))
     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
       (nnimap-wait-for-response (cadar sequences))
@@ -561,7 +751,19 @@ not done by default on servers that doesn't support that command.")
       (nnimap-update-infos (nnimap-flags-to-marks
 			    (nnimap-parse-flags
 			     (nreverse sequences)))
-			   infos))))
+			   infos)
+      ;; Finally, just return something resembling an active file in
+      ;; the nntp buffer, so that the agent can save the info, too.
+      (with-current-buffer nntp-server-buffer
+	(erase-buffer)
+	(dolist (info infos)
+	  (let* ((group (gnus-info-group info))
+		 (active (gnus-active group)))
+	    (when active
+	      (insert (format "%S %d %d y\n"
+			      (gnus-group-real-name group)
+			      (cdr active)
+			      (car active))))))))))
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)
@@ -596,9 +798,11 @@ not done by default on servers that doesn't support that command.")
 	  (when (> start-article 1)
 	    (setq read
 		  (gnus-range-nconcat
-		   (gnus-sorted-range-intersection
-		    (cons 1 start-article)
-		    (gnus-info-read info))
+		   (if (> start-article 1)
+		       (gnus-sorted-range-intersection
+			(cons 1 (1- start-article))
+			(gnus-info-read info))
+		     (gnus-info-read info))
 		   read)))
 	  (gnus-info-set-read info read)
 	  ;; Update the marks.
@@ -617,12 +821,20 @@ not done by default on servers that doesn't support that command.")
 	      (when (and old-marks
 			 (> start-article 1))
 		(setq old-marks (gnus-range-difference
-				 (cons start-article high)
-				 old-marks))
+				 old-marks
+				 (cons start-article high)))
 		(setq new-marks (gnus-range-nconcat old-marks new-marks)))
 	      (when new-marks
 		(push (cons (car type) new-marks) marks)))
-	    (gnus-info-set-marks info marks)))))))
+	    (gnus-info-set-marks info marks t)
+	    (nnimap-store-info info (gnus-active group))))))))
+
+(defun nnimap-store-info (info active)
+  (let* ((group (gnus-group-real-name (gnus-info-group info)))
+	 (entry (assoc group nnimap-current-infos)))
+    (if entry
+	(setcdr entry (list info active))
+      (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)
   (let (data group totalp uidnext articles start-article mark)
@@ -676,23 +888,29 @@ not done by default on servers that doesn't support that command.")
 (defun nnimap-find-process-buffer (buffer)
   (cadr (assoc buffer nnimap-connection-alist)))
 
-(defun nnimap-request-post (&optional server)
+(deffoo nnimap-request-post (&optional server)
   (setq nnimap-status-string "Read-only server")
   nil)
 
 (defun nnimap-possibly-change-group (group server)
-  (when (and server
-	     (not (nnimap-server-opened server)))
-    (nnimap-open-server server))
-  (if (not group)
-      t
-    (with-current-buffer (nnimap-buffer)
-      (if (equal group (nnimap-group nnimap-object))
-	  t
-	(let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
-	  (when (car result)
-	    (setf (nnimap-group nnimap-object) group)
-	    result))))))
+  (let ((open-result t))
+    (when (and server
+	       (not (nnimap-server-opened server)))
+      (setq open-result (nnimap-open-server server)))
+    (cond
+     ((not open-result)
+      nil)
+     ((not group)
+      t)
+     (t
+      (with-current-buffer (nnimap-buffer)
+	(if (equal group (nnimap-group nnimap-object))
+	    t
+	  (let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
+	    (when (car result)
+	      (setf (nnimap-group nnimap-object) group
+		    (nnimap-select-result nnimap-object) result)
+	      result))))))))
 
 (defun nnimap-find-connection (buffer)
   "Find the connection delivering to BUFFER."
@@ -712,9 +930,12 @@ not done by default on servers that doesn't support that command.")
   (process-send-string
    (get-buffer-process (current-buffer))
    (nnimap-log-command
-    (format "%d %s\r\n"
+    (format "%d %s%s\n"
 	    (incf nnimap-sequence)
-	    (apply #'format args))))
+	    (apply #'format args)
+	    (if (nnimap-newlinep nnimap-object)
+		""
+	      "\r"))))
   nnimap-sequence)
 
 (defun nnimap-log-command (command)
@@ -730,23 +951,39 @@ not done by default on servers that doesn't support that command.")
     (if (equal (caar response) "OK")
 	(cons t response)
       (nnheader-report 'nnimap "%s"
-		       (mapconcat #'identity (car response) " "))
+		       (mapconcat (lambda (a)
+				    (format "%s" a))
+				  (car response) " "))
       nil)))
 
 (defun nnimap-get-response (sequence)
   (nnimap-wait-for-response sequence)
   (nnimap-parse-response))
 
+(defun nnimap-wait-for-connection ()
+  (let ((process (get-buffer-process (current-buffer))))
+    (goto-char (point-min))
+    (while (and (memq (process-status process)
+		      '(open run))
+		(not (re-search-forward "^\\* .*\n" nil t)))
+      (nnheader-accept-process-output process)
+      (goto-char (point-min)))
+    (forward-line -1)
+    (and (looking-at "\\* \\([A-Z0-9]+\\)")
+	 (match-string 1))))
+
 (defun nnimap-wait-for-response (sequence &optional messagep)
-  (goto-char (point-max))
-  (while (or (bobp)
-	     (progn
-	       (forward-line -1)
-	       (not (looking-at (format "^%d .*\n" sequence)))))
-    (when messagep
-      (message "Read %dKB" (/ (buffer-size) 1000)))
-    (nnheader-accept-process-output (get-buffer-process (current-buffer)))
-    (goto-char (point-max))))
+  (let ((process (get-buffer-process (current-buffer))))
+    (goto-char (point-max))
+    (while (and (memq (process-status process)
+		      '(open run))
+		(not (re-search-backward (format "^%d .*\n" sequence)
+					 (max (point-min) (- (point) 500))
+					 t)))
+      (when messagep
+	(message "Read %dKB" (/ (buffer-size) 1000)))
+      (nnheader-accept-process-output process)
+      (goto-char (point-max)))))
 
 (defun nnimap-parse-response ()
   (let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
@@ -825,7 +1062,7 @@ not done by default on servers that doesn't support that command.")
 		 "BODY.PEEK[HEADER] BODY.PEEK"
 	       "RFC822.PEEK"))
 	    (if nnimap-split-download-body-default
-		""
+		"[]"
 	      "[1]")))
    t))
 
@@ -877,17 +1114,19 @@ not done by default on servers that doesn't support that command.")
 (defun nnimap-mark-and-expunge-incoming (range)
   (when range
     (setq range (nnimap-article-ranges range))
-    (nnimap-send-command
-     "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)
-    (cond
-     ;; If the server supports it, we now delete the message we have
-     ;; just copied over.
-     ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
-      (nnimap-send-command "UID EXPUNGE %s" range))
-     ;; If it doesn't support UID EXPUNGE, then we only expunge if the
-     ;; user has configured it.
-     (nnimap-expunge-inbox
-      (nnimap-send-command "EXPUNGE")))))
+    (let ((sequence
+	   (nnimap-send-command
+	    "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
+      (cond
+       ;; If the server supports it, we now delete the message we have
+       ;; just copied over.
+       ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
+	(setq sequence (nnimap-send-command "UID EXPUNGE %s" range)))
+       ;; If it doesn't support UID EXPUNGE, then we only expunge if the
+       ;; user has configured it.
+       (nnimap-expunge
+	(setq sequence (nnimap-send-command "EXPUNGE"))))
+      (nnimap-wait-for-response sequence))))
 
 (defun nnimap-parse-copied-articles (sequences)
   (let (sequence copied range)