Add nnimap-user to nnimap.el.
[gnus] / lisp / nnimap.el
index 1a2bb6f..f819c17 100644 (file)
   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 
 (eval-and-compile
-  (require 'nnheader))
+  (require 'nnheader)
+  ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
+  ;; `make-network-stream'.
+  (unless (fboundp 'open-protocol-stream)
+    (require 'proto-stream)))
 
 (eval-when-compile
   (require 'cl))
@@ -45,7 +49,6 @@
 (require 'tls)
 (require 'parse-time)
 (require 'nnmail)
-(require 'proto-stream)
 
 (autoload 'auth-source-forget+ "auth-source")
 (autoload 'auth-source-search "auth-source")
 (defvoo nnimap-address nil
   "The address of the IMAP server.")
 
+(defvoo nnimap-user nil
+  "Username to use for authentication to the IMAP server.")
+
 (defvoo nnimap-server-port nil
   "The IMAP port used.
 If nnimap-stream is `ssl', this will default to `imaps'.  If not,
 it will default to `imap'.")
 
 (defvoo nnimap-stream 'undecided
-  "How nnimap will talk to the IMAP server.
-Values are `ssl', `network', `network-only, `starttls' or
-`shell'.  The default is to try `ssl' first, and then
-`network'.")
+  "How nnimap talks to the IMAP server.
+The value should be either `undecided', `ssl' or `tls',
+`network', `starttls', `plain', or `shell'.
+
+If the value is `undecided', nnimap tries `ssl' first, then falls
+back on `network'.")
 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)
@@ -278,13 +286,14 @@ textual parts.")
     (push (current-buffer) nnimap-process-buffers)
     (current-buffer)))
 
-(defun nnimap-credentials (address ports)
+(defun nnimap-credentials (address ports user)
   (let* ((auth-source-creation-prompts
           '((user  . "IMAP user at %h: ")
             (secret . "IMAP password for %u@%h: ")))
          (found (nth 0 (auth-source-search :max 1
                                            :host address
                                            :port ports
+                                           :user user
                                            :require '(:user :secret)
                                            :create t))))
     (if found
@@ -339,8 +348,7 @@ textual parts.")
           (port nil)
           (ports
            (cond
-            ((or (eq nnimap-stream 'network)
-                 (eq nnimap-stream 'starttls))
+            ((memq nnimap-stream '(network plain starttls))
              (nnheader-message 7 "Opening connection to %s..."
                                nnimap-address)
              '("imap" "143"))
@@ -354,21 +362,29 @@ textual parts.")
              '("imaps" "imap" "993" "143"))
             (t
              (error "Unknown stream type: %s" nnimap-stream))))
-          (proto-stream-always-use-starttls t)
            login-result credentials)
       (when nnimap-server-port
        (push nnimap-server-port ports))
-      (destructuring-bind (stream greeting capabilities stream-type)
-         (open-protocol-stream
-          "*nnimap*" (current-buffer) nnimap-address (car ports)
-          :type nnimap-stream
-          :shell-command nnimap-shell-program
-          :capability-command "1 CAPABILITY\r\n"
-          :success " OK "
-          :starttls-function
-          (lambda (capabilities)
-            (when (gnus-string-match-p "STARTTLS" capabilities)
-              "1 STARTTLS\r\n")))
+      (let* ((stream-list
+             (open-protocol-stream
+              "*nnimap*" (current-buffer) nnimap-address (car ports)
+              :type nnimap-stream
+              :return-list t
+              :shell-command nnimap-shell-program
+              :capability-command "1 CAPABILITY\r\n"
+              :end-of-command "\r\n"
+              :success " OK "
+              :starttls-function
+              (lambda (capabilities)
+                (when (gnus-string-match-p "STARTTLS" capabilities)
+                  "1 STARTTLS\r\n"))))
+            (stream (car stream-list))
+            (props (cdr stream-list))
+            (greeting (plist-get props :greeting))
+            (capabilities (plist-get props :capabilities))
+            (stream-type (plist-get props :type)))
+       (when (and stream (not (memq (process-status stream) '(open run))))
+         (setq stream nil))
        (setf (nnimap-process nnimap-object) stream)
        (setf (nnimap-stream-type nnimap-object) stream-type)
        (if (not stream)
@@ -396,17 +412,25 @@ textual parts.")
                                 (list
                                  nnimap-address
                                  (nnoo-current-server 'nnimap)))
-                                ports))))
+                                ports
+                                nnimap-user))))
                  (setq nnimap-object nil)
                (let ((nnimap-inhibit-logging t))
                  (setq login-result
                        (nnimap-login (car credentials) (cadr credentials))))
                (if (car login-result)
-                    ;; save the credentials if a save function exists
+                   (progn
+                    ;; Save the credentials if a save function exists
                     ;; (such a function will only be passed if a new
-                    ;; token was created)
-                    (when (functionp (nth 2 credentials))
-                      (funcall (nth 2 credentials)))
+                    ;; token was created).
+                     (when (functionp (nth 2 credentials))
+                       (funcall (nth 2 credentials)))
+                     ;; See if CAPABILITY is set as part of login
+                     ;; response.
+                     (dolist (response (cddr login-result))
+                       (when (string= "CAPABILITY" (upcase (car response)))
+                         (setf (nnimap-capabilities nnimap-object)
+                               (mapcar #'upcase (cdr response))))))
                  ;; If the login failed, then forget the credentials
                  ;; that are now possibly cached.
                  (dolist (host (list (nnoo-current-server 'nnimap)
@@ -1452,8 +1476,8 @@ textual parts.")
   ;; Change \Delete etc to %Delete, so that the reader can read it.
   (subst-char-in-region (point-min) (point-max)
                        ?\\ ?% t)
-  ;; Remove any MODSEQ entries in the buffer, because they may
-  ;; contain numbers that are too large for 32-bit Emacsen.
+  ;; Remove any MODSEQ entries in the buffer, because they may contain
+  ;; numbers that are too large for 32-bit Emacsen.
   (while (re-search-forward " MODSEQ ([0-9]+)" nil t)
     (replace-match "" t t))
   (goto-char (point-min))
@@ -1496,9 +1520,9 @@ textual parts.")
                            (match-string 1)))
                 (goto-char start)
                 (setq highestmodseq
-                      (and (search-forward "HIGHESTMODSEQ "
+                      (and (re-search-forward "HIGHESTMODSEQ \\([0-9]+\\)"
                                            (or end (point-min)) t)
-                           (read (current-buffer))))
+                           (match-string 1)))
                 (goto-char end)
                 (forward-line -1))
               ;; The UID FETCH FLAGS was successful.
@@ -1761,11 +1785,15 @@ textual parts.")
     (format "(UID %s%s)"
            (format
             (if (nnimap-ver4-p)
-                "BODY.PEEK[HEADER] BODY.PEEK"
+                "BODY.PEEK"
               "RFC822.PEEK"))
-           (if nnimap-split-download-body-default
-               "[]"
-             "[1]")))
+           (cond
+            (nnimap-split-download-body-default
+             "[]")
+            ((nnimap-ver4-p)
+             "[HEADER]")
+            (t
+             "[1]"))))
    t))
 
 (defun nnimap-split-incoming-mail ()