(nnimap-transform-headers): Simplify regexp to hopefully avoid regexp overflow.
[gnus] / lisp / nnimap.el
index e0804f8..e2953ff 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)
@@ -182,7 +190,7 @@ textual parts.")
   (let (article bytes lines size string)
     (block nil
       (while (not (eobp))
-       (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
+       (while (not (looking-at "\\* [0-9]+ FETCH.+UID [0-9]+"))
          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))
@@ -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,9 +348,7 @@ textual parts.")
           (port nil)
           (ports
            (cond
-            ((or (eq nnimap-stream 'network)
-                 (eq nnimap-stream 'network-only)
-                 (eq nnimap-stream 'starttls))
+            ((memq nnimap-stream '(network plain starttls))
              (nnheader-message 7 "Opening connection to %s..."
                                nnimap-address)
              '("imap" "143"))
@@ -355,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)
@@ -397,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)
@@ -522,10 +545,9 @@ textual parts.")
                  (nnimap-get-whole-article article))
            (let ((buffer (current-buffer)))
              (with-current-buffer (or to-buffer nntp-server-buffer)
-               (erase-buffer)
-               (insert-buffer-substring buffer)
-               (nnheader-ms-strip-cr)
-               (cons group article)))))))))
+               (nnheader-insert-buffer-substring buffer)
+               (nnheader-ms-strip-cr)))
+           (cons group article)))))))
 
 (deffoo nnimap-request-head (article &optional group server to-buffer)
   (when (nnimap-possibly-change-group group server)
@@ -1762,11 +1784,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 ()
@@ -1878,7 +1904,7 @@ textual parts.")
   (let (article bytes)
     (block nil
       (while (not (eobp))
-       (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
+       (while (not (looking-at "\\* [0-9]+ FETCH.+UID [0-9]+"))
          (delete-region (point) (progn (forward-line 1) (point)))
          (when (eobp)
            (return)))