Indent.
[gnus] / lisp / nnimap.el
index 8aad3ea..8dad44d 100644 (file)
@@ -38,6 +38,7 @@
 (require 'nnoo)
 (require 'netrc)
 (require 'utf7)
+(require 'tls)
 (require 'parse-time)
 
 (autoload 'auth-source-forget-user-or-password "auth-source")
@@ -70,6 +71,9 @@ Values are `ssl', `network', `starttls' or `shell'.")
   "How mail is split.
 Uses the same syntax as nnmail-split-methods")
 
+(defvoo nnimap-split-fancy nil
+  "Uses the same syntax as nnmail-split-fancy.")
+
 (make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
                        "Emacs 24.1")
 
@@ -306,19 +310,25 @@ textual parts.")
                 (setq port (or nnimap-server-port "imap")))
                '("imap"))
               ((eq nnimap-stream 'starttls)
-               (starttls-open-stream
-                "*nnimap*" (current-buffer) nnimap-address
-                (setq port (or nnimap-server-port "imap")))
+               (let ((tls-program (nnimap-extend-tls-programs)))
+                 (open-tls-stream
+                  "*nnimap*" (current-buffer) nnimap-address
+                  (setq port (or nnimap-server-port "imap"))
+                  'starttls))
                '("imap"))
-              ((eq nnimap-stream 'ssl)
-               (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"))))
+              ((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)))
@@ -327,7 +337,8 @@ textual parts.")
                            '(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)
+         (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
@@ -342,11 +353,23 @@ textual parts.")
                   #'upcase
                   (nnimap-find-parameter
                    "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
-           (when (eq nnimap-stream 'starttls)
-             (nnimap-command "STARTTLS")
-             (starttls-negotiate (nnimap-process nnimap-object)))
            (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.
+           (when (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")
              (if (not (setq credentials
                             (if (eq nnimap-authenticator 'anonymous)
@@ -378,7 +401,20 @@ textual parts.")
            (when nnimap-object
              (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
                (nnimap-command "ENABLE QRESYNC"))
-             t)))))))
+             (nnimap-process nnimap-object))))))))
+
+(defun nnimap-extend-tls-programs ()
+  (let ((programs tls-program)
+       result)
+    (unless (consp programs)
+      (setq programs (list programs)))
+    (dolist (program programs)
+      (when (assoc (car (split-string program)) tls-starttls-switches)
+       (push (if (not (string-match "%s" program))
+                 (concat program " " "%s")
+               program)
+             result)))
+    (nreverse result)))
 
 (defun nnimap-find-parameter (parameter elems)
   (let (result)
@@ -393,7 +429,10 @@ textual parts.")
     result))
 
 (deffoo nnimap-close-server (&optional server)
-  t)
+  (when (nnoo-change-server 'nnimap server nil)
+    (ignore-errors
+      (delete-process (get-buffer-process (nnimap-buffer))))
+    t))
 
 (deffoo nnimap-request-close ()
   t)
@@ -592,10 +631,11 @@ textual parts.")
                (nnimap-update-infos marks (list info)))
              (goto-char (point-max))
              (let ((uidnext (nth 5 (car marks))))
-               (setq high (if uidnext
-                              (1- uidnext)
-                            (nth 3 (car marks)))
-                     low (or (nth 4 (car marks)) uidnext)))))
+               (setq high (or (if uidnext
+                                   (1- uidnext)
+                                 (nth 3 (car marks)))
+                               0)
+                     low (or (nth 4 (car marks)) uidnext 1)))))
          (erase-buffer)
          (insert
           (format
@@ -612,6 +652,12 @@ textual parts.")
     (with-current-buffer (nnimap-buffer)
       (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
 
+(deffoo nnimap-request-rename-group (group new-name &optional server)
+  (when (nnimap-possibly-change-group nil server)
+    (with-current-buffer (nnimap-buffer)
+      (car (nnimap-command "RENAME %S %S"
+                          (utf7-encode group t) (utf7-encode new-name t))))))
+
 (deffoo nnimap-request-expunge-group (group &optional server)
   (when (nnimap-possibly-change-group group server)
     (with-current-buffer (nnimap-buffer)
@@ -881,6 +927,17 @@ textual parts.")
                                  (or highest exists)))))))))
        t))))
 
+(deffoo nnimap-request-newgroups (date &optional server)
+  (nnimap-possibly-change-group nil server)
+  (with-current-buffer nntp-server-buffer
+    (erase-buffer)
+    (dolist (group (with-current-buffer (nnimap-buffer)
+                    (nnimap-get-groups)))
+      (unless (assoc group nnimap-current-infos)
+       ;; Insert dummy numbers here -- they don't matter.
+       (insert (format "%S 0 1 y\n" group))))
+    t))
+
 (deffoo nnimap-retrieve-group-data-early (server infos)
   (when (nnimap-possibly-change-group nil server)
     (with-current-buffer (nnimap-buffer)
@@ -932,7 +989,7 @@ textual parts.")
             (nnimap-possibly-change-group nil server))
     (with-current-buffer (nnimap-buffer)
       ;; Wait for the final data to trickle in.
-      (when (nnimap-wait-for-response (cadar sequences))
+      (when (nnimap-wait-for-response (cadar sequences) t)
        ;; Now we should have all the data we need, no matter whether
        ;; we're QRESYNCING, fetching all the flags from scratch, or
        ;; just fetching the last 100 flags per group.
@@ -959,7 +1016,11 @@ textual parts.")
       (nnimap-update-info info (cdr (assoc group flags))))))
 
 (defun nnimap-update-info (info marks)
-  (when marks
+  (when (and marks
+            ;; Ignore groups with no UIDNEXT/marks.  This happens for
+            ;; completely empty groups.
+            (or (car marks)
+                (nth 4 marks)))
     (destructuring-bind (existing flags high low uidnext start-article
                                  permanent-flags) marks
       (let ((group (gnus-info-group info))
@@ -986,9 +1047,6 @@ textual parts.")
           group
           (cons (car (gnus-active group))
                 (or high (1- uidnext)))))
-       (when (and (not high)
-                  uidnext)
-         (setq high (1- uidnext)))
        ;; Then update the list of read articles.
        (let* ((unread
                (gnus-compress-sequence
@@ -1187,11 +1245,11 @@ textual parts.")
     (goto-char (point-min))
     (while (and (memq (process-status process)
                      '(open run))
-               (not (re-search-forward "^\\* .*\n" nil t)))
+               (not (re-search-forward "^[*.] .*\n" nil t)))
       (nnheader-accept-process-output process)
       (goto-char (point-min)))
     (forward-line -1)
-    (and (looking-at "\\* \\([A-Z0-9]+\\)")
+    (and (looking-at "[*.] \\([A-Z0-9]+\\)")
         (match-string 1))))
 
 (defun nnimap-wait-for-response (sequence &optional messagep)
@@ -1207,7 +1265,7 @@ textual parts.")
                        (point-min))
                      t)))
       (when messagep
-       (message "Read %dKB" (/ (buffer-size) 1000)))
+       (message "nnimap read %dk" (/ (buffer-size) 1000)))
       (nnheader-accept-process-output process)
       (goto-char (point-max)))
     openp))
@@ -1236,13 +1294,15 @@ textual parts.")
          (push
           (cond
            ((eql char ?\[)
-            (split-string (buffer-substring
-                           (1+ (point))
-                           (1- (search-forward "]" (line-end-position) 'move)))))
+            (split-string
+             (buffer-substring
+              (1+ (point))
+              (1- (search-forward "]" (line-end-position) 'move)))))
            ((eql char ?\()
-            (split-string (buffer-substring
-                           (1+ (point))
-                           (1- (search-forward ")" (line-end-position) 'move)))))
+            (split-string
+             (buffer-substring
+              (1+ (point))
+              (1- (search-forward ")" (line-end-position) 'move)))))
            ((eql char ?\")
             (forward-char 1)
             (buffer-substring
@@ -1303,6 +1363,8 @@ textual parts.")
          (nnmail-split-methods (if (eq nnimap-split-methods 'default)
                                    nnmail-split-methods
                                  nnimap-split-methods))
+         (nnmail-split-fancy (or nnimap-split-fancy
+                                 nnmail-split-fancy))
          (nnmail-inhibit-default-split-group t)
          (groups (nnimap-get-groups))
          new-articles)