* mm-view.el (mml-smime): Require.

[gnus] / lisp / nnimap.el

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 775b1bc..1899b0e 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -1,6 +1,6 @@
 ;;; nnimap.el --- IMAP interface for Gnus
 
 ;;; nnimap.el --- IMAP interface for Gnus
 

-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Simon Josefsson <simon@josefsson.org>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         Simon Josefsson <simon@josefsson.org>


@@ -26,6 +26,10 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+

 (eval-and-compile
   (require 'nnheader))
 
 (eval-and-compile
   (require 'nnheader))
 


@@ -40,6 +44,8 @@
 (require 'utf7)
 (require 'tls)
 (require 'parse-time)
 (require 'utf7)
 (require 'tls)
 (require 'parse-time)

+(require 'nnmail)
+(require 'proto-stream)

 
 (autoload 'auth-source-forget-user-or-password "auth-source")
 (autoload 'auth-source-user-or-password "auth-source")
 
 (autoload 'auth-source-forget-user-or-password "auth-source")
 (autoload 'auth-source-user-or-password "auth-source")


@@ -54,9 +60,10 @@
 If nnimap-stream is `ssl', this will default to `imaps'.  If not,
 it will default to `imap'.")
 
 If nnimap-stream is `ssl', this will default to `imaps'.  If not,
 it will default to `imap'.")
 

-(defvoo nnimap-stream 'ssl
+(defvoo nnimap-stream 'undecided

   "How nnimap will talk to the IMAP server.
   "How nnimap will talk to the IMAP server.

-Values are `ssl', `network', `starttls' or `shell'.")
+Values are `ssl', `network', `starttls' or `shell'.
+The default is to try `ssl' first, and then `network'.")

 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)
 
 (defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
                                 (if (listp imap-shell-program)


@@ -74,6 +81,9 @@ Uses the same syntax as nnmail-split-methods")
 (defvoo nnimap-split-fancy nil
   "Uses the same syntax as nnmail-split-fancy.")
 
 (defvoo nnimap-split-fancy nil
   "Uses the same syntax as nnmail-split-fancy.")
 

+(defvoo nnimap-unsplittable-articles '(%Deleted %Seen)
+  "Articles with the flags in the list will not be considered when splitting.")
+

 (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
                        "Emacs 24.1")
 
 (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
                        "Emacs 24.1")
 


@@ -114,7 +124,7 @@ textual parts.")
 
 (defstruct nnimap
   group process commands capabilities select-result newlinep server
 
 (defstruct nnimap
   group process commands capabilities select-result newlinep server

-  last-command-time greeting)
+  last-command-time greeting examined)

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


@@ -129,9 +139,22 @@ textual parts.")
     (download "gnus-download")
     (forward "gnus-forward")))
 
     (download "gnus-download")
     (forward "gnus-forward")))
 

+(defvar nnimap-quirks
+  '(("QRESYNC" "Zimbra" "QRESYNC ")))
+

 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 
 (defun nnimap-buffer ()
   (nnimap-find-process-buffer nntp-server-buffer))
 

+(defun nnimap-header-parameters ()
+  (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
+         (format
+          (if (nnimap-ver4-p)
+              "BODY.PEEK[HEADER.FIELDS %s]"
+            "RFC822.HEADER.LINES %s")
+          (append '(Subject From Date Message-Id
+                            References In-Reply-To Xref)
+                  nnmail-extra-headers))))
+

 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)
 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
   (with-current-buffer nntp-server-buffer
     (erase-buffer)


@@ -142,16 +165,10 @@ textual parts.")
         (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 BODYSTRUCTURE %s)"
-                 (format
-                  (if (nnimap-ver4-p)
-                      "BODY.PEEK[HEADER.FIELDS %s]"
-                    "RFC822.HEADER.LINES %s")
-                  (append '(Subject From Date Message-Id
-                                    References In-Reply-To Xref)
-                          nnmail-extra-headers))))
+         (nnimap-header-parameters))

         t)
         t)

-       (nnimap-transform-headers))
+       (nnimap-transform-headers)
+       (nnheader-remove-cr-followed-by-lf))

       (insert-buffer-substring
        (nnimap-find-process-buffer (current-buffer))))
     'headers))
       (insert-buffer-substring
        (nnimap-find-process-buffer (current-buffer))))
     'headers))


@@ -167,11 +184,12 @@ textual parts.")
            (return)))
        (setq article (match-string 1))
        ;; Unfold quoted {number} strings.
            (return)))
        (setq article (match-string 1))
        ;; Unfold quoted {number} strings.

