Get credentials for numerical equivalents of the port numbers.

[gnus] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index e7bf0f3..4c3eaac 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -63,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)
+
+(defvoo nnimap-current-infos nil)
+
 (defvar nnimap-process nil)
 
 (defvar nnimap-status-string "")
@@ -71,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
-  group process commands capabilities)
+  group process commands capabilities select-result)
 
 (defvar nnimap-object nil)
 
@@ -91,7 +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-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)
@@ -167,7 +170,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)
@@ -199,6 +202,17 @@ not done by default on servers that doesn't support that command.")
                                  ?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)
     (let* ((coding-system-for-read 'binary)
@@ -211,25 +225,19 @@ not done by default on servers that doesn't support that command.")
                                       (if (netrc-find-service-number "imap")
                                           "imap"
                                         "143")))
-             (auth-source-user-or-password
-              '("login" "password") nnimap-address "imap" nil t))
+             (nnimap-credentials nnimap-address "143" "imap"))
             ((eq nnimap-stream 'stream)
              (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))
+             (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")))
-             (or
-              (auth-source-user-or-password
-               '("login" "password") nnimap-address "imap")
-              (auth-source-user-or-password
-               '("login" "password") nnimap-address "imaps" nil t))))))
+             (nnimap-credentials nnimap-address "143" "993" "imap" "imaps")))))
       (setf (nnimap-process nnimap-object)
            (get-buffer-process (current-buffer)))
       (unless credentials
@@ -266,22 +274,22 @@ 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)))
       (when (stringp article)
@@ -310,20 +318,39 @@ not done by default on servers that doesn't support that command.")
                (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))
-         articles)
+         articles active marks)
       (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)
@@ -341,7 +368,7 @@ 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
@@ -413,7 +440,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)
@@ -467,7 +494,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 +537,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,7 +577,7 @@ not done by default on servers that doesn't support that command.")
                    sequences))))
        sequences))))
 
-(defun nnimap-finish-retrieve-group-infos (server infos sequences)
+(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
   (when (and sequences
             (nnimap-possibly-change-group nil server))
     (with-current-buffer (nnimap-buffer)
@@ -623,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)))
-           (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)
@@ -677,7 +712,7 @@ 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)
 
@@ -697,7 +732,8 @@ not done by default on servers that doesn't support that command.")
            t
          (let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
            (when (car result)
-             (setf (nnimap-group nnimap-object) group)
+             (setf (nnimap-group nnimap-object) group
+                   (nnimap-select-result nnimap-object) result)
              result))))))))
 
 (defun nnimap-find-connection (buffer)