X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnimap.el;h=775b1bc054a5572508d38582c530125415429cf4;hp=ccd85bf82764803039a0dd7a71374ff0427d39af;hb=0661509959b5bf873e14519923ed74ade86925ac;hpb=f7b1fecbfa541bd9c7605ed0424d7e02dede0614

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index ccd85bf82..775b1bc05 100644
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -38,6 +38,7 @@
 (require 'nnoo)
 (require 'netrc)
 (require 'utf7)
+(require 'tls)
 (require 'parse-time)
 
 (autoload 'auth-source-forget-user-or-password "auth-source")
@@ -70,8 +71,11 @@ Values are `ssl', `network', `starttls' or `shell'.")
   "How mail is split.
 Uses the same syntax as nnmail-split-methods")
 
+(defvoo nnimap-split-fancy nil
+  "Uses the same syntax as nnmail-split-fancy.")
+
 (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
-			"Gnus 5.13")
+			"Emacs 24.1")
 
 (defvoo nnimap-authenticator nil
   "How nnimap authenticate itself to the server.
@@ -291,7 +295,9 @@ textual parts.")
 	     (port nil)
 	     (ports
 	      (cond
-	       ((eq nnimap-stream 'network)
+	       ((or (eq nnimap-stream 'network)
+		    (and (eq nnimap-stream 'starttls)
+			 (fboundp 'open-gnutls-stream)))
 		(open-network-stream
 		 "*nnimap*" (current-buffer) nnimap-address
 		 (setq port
@@ -306,19 +312,25 @@ textual parts.")
 		 (setq port (or nnimap-server-port "imap")))
 		'("imap"))
 	       ((eq nnimap-stream 'starttls)
-		(starttls-open-stream
-		 "*nnimap*" (current-buffer) nnimap-address
-		 (setq port (or nnimap-server-port "imap")))
+		(let ((tls-program (nnimap-extend-tls-programs)))
+		  (open-tls-stream
+		   "*nnimap*" (current-buffer) nnimap-address
+		   (setq port (or nnimap-server-port "imap"))
+		   'starttls))
 		'("imap"))
-	       ((eq nnimap-stream 'ssl)
-		(open-tls-stream
-		 "*nnimap*" (current-buffer) nnimap-address
-		 (setq port
-		       (or nnimap-server-port
-			   (if (netrc-find-service-number "imaps")
-			       "imaps"
-			     "993"))))
-		'("143" "993" "imap" "imaps"))))
+	       ((memq nnimap-stream '(ssl tls))
+		(funcall (if (fboundp 'open-gnutls-stream)
+			     'open-gnutls-stream
+			   'open-tls-stream)
+			 "*nnimap*" (current-buffer) nnimap-address
+			 (setq port
+			       (or nnimap-server-port
+				   (if (netrc-find-service-number "imaps")
+				       "imaps"
+				     "993"))))
+		'("143" "993" "imap" "imaps"))
+	       (t
+		(error "Unknown stream type: %s" nnimap-stream))))
 	     connection-result login-result credentials)
 	(setf (nnimap-process nnimap-object)
 	      (get-buffer-process (current-buffer)))
@@ -327,7 +339,8 @@ textual parts.")
 			    '(open run))))
 	    (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
 			     nnimap-address port nnimap-stream)
-	  (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
+	  (gnus-set-process-query-on-exit-flag
+	   (nnimap-process nnimap-object) nil)
 	  (if (not (setq connection-result (nnimap-wait-for-connection)))
 	      (nnheader-report 'nnimap
 			       "%s" (buffer-substring
@@ -342,11 +355,31 @@ textual parts.")
 		   #'upcase
 		   (nnimap-find-parameter
 		    "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
-	    (when (eq nnimap-stream 'starttls)
-	      (nnimap-command "STARTTLS")
-	      (starttls-negotiate (nnimap-process nnimap-object)))
 	    (when nnimap-server-port
 	      (push (format "%s" nnimap-server-port) ports))
+	    ;; If this is a STARTTLS-capable server, then sever the
+	    ;; connection and start a STARTTLS connection instead.
+	    (cond
+	     ((and (or (and (eq nnimap-stream 'network)
+			    (member "STARTTLS"
+				    (nnimap-capabilities nnimap-object)))
+		       (eq nnimap-stream 'starttls))
+		   (fboundp 'open-gnutls-stream))
+	      (nnimap-command "STARTTLS")
+	      (gnutls-negotiate (nnimap-process nnimap-object) nil))
+	     ((and (eq nnimap-stream 'network)
+		   (member "STARTTLS" (nnimap-capabilities nnimap-object)))
+	      (let ((nnimap-stream 'starttls))
+		(let ((tls-process
+		       (nnimap-open-connection buffer)))
+		  ;; If the STARTTLS connection was successful, we
+		  ;; kill our first non-encrypted connection.  If it
+		  ;; wasn't successful, we just use our unencrypted
+		  ;; connection.
+		  (when (memq (process-status tls-process) '(open run))
+		    (delete-process (nnimap-process nnimap-object))
+		    (kill-buffer (current-buffer))
+		    (return tls-process))))))
 	    (unless (equal connection-result "PREAUTH")
 	      (if (not (setq credentials
 			     (if (eq nnimap-authenticator 'anonymous)
@@ -378,7 +411,20 @@ textual parts.")
 	    (when nnimap-object
 	      (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
 		(nnimap-command "ENABLE QRESYNC"))
-	      t)))))))
+	      (nnimap-process nnimap-object))))))))
+
+(defun nnimap-extend-tls-programs ()
+  (let ((programs tls-program)
+	result)
+    (unless (consp programs)
+      (setq programs (list programs)))
+    (dolist (program programs)
+      (when (assoc (car (split-string program)) tls-starttls-switches)
+	(push (if (not (string-match "%s" program))
+		  (concat program " " "%s")
+		program)
+	      result)))
+    (nreverse result)))
 
 (defun nnimap-find-parameter (parameter elems)
   (let (result)
@@ -393,7 +439,10 @@ textual parts.")
     result))
 
 (deffoo nnimap-close-server (&optional server)
-  t)
+  (when (nnoo-change-server 'nnimap server nil)
+    (ignore-errors
+      (delete-process (get-buffer-process (nnimap-buffer))))
+    t))
 
 (deffoo nnimap-request-close ()
   t)
@@ -422,7 +471,12 @@ textual parts.")
 	    (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
 	    (goto-char (point-min))
 	    (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
-	      (setq structure (ignore-errors (read (current-buffer)))
+	      (setq structure (ignore-errors
+				(let ((start (point)))
+				  (forward-sexp 1)
+				  (downcase-region start (point))
+				  (goto-char (point))
+				  (read (current-buffer))))
 		    parts (nnimap-find-wanted-parts structure))))
 	  (when (if parts
 		    (nnimap-get-partial-article article parts structure)
@@ -582,15 +636,18 @@ textual parts.")
 	      (setq marks
 		    (nnimap-flags-to-marks
 		     (nnimap-parse-flags
-		      (list (list group-sequence flag-sequence 1 group)))))
-	      (when info
+		      (list (list group-sequence flag-sequence
+				  1 group "SELECT")))))
+	      (when (and info
+			 marks)
 		(nnimap-update-infos marks (list info)))
 	      (goto-char (point-max))
 	      (let ((uidnext (nth 5 (car marks))))
-		(setq high (if uidnext
-			       (1- uidnext)
-			     (nth 3 (car marks)))
-		      low (or (nth 4 (car marks)) uidnext)))))
+		(setq high (or (if uidnext
+                                   (1- uidnext)
+                                 (nth 3 (car marks)))
+                               0)
+		      low (or (nth 4 (car marks)) uidnext 1)))))
 	  (erase-buffer)
 	  (insert
 	   (format
@@ -607,6 +664,12 @@ textual parts.")
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
 
+(deffoo nnimap-request-rename-group (group new-name &optional server)
+  (when (nnimap-possibly-change-group nil server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "RENAME %S %S"
+			   (utf7-encode group t) (utf7-encode new-name t))))))
+
 (deffoo nnimap-request-expunge-group (group &optional server)
   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
@@ -614,16 +677,19 @@ textual parts.")
 
 (defun nnimap-get-flags (spec)
   (let ((articles nil)
-	elems)
+	elems end)
     (with-current-buffer (nnimap-buffer)
       (erase-buffer)
       (nnimap-wait-for-response (nnimap-send-command
 				 "UID FETCH %s FLAGS" spec))
+      (setq end (point))
+      (subst-char-in-region (point-min) (point-max)
+			    ?\\ ?% t)
       (goto-char (point-min))
-      (while (re-search-forward "^\\* [0-9]+ FETCH (\\(.*\\))" nil t)
-	(setq elems (nnimap-parse-line (match-string 1)))
-	(push (cons (string-to-number (cadr (member "UID" elems)))
-		    (cadr (member "FLAGS" elems)))
+      (while (search-forward " FETCH " end t)
+	(setq elems (read (current-buffer)))
+	(push (cons (cadr (memq 'UID elems))
+		    (cadr (memq 'FLAGS elems)))
 	      articles)))
     (nreverse articles)))
 
@@ -724,16 +790,20 @@ textual parts.")
 
 
 (defun nnimap-find-article-by-message-id (group message-id)
-  (when (nnimap-possibly-change-group group nil)
-    (with-current-buffer (nnimap-buffer)
-      (let ((result
-	     (nnimap-command "UID SEARCH HEADER Message-Id %S" message-id))
-	    article)
-	(when (car result)
-	  ;; Select the last instance of the message in the group.
-	  (and (setq article
-		     (car (last (assoc "SEARCH" (cdr result)))))
-	       (string-to-number article)))))))
+  (with-current-buffer (nnimap-buffer)
+    (erase-buffer)
+    (setf (nnimap-group nnimap-object) nil)
+    (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
+    (let ((sequence
+	   (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id))
+	  article result)
+      (setq result (nnimap-wait-for-response sequence))
+      (when (and result
+		 (car (setq result (nnimap-parse-response))))
+	;; Select the last instance of the message in the group.
+	(and (setq article
+		   (car (last (assoc "SEARCH" (cdr result)))))
+	     (string-to-number article))))))
 
 (defun nnimap-delete-article (articles)
   (with-current-buffer (nnimap-buffer)
@@ -791,10 +861,10 @@ textual parts.")
 (deffoo nnimap-request-accept-article (group &optional server last)
   (when (nnimap-possibly-change-group nil server)
     (nnmail-check-syntax)
-    (nnimap-add-cr)
-    (let ((message (buffer-string))
-	  (message-id (message-field-value "message-id"))
-	  sequence)
+    (let ((message-id (message-field-value "message-id"))
+	  sequence message)
+      (nnimap-add-cr)
+      (setq message (buffer-string))
       (with-current-buffer (nnimap-buffer)
 	(setq sequence (nnimap-send-command
 			"APPEND %S {%d}" (utf7-encode group t)
@@ -872,44 +942,59 @@ textual parts.")
 				  (or highest exists)))))))))
 	t))))
 
+(deffoo nnimap-request-newgroups (date &optional server)
+  (nnimap-possibly-change-group nil server)
+  (with-current-buffer nntp-server-buffer
+    (erase-buffer)
+    (dolist (group (with-current-buffer (nnimap-buffer)
+		     (nnimap-get-groups)))
+      (unless (assoc group nnimap-current-infos)
+	;; Insert dummy numbers here -- they don't matter.
+	(insert (format "%S 0 1 y\n" group))))
+    t))
+
 (deffoo nnimap-retrieve-group-data-early (server infos)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
+      (erase-buffer)
+      (setf (nnimap-group nnimap-object) nil)
       ;; QRESYNC handling isn't implemented.
-      (let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object)))
-	    marks groups sequences)
+      (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object)))
+	    params groups sequences active uidvalidity modseq group)
 	;; Go through the infos and gather the data needed to know
 	;; what and how to request the data.
 	(dolist (info infos)
-	  (setq marks (gnus-info-marks info))
-	  (push (list (gnus-group-real-name (gnus-info-group info))
-		      (cdr (assq 'active marks))
-		      (cdr (assq 'uid marks)))
-		groups))
-	;; Then request the data.
-	(erase-buffer)
-	(setf (nnimap-group nnimap-object) nil)
-	(dolist (elem groups)
+	  (setq params (gnus-info-params info)
+		group (gnus-group-real-name (gnus-info-group info))
+		active (cdr (assq 'active params))
+		uidvalidity (cdr (assq 'uidvalidity params))
+		modseq (cdr (assq 'modseq params)))
 	  (if (and qresyncp
-		   (nth 2 elem))
+		   uidvalidity
+		   modseq)
 	      (push
-	       (list 'qresync
-		     (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
-					  (car elem)
-					  (car (nth 2 elem))
-					  (cdr (nth 2 elem)))
-		     nil
-		     (car elem))
+	       (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
+					  group uidvalidity modseq)
+		     'qresync
+		     nil group 'qresync)
 	       sequences)
 	    (let ((start
-		   (if (nth 1 elem)
+		   (if (and active uidvalidity)
 		       ;; Fetch the last 100 flags.
-		       (max 1 (- (cdr (nth 1 elem)) 100))
-		     1)))
-	      (push (list (nnimap-send-command "EXAMINE %S" (car elem))
+		       (max 1 (- (cdr active) 100))
+		     1))
+		  (command
+		   (if uidvalidity
+		       "EXAMINE"
+		     ;; If we don't have a UIDVALIDITY, then this is
+		     ;; the first time we've seen the group, so we
+		     ;; have to do a SELECT (which is slower than an
+		     ;; examine), but will tell us whether the group
+		     ;; is read-only or not.
+		     "SELECT")))
+	      (push (list (nnimap-send-command "%s %S" command group)
 			  (nnimap-send-command "UID FETCH %d:* FLAGS" start)
-			  start
-			  (car elem))
+			  start group command)
 		    sequences)))
 	  ;; Some servers apparently can't have many outstanding
 	  ;; commands, so throttle them.
@@ -923,10 +1008,13 @@ textual parts.")
 	     (nnimap-possibly-change-group nil server))
     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
-      (when (nnimap-wait-for-response (cadar sequences))
-	;; Now we should have all the data we need, no matter whether
-	;; we're QRESYNCING, fetching all the flags from scratch, or
-	;; just fetching the last 100 flags per group.
+      (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync)
+					  (caar sequences)
+					(cadar sequences))
+				      t)
+	;; Now we should have most of the data we need, no matter
+	;; whether we're QRESYNCING, fetching all the flags from
+	;; scratch, or just fetching the last 100 flags per group.
 	(nnimap-update-infos (nnimap-flags-to-marks
 			      (nnimap-parse-flags
 			       (nreverse sequences)))
@@ -946,16 +1034,40 @@ textual parts.")
 
 (defun nnimap-update-infos (flags infos)
   (dolist (info infos)
-    (let ((group (gnus-group-real-name (gnus-info-group info))))
-      (nnimap-update-info info (cdr (assoc group flags))))))
+    (let* ((group (gnus-group-real-name (gnus-info-group info)))
+	   (marks (cdr (assoc group flags))))
+      (when marks
+	(nnimap-update-info info marks)))))
 
 (defun nnimap-update-info (info marks)
-  (when marks
-    (destructuring-bind (existing flags high low uidnext start-article
-				  permanent-flags) marks
-      (let ((group (gnus-info-group info))
-	    (completep (and start-article
-			    (= start-article 1))))
+  (destructuring-bind (existing flags high low uidnext start-article
+				permanent-flags uidvalidity
+				vanished highestmodseq) marks
+    (cond
+     ;; Ignore groups with no UIDNEXT/marks.  This happens for
+     ;; completely empty groups.
+     ((and (not existing)
+	   (not uidnext))
+      (let ((active (cdr (assq 'active (gnus-info-params info)))))
+	(when active
+	  (gnus-set-active (gnus-info-group info) active))))
+     ;; We have a mismatch between the old and new UIDVALIDITY
+     ;; identifiers, so we have to re-request the group info (the next
+     ;; time).  This virtually never happens.
+     ((let ((old-uidvalidity
+	     (cdr (assq 'uidvalidity (gnus-info-params info)))))
+	(and old-uidvalidity
+	     (not (equal old-uidvalidity uidvalidity))
+	     (> start-article 1)))
+      (gnus-group-remove-parameter info 'uidvalidity)
+      (gnus-group-remove-parameter info 'modseq))
+     ;; We have the data needed to update.
+     (t
+      (let* ((group (gnus-info-group info))
+	     (completep (and start-article
+			     (= start-article 1)))
+	     (active (or (gnus-active group)
+			 (cdr (assq 'active (gnus-info-params info))))))
 	(when uidnext
 	  (setq high (1- uidnext)))
 	;; First set the active ranges based on high/low.
@@ -968,6 +1080,8 @@ textual parts.")
 			      (uidnext
 			       ;; No articles in this group.
 			       (cons uidnext (1- uidnext)))
+			      (active
+			       active)
 			      (start-article
 			       (cons start-article (1- start-article)))
 			      (t
@@ -975,57 +1089,109 @@ textual parts.")
 			       nil)))
 	  (gnus-set-active
 	   group
-	   (cons (car (gnus-active group))
+	   (cons (car active)
 		 (or high (1- uidnext)))))
-	(when (and (not high)
-		   uidnext)
-	  (setq high (1- uidnext)))
-	;; Then update the list of read articles.
-	(let* ((unread
-		(gnus-compress-sequence
-		 (gnus-set-difference
-		  (gnus-set-difference
-		   existing
-		   (cdr (assoc '%Seen flags)))
-		  (cdr (assoc '%Flagged flags)))))
-	       (read (gnus-range-difference
-		      (cons start-article high) unread)))
-	  (when (> start-article 1)
-	    (setq read
-		  (gnus-range-nconcat
-		   (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.
-	  (setq marks (gnus-info-marks info))
-	  ;; Note the active level for the next run-through.
-	  (let ((active (assq 'active marks)))
-	    (if active
-		(setcdr active (gnus-active group))
-	      (push (cons 'active (gnus-active group)) marks)))
-	  (dolist (type (cdr nnimap-mark-alist))
-	    (let ((old-marks (assoc (car type) marks))
-		  (new-marks
-		   (gnus-compress-sequence
-		    (cdr (or (assoc (caddr type) flags)	    ; %Flagged
-			     (assoc (intern (cadr type) obarray) flags)
-			     (assoc (cadr type) flags)))))) ; "\Flagged"
-	      (setq marks (delq old-marks marks))
-	      (pop old-marks)
-	      (when (and old-marks
-			 (> start-article 1))
-		(setq old-marks (gnus-range-difference
-				 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 t)
-	    (nnimap-store-info info (gnus-active group))))))))
+	;; See whether this is a read-only group.
+	(unless (eq permanent-flags 'not-scanned)
+	  (gnus-group-set-parameter
+	   info 'permanent-flags
+	   (if (memq '%* permanent-flags)
+	       t
+	     nil)))
+	;; Update marks and read articles if this isn't a
+	;; read-only IMAP group.
+	(when (cdr (assq 'permanent-flags (gnus-info-params info)))
+	  (if (and highestmodseq
+		   (not start-article))
+	      ;; We've gotten the data by QRESYNCing.
+	      (nnimap-update-qresync-info
+	       info existing (nnimap-imap-ranges-to-gnus-ranges vanished) flags)
+	    ;; Do normal non-QRESYNC flag updates.
+	    ;; Update the list of read articles.
+	    (let* ((unread
+		    (gnus-compress-sequence
+		     (gnus-set-difference
+		      (gnus-set-difference
+		       existing
+		       (cdr (assoc '%Seen flags)))
+		      (cdr (assoc '%Flagged flags)))))
+		   (read (gnus-range-difference
+			  (cons start-article high) unread)))
+	      (when (> start-article 1)
+		(setq read
+		      (gnus-range-nconcat
+		       (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.
+	      (setq marks (gnus-info-marks info))
+	      (dolist (type (cdr nnimap-mark-alist))
+		(let ((old-marks (assoc (car type) marks))
+		      (new-marks
+		       (gnus-compress-sequence
+			(cdr (or (assoc (caddr type) flags) ; %Flagged
+				 (assoc (intern (cadr type) obarray) flags)
+				 (assoc (cadr type) flags)))))) ; "\Flagged"
+		  (setq marks (delq old-marks marks))
+		  (pop old-marks)
+		  (when (and old-marks
+			     (> start-article 1))
+		    (setq old-marks (gnus-range-difference
+				     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 t)))))
+	;; Note the active level for the next run-through.
+	(gnus-group-set-parameter info 'active (gnus-active group))
+	(gnus-group-set-parameter info 'uidvalidity uidvalidity)
+	(gnus-group-set-parameter info 'modseq highestmodseq)
+	(nnimap-store-info info (gnus-active group)))))))
+
+(defun nnimap-update-qresync-info (info existing vanished flags)
+  ;; Add all the vanished articles to the list of read articles.
+  (gnus-info-set-read
+   info
+   (gnus-range-add (gnus-info-read info)
+		   vanished))
+  (let ((marks (gnus-info-marks info)))
+    (dolist (type (cdr nnimap-mark-alist))
+      (let ((ticks (assoc (car type) marks))
+	    (new-marks
+	     (cdr (or (assoc (caddr type) flags) ; %Flagged
+		      (assoc (intern (cadr type) obarray) flags)
+		      (assoc (cadr type) flags))))) ; "\Flagged"
+	(setq marks (delq ticks marks))
+	(pop ticks)
+	;; Add the new marks we got.
+	(setq ticks (gnus-add-to-range ticks new-marks))
+	;; Remove the marks from messages that don't have them.
+	(setq ticks (gnus-remove-from-range
+		     ticks
+		     (gnus-compress-sequence
+		      (gnus-sorted-complement existing new-marks))))
+	(when ticks
+	  (push (cons (car type) ticks) marks)))
+      (gnus-info-set-marks info marks t))))
+
+(defun nnimap-imap-ranges-to-gnus-ranges (irange)
+  (if (zerop (length irange))
+      nil
+    (let ((result nil))
+      (dolist (elem (split-string irange ","))
+	(push
+	 (if (string-match ":" elem)
+	     (let ((numbers (split-string elem ":")))
+	       (cons (string-to-number (car numbers))
+		     (string-to-number (cadr numbers))))
+	   (string-to-number elem))
+	 result))
+      (nreverse result))))
 
 (defun nnimap-store-info (info active)
   (let* ((group (gnus-group-real-name (gnus-info-group info)))
@@ -1035,13 +1201,17 @@ textual parts.")
       (push (list group info active) nnimap-current-infos))))
 
 (defun nnimap-flags-to-marks (groups)
-  (let (data group totalp uidnext articles start-article mark permanent-flags)
+  (let (data group totalp uidnext articles start-article mark permanent-flags
+	     uidvalidity vanished highestmodseq)
     (dolist (elem groups)
       (setq group (car elem)
 	    uidnext (nth 1 elem)
 	    start-article (nth 2 elem)
 	    permanent-flags (nth 3 elem)
-	    articles (nthcdr 4 elem))
+	    uidvalidity (nth 4 elem)
+	    vanished (nth 5 elem)
+	    highestmodseq (nth 6 elem)
+	    articles (nthcdr 7 elem))
       (let ((high (caar articles))
 	    marks low existing)
 	(dolist (article articles)
@@ -1053,7 +1223,7 @@ textual parts.")
 		(push (list flag (car article)) marks)
 	      (setcdr mark (cons (car article) (cdr mark))))))
 	(push (list group existing marks high low uidnext start-article
-		    permanent-flags)
+		    permanent-flags uidvalidity vanished highestmodseq)
 	      data)))
     data))
 
@@ -1062,38 +1232,69 @@ textual parts.")
   ;; Change \Delete etc to %Delete, so that the reader can read it.
   (subst-char-in-region (point-min) (point-max)
 			?\\ ?% t)
-  (let (start end articles groups uidnext elems permanent-flags)
+  (let (start end articles groups uidnext elems permanent-flags
+	      uidvalidity vanished highestmodseq)
     (dolist (elem sequences)
-      (destructuring-bind (group-sequence flag-sequence totalp group) elem
+      (destructuring-bind (group-sequence flag-sequence totalp group command)
+	  elem
 	(setq start (point))
-	;; The EXAMINE was successful.
-	(when (and (search-forward (format "\n%d OK " group-sequence) nil t)
-		   (progn
-		     (forward-line 1)
-		     (setq end (point))
-		     (goto-char start)
-		     (setq permanent-flags
+	(when (and
+	       ;; The EXAMINE was successful.
+	       (search-forward (format "\n%d OK " group-sequence) nil t)
+	       (progn
+		 (forward-line 1)
+		 (setq end (point))
+		 (goto-char start)
+		 (setq permanent-flags
+		       (if (equal command "SELECT")
 			   (and (search-forward "PERMANENTFLAGS "
-						 (or end (point-min)) t)
-				(read (current-buffer))))
-		     (goto-char start)
-		     (setq uidnext
-			   (and (search-forward "UIDNEXT "
-						 (or end (point-min)) t)
-				(read (current-buffer))))
-		     (goto-char end)
-		     (forward-line -1))
-		   ;; The UID FETCH FLAGS was successful.
-		   (search-forward (format "\n%d OK " flag-sequence) nil t))
-	  (setq start (point))
-	  (goto-char end)
+						(or end (point-min)) t)
+				(read (current-buffer)))
+			 'not-scanned))
+		 (goto-char start)
+		 (setq uidnext
+		       (and (search-forward "UIDNEXT "
+					    (or end (point-min)) t)
+			    (read (current-buffer))))
+		 (goto-char start)
+		 (setq uidvalidity
+		       (and (re-search-forward "UIDVALIDITY \\([0-9]+\\)"
+					       (or end (point-min)) t)
+			    ;; Store UIDVALIDITY as a string, as it's
+			    ;; too big for 32-bit Emacsen, usually.
+			    (match-string 1)))
+		 (goto-char start)
+		 (setq vanished
+		       (and (eq flag-sequence 'qresync)
+			    (re-search-forward "VANISHED.* \\([0-9:,]+\\)"
+					       (or end (point-min)) t)
+			    (match-string 1)))
+		 (goto-char start)
+		 (setq highestmodseq
+		       (and (search-forward "HIGHESTMODSEQ "
+					    (or end (point-min)) t)
+			    (read (current-buffer))))
+		 (goto-char end)
+		 (forward-line -1))
+	       ;; The UID FETCH FLAGS was successful.
+	       (or (eq flag-sequence 'qresync)
+		   (search-forward (format "\n%d OK " flag-sequence) nil t)))
+	  (if (eq flag-sequence 'qresync)
+	      (progn
+		(goto-char start)
+		(setq start end))
+	    (setq start (point))
+	    (goto-char end))
 	  (while (search-forward " FETCH " start t)
 	    (setq elems (read (current-buffer)))
 	    (push (cons (cadr (memq 'UID elems))
 			(cadr (memq 'FLAGS elems)))
 		  articles))
-	  (push (nconc (list group uidnext totalp permanent-flags) articles)
+	  (push (nconc (list group uidnext totalp permanent-flags uidvalidity
+			     vanished highestmodseq)
+		       articles)
 		groups)
+	  (goto-char end)
 	  (setq articles nil))))
     groups))
 
@@ -1178,30 +1379,38 @@ textual parts.")
     (goto-char (point-min))
     (while (and (memq (process-status process)
 		      '(open run))
-		(not (re-search-forward "^\\* .*\n" nil t)))
+		(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]+\\)")
+    (and (looking-at "[*.] \\([A-Z0-9]+\\)")
 	 (match-string 1))))
 
 (defun nnimap-wait-for-response (sequence &optional messagep)
   (let ((process (get-buffer-process (current-buffer)))
 	openp)
-    (goto-char (point-max))
-    (while (and (setq openp (memq (process-status process)
-				  '(open run)))
-		(not (re-search-backward
-		      (format "^%d .*\n" sequence)
-		      (if nnimap-streaming
-			  (max (point-min) (- (point) 500))
-			(point-min))
-		      t)))
-      (when messagep
-	(message "Read %dKB" (/ (buffer-size) 1000)))
-      (nnheader-accept-process-output process)
-      (goto-char (point-max)))
-    openp))
+    (condition-case nil
+        (progn
+	  (goto-char (point-max))
+	  (while (and (setq openp (memq (process-status process)
+					'(open run)))
+		      (not (re-search-backward
+			    (format "^%d .*\n" sequence)
+			    (if nnimap-streaming
+				(max (point-min) (- (point) 500))
+			      (point-min))
+			    t)))
+	    (when messagep
+	      (message "nnimap read %dk" (/ (buffer-size) 1000)))
+	    (nnheader-accept-process-output process)
+	    (goto-char (point-max)))
+          openp)
+      (quit
+       ;; The user hit C-g while we were waiting: kill the process, in case
+       ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
+       ;; NAT routers).
+       (delete-process process)
+       nil))))
 
 (defun nnimap-parse-response ()
   (let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
@@ -1227,13 +1436,15 @@ textual parts.")
 	  (push
 	   (cond
 	    ((eql char ?\[)
-	     (split-string (buffer-substring
-			    (1+ (point))
-			    (1- (search-forward "]" (line-end-position) 'move)))))
+	     (split-string
+	      (buffer-substring
+	       (1+ (point))
+	       (1- (search-forward "]" (line-end-position) 'move)))))
 	    ((eql char ?\()
-	     (split-string (buffer-substring
-			    (1+ (point))
-			    (1- (search-forward ")" (line-end-position) 'move)))))
+	     (split-string
+	      (buffer-substring
+	       (1+ (point))
+	       (1- (search-forward ")" (line-end-position) 'move)))))
 	    ((eql char ?\")
 	     (forward-char 1)
 	     (buffer-substring
@@ -1291,7 +1502,11 @@ textual parts.")
 (defun nnimap-split-incoming-mail ()
   (with-current-buffer (nnimap-buffer)
     (let ((nnimap-incoming-split-list nil)
-	  (nnmail-split-methods nnimap-split-methods)
+	  (nnmail-split-methods (if (eq nnimap-split-methods 'default)
+				    nnmail-split-methods
+				  nnimap-split-methods))
+	  (nnmail-split-fancy (or nnimap-split-fancy
+				  nnmail-split-fancy))
 	  (nnmail-inhibit-default-split-group t)
 	  (groups (nnimap-get-groups))
 	  new-articles)