-       (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n"
+       (while (re-search-forward "[^]][ (]{\\([0-9]+\\)}\r?\n"

                                  (1+ (line-end-position)) t)
          (setq size (string-to-number (match-string 1)))
          (delete-region (+ (match-beginning 0) 2) (point))
                                  (1+ (line-end-position)) t)
          (setq size (string-to-number (match-string 1)))
          (delete-region (+ (match-beginning 0) 2) (point))

-         (setq string (delete-region (point) (+ (point) size)))
+         (setq string (buffer-substring (point) (+ (point) size)))
+         (delete-region (point) (+ (point) size))

          (insert (format "%S" string)))
        (setq bytes (nnimap-get-length)
              lines nil)
          (insert (format "%S" string)))
        (setq bytes (nnimap-get-length)
              lines nil)


@@ -196,11 +214,22 @@ textual parts.")
          (insert (format "Chars: %s\n" size)))
        (when lines
          (insert (format "Lines: %s\n" lines)))
          (insert (format "Chars: %s\n" size)))
        (when lines
          (insert (format "Lines: %s\n" lines)))

-       (re-search-forward "^\r$")
+       (unless (re-search-forward "^\r$" nil t)
+         (goto-char (point-max)))

        (delete-region (line-beginning-position) (line-end-position))
        (insert ".")
        (forward-line 1)))))
 
        (delete-region (line-beginning-position) (line-end-position))
        (insert ".")
        (forward-line 1)))))
 

+(defun nnimap-unfold-quoted-lines ()
+  ;; Unfold quoted {number} strings.
+  (let (size string)
+    (while (re-search-forward " {\\([0-9]+\\)}\r?\n" nil t)
+      (setq size (string-to-number (match-string 1)))
+      (delete-region (1+ (match-beginning 0)) (point))
+      (setq string (buffer-substring (point) (+ (point) size)))
+      (delete-region (point) (+ (point) size))
+      (insert (format "%S" string)))))
+

 (defun nnimap-get-length ()
   (and (re-search-forward "{\\([0-9]+\\)}" (line-end-position) t)
        (string-to-number (match-string 1))))
 (defun nnimap-get-length ()
   (and (re-search-forward "{\\([0-9]+\\)}" (line-end-position) t)
        (string-to-number (match-string 1))))


@@ -245,16 +274,6 @@ textual parts.")
     (push (current-buffer) nnimap-process-buffers)
     (current-buffer)))
 
     (push (current-buffer) nnimap-process-buffers)
     (current-buffer)))
 

