Get credentials for numerical equivalents of the port numbers.

[gnus] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 548b6ec..4c3eaac 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -29,6 +29,11 @@
 (eval-and-compile
   (require 'nnheader))
 
 (eval-and-compile
   (require 'nnheader))
 

+(eval-when-compile
+  (require 'cl))
+
+(require 'netrc)
+

 (nnoo-declare nnimap)
 
 (defvoo nnimap-address nil
 (nnoo-declare nnimap)
 
 (defvoo nnimap-address nil


@@ -43,6 +48,12 @@ it will default to `imap'.")
   "How nnimap will talk to the IMAP server.
 Values are `ssl' and `network'.")
 
   "How nnimap will talk to the IMAP server.
 Values are `ssl' and `network'.")
 

+(defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
+                                (if (listp imap-shell-program)
+                                    (car imap-shell-program)
+                                  imap-shell-program)
+                              "ssh %s imapd"))
+

 (defvoo nnimap-inbox nil
   "The mail box where incoming mail arrives and should be split out of.")
 
 (defvoo nnimap-inbox nil
   "The mail box where incoming mail arrives and should be split out of.")
 


@@ -52,6 +63,9 @@ 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)
 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 "")
 (defvar nnimap-process nil)
 
 (defvar nnimap-status-string "")


@@ -60,7 +74,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
   "Internal variable with default value for `nnimap-split-download-body'.")
 
 (defstruct nnimap

-  group process commands capabilities)
+  group process commands capabilities select-result)

 
 (defvar nnimap-object nil)
 
 
 (defvar nnimap-object nil)
 


@@ -80,11 +94,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-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 

-(defmacro nnimap-with-process-buffer (&rest body)
-  `(with-current-buffer (nnimap-find-process-buffer (current-buffer))
-     ,@body))
-
-(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)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (when (nnimap-possibly-change-group group server)


@@ -95,9 +105,9 @@ not done by default on servers that doesn't support that command.")
         (nnimap-send-command
          "UID FETCH %s %s"
          (nnimap-article-ranges (gnus-compress-sequence articles))
         (nnimap-send-command
          "UID FETCH %s %s"
          (nnimap-article-ranges (gnus-compress-sequence articles))

-         (format "(UID RFC822.SIZE %s)"
+         (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"

                  (format
                  (format

-                  (if (member "IMAP4rev1"
+                  (if (member "IMAP4REV1"

                               (nnimap-capabilities nnimap-object))
                       "BODY.PEEK[HEADER.FIELDS %s]"
                     "RFC822.HEADER.LINES %s")
                               (nnimap-capabilities nnimap-object))
                       "BODY.PEEK[HEADER.FIELDS %s]"
                     "RFC822.HEADER.LINES %s")


@@ -112,7 +122,7 @@ not done by default on servers that doesn't support that command.")
 
 (defun nnimap-transform-headers ()
   (goto-char (point-min))
 
 (defun nnimap-transform-headers ()
   (goto-char (point-min))

-  (let (article bytes)
+  (let (article bytes lines)

     (block nil
       (while (not (eobp))
        (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
     (block nil
       (while (not (eobp))
        (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))


@@ -120,11 +130,21 @@ not done by default on servers that doesn't support that command.")
          (when (eobp)
            (return)))
        (setq article (match-string 1)
          (when (eobp)
            (return)))
        (setq article (match-string 1)

-             bytes (nnimap-get-length))
+             bytes (nnimap-get-length)
+             lines nil)
+       (beginning-of-line)
+       (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
+         (let ((structure (ignore-errors (read (current-buffer)))))
+           (while (and (consp structure)
+                       (not (stringp (car structure))))
+             (setq structure (car structure)))
+           (setq lines (nth 7 structure))))

        (delete-region (line-beginning-position) (line-end-position))
        (insert (format "211 %s Article retrieved." article))
        (forward-line 1)
        (insert (format "Bytes: %d\n" bytes))
        (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 lines
+         (insert (format "Lines: %s\n" lines)))

        (re-search-forward "^\r$")
        (delete-region (line-beginning-position) (line-end-position))
        (insert ".")
        (re-search-forward "^\r$")
        (delete-region (line-beginning-position) (line-end-position))
        (insert ".")


@@ -150,7 +170,7 @@ not done by default on servers that doesn't support that command.")
         result))
       (mapconcat #'identity (nreverse result) ",")))))
 
         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)
   (if (nnimap-server-opened server)
       t
     (unless (assq 'nnimap-address defs)


@@ -172,40 +192,75 @@ not done by default on servers that doesn't support that command.")
     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (current-buffer)))
 
     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (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))
+
+(defun nnimap-credentials (address &rest 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)
 (defun nnimap-open-connection (buffer)
   (with-current-buffer (nnimap-make-process-buffer buffer)

-    (let ((credentials
-          (cond
-           ((eq nnimap-stream 'network)
-            (open-network-stream "*nnimap*" (current-buffer) nnimap-address
-                                 (or nnimap-server-port "imap"))
-            (netrc-credentials nnimap-address "imap"))
-           ((eq nnimap-stream 'ssl)
-            (open-tls-stream "*nnimap*" (current-buffer) nnimap-address
-                             (or nnimap-server-port "imaps"))
-            (netrc-credentials nnimap-address "imaps" "imap")))))
+    (let* ((coding-system-for-read 'binary)
+          (coding-system-for-write 'binary)
+          (credentials
+           (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")))
+             (nnimap-credentials nnimap-address "143" "imap"))
+            ((eq nnimap-stream 'stream)
+             (nnimap-open-shell-stream
+              "*nnimap*" (current-buffer) nnimap-address
+              (or nnimap-server-port "imap"))
+             (nnimap-credentials nnimap-address "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")))
+             (nnimap-credentials nnimap-address "143" "993" "imap" "imaps")))))

       (setf (nnimap-process nnimap-object)
            (get-buffer-process (current-buffer)))
       (unless credentials
       (setf (nnimap-process nnimap-object)
            (get-buffer-process (current-buffer)))
       (unless credentials

-       (delete-process (nnimap-process nnimap-object))
-       (error "Can't find user name/password for %s" nnimap-address))
+       (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))))
       (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))))

-         (unless (car result)
-           (delete-process (nnimap-process nnimap-object))
-           (error "Unable to login to the server: %s"
-                  (mapconcat #'identity (cadr result) " ")))
-         (setf (nnimap-capabilities nnimap-object)
-               (or (nnimap-find-parameter "CAPABILITY" (cdr result))
-                   (nnimap-find-parameter
-                    "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
-         (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
-           (nnimap-command "ENABLE QRESYNC"))
-         t)))))
+         (if (not (car result))
+             (progn
+               (delete-process (nnimap-process nnimap-object))
+               nil)
+           (setf (nnimap-capabilities nnimap-object)
+                 (mapcar
+                  #'upcase
+                  (or (nnimap-find-parameter "CAPABILITY" (cdr result))
+                      (nnimap-find-parameter
+                       "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
+           (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
+             (nnimap-command "ENABLE QRESYNC"))
+           t))))))

 
 (defun nnimap-find-parameter (parameter elems)
   (let (result)
 
 (defun nnimap-find-parameter (parameter elems)
   (let (result)


@@ -219,22 +274,22 @@ not done by default on servers that doesn't support that command.")
        (setq result (cdr (cadr elem))))))
     result))
 
        (setq result (cdr (cadr elem))))))
     result))
 

-(defun nnimap-close-server (&optional server)
+(deffoo nnimap-close-server (&optional server)

   t)
 
   t)
 

-(defun nnimap-request-close ()
+(deffoo nnimap-request-close ()

   t)
 
   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)))
 
   (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)
 
   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)))
       (when (stringp article)
   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server)))
       (when (stringp article)


@@ -242,14 +297,14 @@ not done by default on servers that doesn't support that command.")
       (when (and result
                 article)
        (erase-buffer)
       (when (and result
                 article)
        (erase-buffer)

-       (nnimap-with-process-buffer
-        (erase-buffer)
-        (setq result
-              (nnimap-command
-               (if (member "IMAP4rev1" (nnimap-capabilities nnimap-object))
-                   "UID FETCH %d BODY.PEEK[]"
-                 "UID FETCH %d RFC822.PEEK")
-               article)))
+       (with-current-buffer (nnimap-buffer)
+         (erase-buffer)
+         (setq result
+               (nnimap-command
+                (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
+                    "UID FETCH %d BODY.PEEK[]"
+                  "UID FETCH %d RFC822.PEEK")
+                article)))

        (let ((buffer (nnimap-find-process-buffer (current-buffer))))
          (when (car result)
            (with-current-buffer to-buffer
        (let ((buffer (nnimap-find-process-buffer (current-buffer))))
          (when (car result)
            (with-current-buffer to-buffer


@@ -263,20 +318,39 @@ not done by default on servers that doesn't support that command.")
                (nnheader-ms-strip-cr))
              t)))))))
 
                (nnheader-ms-strip-cr))
              t)))))))
 

-(defun nnimap-request-group (group &optional server dont-check)
+(deffoo nnimap-request-group (group &optional server dont-check info)

   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))
   (with-current-buffer nntp-server-buffer
     (let ((result (nnimap-possibly-change-group group server))

-         articles)
+         articles active marks)

       (when result
       (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)))
+                 (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)))))
+         (erase-buffer)
+         (let ((high (nth 3 (car marks)))
+               (low (nth 4 (car marks))))
+           (insert
+            (format
+             "211 %d %d %d %S\n"
+             (1+ (- high low))
+             low high group))))

        t))))
 
 (defun nnimap-get-flags (spec)
        t))))
 
 (defun nnimap-get-flags (spec)


@@ -294,7 +368,7 @@ not done by default on servers that doesn't support that command.")
              articles)))
     (nreverse articles)))
 
              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
   t)
 
 (deffoo nnimap-request-move-article (article group server accept-form


@@ -366,10 +440,10 @@ not done by default on servers that doesn't support that command.")
        (push flag flags)))
     flags))
 
        (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)
   (when (nnimap-possibly-change-group group server)
     (let (sequence)

-      (with-current-buffer (nnimap-find-process-buffer nntp-server-buffer)
+      (with-current-buffer (nnimap-buffer)

        ;; Just send all the STORE commands without waiting for
        ;; response.  If they're successful, they're successful.
        (dolist (action actions)
        ;; Just send all the STORE commands without waiting for
        ;; response.  If they're successful, they're successful.
        (dolist (action actions)


@@ -393,17 +467,16 @@ not done by default on servers that doesn't support that command.")
     (let ((message (buffer-string))
          (message-id (message-field-value "message-id"))
          sequence)
     (let ((message (buffer-string))
          (message-id (message-field-value "message-id"))
          sequence)

-      (with-current-buffer nntp-server-buffer
-       (nnimap-with-process-buffer
-        (setq sequence (nnimap-send-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")
-        (let ((result (nnimap-get-response sequence)))
-          (when result
-            (cons group
-                  (nnimap-find-article-by-message-id group message-id)))))))))
+      (with-current-buffer (nnimap-buffer)
+       (setq sequence (nnimap-send-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")
+       (let ((result (nnimap-get-response sequence)))
+         (when result
+           (cons group
+                 (nnimap-find-article-by-message-id group message-id))))))))

 
 (defun nnimap-add-cr ()
   (goto-char (point-min))
 
 (defun nnimap-add-cr ()
   (goto-char (point-min))


@@ -416,27 +489,28 @@ not done by default on servers that doesn't support that command.")
     (when (car result)
       (dolist (line (cdr result))
        (when (and (equal (car line) "LIST")
     (when (car result)
       (dolist (line (cdr result))
        (when (and (equal (car line) "LIST")

-                  (not (string-match "noselect" (caadr line))))
+                  (not (and (caadr line)
+                            (string-match "noselect" (caadr line)))))

          (push (car (last line)) groups)))
       (nreverse groups))))
 
          (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)
     (let ((groups
   (nnimap-possibly-change-group nil server)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
     (let ((groups

-          (nnimap-with-process-buffer
-           (nnimap-get-groups)))
+          (with-current-buffer (nnimap-buffer)
+            (nnimap-get-groups)))

          sequences responses)
       (when groups
          sequences responses)
       (when groups

-       (nnimap-with-process-buffer
-        (dolist (group groups)
-          (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
-                      group)
-                sequences))
-        (nnimap-wait-for-response (caar sequences))
-        (setq responses
-              (nnimap-get-responses (mapcar #'car sequences))))
+       (with-current-buffer (nnimap-buffer)
+         (dolist (group groups)
+           (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
+                       group)
+                 sequences))
+         (nnimap-wait-for-response (caar sequences))
+         (setq responses
+               (nnimap-get-responses (mapcar #'car sequences))))

        (dolist (response responses)
          (let* ((sequence (car response))
                 (response (cadr response))
        (dolist (response responses)
          (let* ((sequence (car response))
                 (response (cadr response))


@@ -450,16 +524,20 @@ not done by default on servers that doesn't support that command.")
                    (setq exists (string-to-number (car elem)))))
                (when uidnext
                  (setq highest (1- (string-to-number (car uidnext)))))
                    (setq exists (string-to-number (car elem)))))
                (when uidnext
                  (setq highest (1- (string-to-number (car uidnext)))))

-               (if (zerop exists)
-                   ;; Empty group.
-                   (insert (format "%S %d %d y\n"
-                                   (utf7-decode group t) highest (1+ highest)))
+               (cond
+                ((null highest)
+                 (insert (format "%S 0 1 y\n" (utf7-decode group t))))
+                ((zerop exists)
+                 ;; Empty group.
+                 (insert (format "%S %d %d y\n"
+                                 (utf7-decode group t) highest (1+ highest))))
+                (t

                  ;; Return the widest possible range.
                  (insert (format "%S %d 1 y\n" (utf7-decode group t)
                  ;; Return the widest possible range.
                  (insert (format "%S %d 1 y\n" (utf7-decode group t)

-                                 (or highest exists))))))))
+                                 (or highest exists)))))))))

        t))))
 
        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.
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
       ;; QRESYNC handling isn't implemented.


@@ -499,8 +577,9 @@ not done by default on servers that doesn't support that command.")
                    sequences))))
        sequences))))
 
                    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))
     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
       (nnimap-wait-for-response (cadar sequences))


@@ -524,7 +603,8 @@ not done by default on servers that doesn't support that command.")
            (completep (and start-article
                            (= start-article 1))))
        ;; First set the active ranges based on high/low.
            (completep (and start-article
                            (= start-article 1))))
        ;; First set the active ranges based on high/low.

-       (if completep
+       (if (or completep
+               (not (gnus-active group)))

            (gnus-set-active group
                             (if high
                                 (cons low high)
            (gnus-set-active group
                             (if high
                                 (cons low high)


@@ -570,7 +650,15 @@ not done by default on servers that doesn't support that command.")
                (setq new-marks (gnus-range-nconcat old-marks new-marks)))
              (when new-marks
                (push (cons (car type) new-marks) marks)))
                (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)
+           (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)
 
 (defun nnimap-flags-to-marks (groups)
   (let (data group totalp uidnext articles start-article mark)


@@ -624,23 +712,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-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)
   (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."
 
 (defun nnimap-find-connection (buffer)
   "Find the connection delivering to BUFFER."


@@ -768,7 +862,7 @@ not done by default on servers that doesn't support that command.")
     (nnimap-article-ranges articles)
     (format "(UID %s%s)"
            (format
     (nnimap-article-ranges articles)
     (format "(UID %s%s)"
            (format

-            (if (member "IMAP4rev1"
+            (if (member "IMAP4REV1"

                         (nnimap-capabilities nnimap-object))
                 "BODY.PEEK[HEADER] BODY.PEEK"
               "RFC822.PEEK"))
                         (nnimap-capabilities nnimap-object))
                 "BODY.PEEK[HEADER] BODY.PEEK"
               "RFC822.PEEK"))