X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnimap.el;h=0aaa797b83536affc4739987e81a41a8497f13a2;hp=d7c48823d9792886cc7cccaee793268003d6a32b;hb=f32737bf4be0c8f83dbe8a3704bc1d88a570ae09;hpb=5f0ba750ccd499ec0c6abe2adc566c4beb24618b diff --git a/lisp/nnimap.el b/lisp/nnimap.el index d7c48823d..0aaa797b8 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -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,9 +310,11 @@ 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 @@ -342,11 +348,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 +396,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) @@ -592,10 +623,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 @@ -729,16 +761,20 @@ textual parts.") (defun nnimap-find-article-by-message-id (group message-id) - (when (nnimap-possibly-change-group group nil) - (with-current-buffer (nnimap-buffer) - (let ((result - (nnimap-command "UID SEARCH HEADER Message-Id %S" message-id)) - article) - (when (car result) - ;; Select the last instance of the message in the group. - (and (setq article - (car (last (assoc "SEARCH" (cdr result))))) - (string-to-number article))))))) + (with-current-buffer (nnimap-buffer) + (erase-buffer) + (setf (nnimap-group nnimap-object) nil) + (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) + (let ((sequence + (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id)) + article result) + (setq result (nnimap-wait-for-response sequence)) + (when (and result + (car (setq result (nnimap-parse-response)))) + ;; Select the last instance of the message in the group. + (and (setq article + (car (last (assoc "SEARCH" (cdr result))))) + (string-to-number article)))))) (defun nnimap-delete-article (articles) (with-current-buffer (nnimap-buffer) @@ -877,6 +913,16 @@ 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)))))) + (deffoo nnimap-retrieve-group-data-early (server infos) (when (nnimap-possibly-change-group nil server) (with-current-buffer (nnimap-buffer) @@ -955,7 +1001,9 @@ 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 values. + (nth 4 marks)) (destructuring-bind (existing flags high low uidnext start-article permanent-flags) marks (let ((group (gnus-info-group info)) @@ -1183,11 +1231,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) @@ -1299,6 +1347,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)