-(defun nnimap-open-shell-stream (name buffer host port)
-  (let ((process-connection-type nil))
-    (start-process name buffer shell-file-name
-                  shell-command-switch
-                  (format-spec
-                   nnimap-shell-program
-                   (format-spec-make
-                    ?s host
-                    ?p port)))))
-

 (defun nnimap-credentials (address ports &optional inhibit-create)
   (let (port credentials)
     ;; Request the credentials from all ports, but only query on the
 (defun nnimap-credentials (address ports &optional inhibit-create)
   (let (port credentials)
     ;; Request the credentials from all ports, but only query on the


@@ -276,7 +295,7 @@ textual parts.")
        (with-current-buffer buffer
          (when (and nnimap-object
                     (nnimap-last-command-time nnimap-object)
        (with-current-buffer buffer
          (when (and nnimap-object
                     (nnimap-last-command-time nnimap-object)

-                    (> (time-to-seconds
+                    (> (gnus-float-time

                         (time-subtract
                          now
                          (nnimap-last-command-time nnimap-object)))
                         (time-subtract
                          now
                          (nnimap-last-command-time nnimap-object)))


@@ -285,102 +304,78 @@ textual parts.")
            (nnimap-send-command "NOOP")))))))
 
 (defun nnimap-open-connection (buffer)
            (nnimap-send-command "NOOP")))))))
 
 (defun nnimap-open-connection (buffer)

+  ;; Be backwards-compatible -- the earlier value of nnimap-stream was
+  ;; `ssl' when nnimap-server-port was nil.  Sort of.
+  (when (and nnimap-server-port
+            (eq nnimap-stream 'undecided))
+    (setq nnimap-stream 'ssl))
+  (let ((stream
+        (if (eq nnimap-stream 'undecided)
+            (loop for type in '(ssl network)
+                  for stream = (let ((nnimap-stream type))
+                                 (nnimap-open-connection-1 buffer))
+                  while (eq stream 'no-connect)
+                  finally (return stream))
+          (nnimap-open-connection-1 buffer))))
+    (if (eq stream 'no-connect)
+       nil
+      stream)))
+
+(defun nnimap-open-connection-1 (buffer)

   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
                                              'nnimap-keepalive)))
   (unless nnimap-keepalive-timer
     (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
                                              'nnimap-keepalive)))

-  (block nil
-    (with-current-buffer (nnimap-make-process-buffer buffer)
-      (let* ((coding-system-for-read 'binary)
-            (coding-system-for-write 'binary)
-            (port nil)
-            (ports
-             (cond
-              ((or (eq nnimap-stream 'network)
-                   (and (eq nnimap-stream 'starttls)
-                        (fboundp 'open-gnutls-stream)))
-               (open-network-stream
-                "*nnimap*" (current-buffer) nnimap-address
-                (setq port
-                      (or nnimap-server-port
-                          (if (netrc-find-service-number "imap")
-                              "imap"
-                            "143"))))
-               '("143" "imap"))
-              ((eq nnimap-stream 'shell)
-               (nnimap-open-shell-stream
-                "*nnimap*" (current-buffer) nnimap-address
-                (setq port (or nnimap-server-port "imap")))
-               '("imap"))
-              ((eq nnimap-stream 'starttls)
-               (let ((tls-program (nnimap-extend-tls-programs)))
-                 (open-tls-stream
-                  "*nnimap*" (current-buffer) nnimap-address
-                  (setq port (or nnimap-server-port "imap"))
-                  'starttls))
-               '("imap"))
-              ((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)))
-       (if (not (and (nnimap-process nnimap-object)
-                     (memq (process-status (nnimap-process nnimap-object))
-                           '(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)
-         (if (not (setq connection-result (nnimap-wait-for-connection)))
-             (nnheader-report 'nnimap
-                              "%s" (buffer-substring
-                                    (point) (line-end-position)))
+  (with-current-buffer (nnimap-make-process-buffer buffer)
+    (let* ((coding-system-for-read 'binary)
+          (coding-system-for-write 'binary)
+          (port nil)
+          (ports
+           (cond
+            ((or (eq nnimap-stream 'network)
+                 (eq nnimap-stream 'starttls))
+             (nnheader-message 7 "Opening connection to %s..."
+                               nnimap-address)
+             '("143" "imap"))
+            ((eq nnimap-stream 'shell)
+             (nnheader-message 7 "Opening connection to %s via shell..."
+                               nnimap-address)
+             '("imap"))
+            ((memq nnimap-stream '(ssl tls))
+             (nnheader-message 7 "Opening connection to %s via tls..."
+                               nnimap-address)
+             '("143" "993" "imap" "imaps"))
+            (t
+             (error "Unknown stream type: %s" nnimap-stream))))
+          (proto-stream-always-use-starttls t)
+           login-result credentials)
+      (when nnimap-server-port
+       (setq ports (append ports (list nnimap-server-port))))
+      (destructuring-bind (stream greeting capabilities)
+         (open-protocol-stream
+          "*nnimap*" (current-buffer) nnimap-address (car (last 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")))
+       (setf (nnimap-process nnimap-object) stream)
+       (if (not stream)
+           (progn
+             (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
+                              nnimap-address port nnimap-stream)
+             'no-connect)
+         (gnus-set-process-query-on-exit-flag stream nil)
+         (if (not (gnus-string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))
+             (nnheader-report 'nnimap "%s" greeting)

            ;; Store the greeting (for debugging purposes).
            ;; Store the greeting (for debugging purposes).

-           (setf (nnimap-greeting nnimap-object)
-                 (buffer-substring (line-beginning-position)
-                                   (line-end-position)))
-           ;; Store the capabilities.
+           (setf (nnimap-greeting nnimap-object) greeting)

            (setf (nnimap-capabilities nnimap-object)
            (setf (nnimap-capabilities nnimap-object)

-                 (mapcar
-                  #'upcase
-                  (nnimap-find-parameter
-                   "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
-           (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")
+                 (mapcar #'upcase
+                         (split-string capabilities)))
+           (unless (gnus-string-match-p "[*.] PREAUTH" greeting)

              (if (not (setq credentials
                             (if (eq nnimap-authenticator 'anonymous)
                                 (list "anonymous"
              (if (not (setq credentials
                             (if (eq nnimap-authenticator 'anonymous)
                                 (list "anonymous"


@@ -394,9 +389,18 @@ textual parts.")
                                ;; physical address.
                                (nnimap-credentials nnimap-address ports)))))
                  (setq nnimap-object nil)
                                ;; physical address.
                                (nnimap-credentials nnimap-address ports)))))
                  (setq nnimap-object nil)

-               (setq login-result (nnimap-command "LOGIN %S %S"
-                                                  (car credentials)
-                                                  (cadr credentials)))
+               (setq login-result
+                     (if (and (nnimap-capability "AUTH=PLAIN")
+                              (nnimap-capability "LOGINDISABLED"))
+                     &nbs