X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnimap.el;h=41d61f77566efec5989774e2ab4b6b7715b39622;hb=f036ee4b99935a15584186aad375afce769affe1;hp=8227bf62a286544568571696998c6a6ede67a237;hpb=ac8ce21091b89a7a05ad821854f4d3e7ff35a394;p=gnus diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 8227bf62a..41d61f775 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -1,6 +1,6 @@ ;;; nnimap.el --- IMAP interface for Gnus -;; Copyright (C) 2010-2012 Free Software Foundation, Inc. +;; Copyright (C) 2010-2013 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Simon Josefsson @@ -100,7 +100,8 @@ Uses the same syntax as `nnmail-split-methods'.") (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. -Possible choices are nil (use default methods) or `anonymous'.") +Possible choices are nil (use default methods), `anonymous', +`login', `plain' and `cram-md5'.") (defvoo nnimap-expunge t "If non-nil, expunge articles after deleting them. @@ -127,10 +128,10 @@ textual parts.") "IMAP for Gnus." :group 'gnus) -(defcustom nnimap-request-move-articles-find-limit nil +(defcustom nnimap-request-articles-find-limit nil "Limit the number of articles to look for after moving an article." :type 'integer - :version "24.2" + :version "24.3" :group 'nnimap) (defvar nnimap-process nil) @@ -498,9 +499,13 @@ textual parts.") ;; round trips than CRAM-MD5, and it's less likely to be buggy), ;; and we're using an encrypted connection. ((and (not (nnimap-capability "LOGINDISABLED")) - (eq (nnimap-stream-type nnimap-object) 'tls)) + (eq (nnimap-stream-type nnimap-object) 'tls) + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'login))) (nnimap-command "LOGIN %S %S" user password)) - ((nnimap-capability "AUTH=CRAM-MD5") + ((and (nnimap-capability "AUTH=CRAM-MD5") + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'cram-md5))) (erase-buffer) (let ((sequence (nnimap-send-command "AUTHENTICATE CRAM-MD5")) (challenge (nnimap-wait-for-line "^\\+\\(.*\\)\n"))) @@ -513,9 +518,13 @@ textual parts.") (base64-decode-string challenge)))) "\r\n")) (nnimap-wait-for-response sequence))) - ((not (nnimap-capability "LOGINDISABLED")) + ((and (not (nnimap-capability "LOGINDISABLED")) + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'login))) (nnimap-command "LOGIN %S %S" user password)) - ((nnimap-capability "AUTH=PLAIN") + ((and (nnimap-capability "AUTH=PLAIN") + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'plain))) (nnimap-command "AUTHENTICATE PLAIN %s" (base64-encode-string @@ -857,6 +866,8 @@ textual parts.") (deffoo nnimap-request-move-article (article group server accept-form &optional last internal-move-group) (setq group (nnimap-decode-gnus-group group)) + (when internal-move-group + (setq internal-move-group (nnimap-decode-gnus-group internal-move-group))) (with-temp-buffer (mm-disable-multibyte) (when (funcall (if internal-move-group @@ -878,7 +889,7 @@ textual parts.") (or (nnimap-find-uid-response "COPYUID" (cadr result)) (nnimap-find-article-by-message-id internal-move-group server message-id - nnimap-request-move-articles-find-limit))))) + nnimap-request-articles-find-limit))))) ;; Move the article to a different method. (let ((result (eval accept-form))) (when result @@ -980,27 +991,33 @@ textual parts.") (cdr (assoc "SEARCH" (cdr result)))))))))) -(defun nnimap-find-article-by-message-id (group server message-id &optional limit) +(defun nnimap-find-article-by-message-id (group server message-id + &optional limit) "Search for message with MESSAGE-ID in GROUP from SERVER. If LIMIT, first try to limit the search to the N last articles." (with-current-buffer (nnimap-buffer) (erase-buffer) - (let* ((number-of-article - (catch 'found - (dolist (result (cdr (nnimap-change-group group server nil t))) - (when (equal "EXISTS" (cadr result)) - (throw 'found (car result)))))) + (let* ((change-group-result (nnimap-change-group group server nil t)) + (number-of-article + (and (listp change-group-result) + (catch 'found + (dolist (result (cdr change-group-result)) + (when (equal "EXISTS" (cadr result)) + (throw 'found (car result))))))) (sequence - (nnimap-send-command "UID SEARCH%s HEADER Message-Id %S" - (if (and limit number-of-article) - ;; The -1 is because IMAP message - ;; numbers are one-based rather than - ;; zero-based. - (format " %s:*" (- (string-to-number number-of-article) limit -1)) - "") - message-id))) + (nnimap-send-command + "UID SEARCH%s HEADER Message-Id %S" + (if (and limit number-of-article) + ;; The -1 is because IMAP message + ;; numbers are one-based rather than + ;; zero-based. + (format " %s:*" (- (string-to-number number-of-article) + limit -1)) + "") + message-id))) (when (nnimap-wait-for-response sequence) - (let ((article (car (last (cdr (assoc "SEARCH" (nnimap-parse-response))))))) + (let ((article (car (last (cdr (assoc "SEARCH" + (nnimap-parse-response))))))) (if article (string-to-number article) (when (and limit number-of-article) @@ -1112,7 +1129,8 @@ If LIMIT, first try to limit the search to the N last articles." (cons group (or (nnimap-find-uid-response "APPENDUID" (car result)) (nnimap-find-article-by-message-id - group server message-id)))))))))) + group server message-id + nnimap-request-articles-find-limit)))))))))) (defun nnimap-process-quirk (greeting-match type data) (when (and (nnimap-greeting nnimap-object) @@ -1193,39 +1211,61 @@ If LIMIT, first try to limit the search to the N last articles." groups)))) (nreverse groups))) +(defun nnimap-get-responses (sequences) + (let (responses) + (dolist (sequence sequences) + (goto-char (point-min)) + (when (re-search-forward (format "^%d " sequence) nil t) + (push (list sequence (nnimap-parse-response)) + responses))) + responses)) + (deffoo nnimap-request-list (&optional server) (when (nnimap-change-group nil server) (with-current-buffer nntp-server-buffer (erase-buffer) - (dolist (response - (with-current-buffer (nnimap-buffer) - ;; Build a list of (group result-of-EXAMINE) for each group - (mapcar - (lambda (group) - (list group (cdr (nnimap-change-group group server nil t)))) - (nnimap-get-groups)))) - (let ((group (encode-coding-string (car response) 'utf-8)) - (response (cadr response))) - (when (equal (caar response) "OK") - (let ((uidnext (nnimap-find-parameter "UIDNEXT" response)) - highest exists) - (dolist (elem response) - (when (equal (cadr elem) "EXISTS") - (setq exists (string-to-number (car elem))))) - (when uidnext - (setq highest (1- (string-to-number (car uidnext))))) - (cond - ((null highest) - (insert (format "%S 0 1 y\n" group))) - ((zerop exists) - ;; Empty group. - (insert (format "%S %d %d y\n" group - highest (1+ highest)))) - (t - ;; Return the widest possible range. - (insert (format "%S %d 1 y\n" group - (or highest exists))))))))) - t))) + (let ((groups + (with-current-buffer (nnimap-buffer) + (nnimap-get-groups))) + sequences responses) + (when groups + (with-current-buffer (nnimap-buffer) + (setf (nnimap-group nnimap-object) nil) + (dolist (group groups) + (setf (nnimap-examined nnimap-object) group) + (push (list (nnimap-send-command "EXAMINE %S" + (utf7-encode group t)) + group) + sequences)) + (nnimap-wait-for-response (caar sequences)) + (setq responses + (nnimap-get-responses (mapcar #'car sequences)))) + (dolist (response responses) + (let* ((sequence (car response)) + (response (cadr response)) + (group (cadr (assoc sequence sequences))) + (egroup (encode-coding-string group 'utf-8))) + (when (and group + (equal (caar response) "OK")) + (let ((uidnext (nnimap-find-parameter "UIDNEXT" response)) + highest exists) + (dolist (elem response) + (when (equal (cadr elem) "EXISTS") + (setq exists (string-to-number (car elem))))) + (when uidnext + (setq highest (1- (string-to-number (car uidnext))))) + (cond + ((null highest) + (insert (format "%S 0 1 y\n" egroup))) + ((zerop exists) + ;; Empty group. + (insert (format "%S %d %d y\n" egroup + highest (1+ highest)))) + (t + ;; Return the widest possible range. + (insert (format "%S %d 1 y\n" egroup + (or highest exists))))))))) + t))))) (deffoo nnimap-request-newgroups (date &optional server) (when (nnimap-change-group nil server) @@ -1423,7 +1463,9 @@ If LIMIT, first try to limit the search to the N last articles." (gnus-set-difference (gnus-set-difference existing - (cdr (assoc '%Seen flags))) + (gnus-sorted-union + (cdr (assoc '%Seen flags)) + (cdr (assoc '%Deleted flags)))) (cdr (assoc '%Flagged flags))))) (read (gnus-range-difference (cons start-article high) unread))) @@ -1692,10 +1734,13 @@ If LIMIT, first try to limit the search to the N last articles." nil t)))))) (defun nnimap-change-group (group &optional server no-reconnect read-only) - "Change group to GROUP. + "Change group to GROUP if non-nil. If SERVER is set, check that server is connected, otherwise retry -to reconnect, unless NO-RECONNECT is set to t. -if READ-ONLY is set, send EXAMINE rather than SELECT to the server." +to reconnect, unless NO-RECONNECT is set to t. Return nil if +unsuccessful in connecting. +If GROUP is nil, return t. +If READ-ONLY is set, send EXAMINE rather than SELECT to the server. +Return the server's response to the SELECT or EXAMINE command." (let ((open-result t)) (when (and server (not (nnimap-server-opened server))) @@ -1751,15 +1796,24 @@ if READ-ONLY is set, send EXAMINE rather than SELECT to the server." (defvar nnimap-record-commands nil "If non-nil, log commands to the \"*imap log*\" buffer.") +(defun nnimap-log-buffer () + (let ((name "*imap log*")) + (or (get-buffer name) + (with-current-buffer (get-buffer-create name) + (when (boundp 'window-point-insertion-type) + (make-local-variable 'window-point-insertion-type) + (setq window-point-insertion-type t)) + (current-buffer))))) + (defun nnimap-log-command (command) (when nnimap-record-commands - (with-current-buffer (get-buffer-create "*imap log*") + (with-current-buffer (nnimap-log-buffer) (goto-char (point-max)) (insert (format-time-string "%H:%M:%S") - " [" nnimap-address "] " - (if nnimap-inhibit-logging - "(inhibited)\n" - command)))) + " [" nnimap-address "] " + (if nnimap-inhibit-logging + "(inhibited)\n" + command)))) command) (defun nnimap-command (&rest args) @@ -1898,15 +1952,6 @@ if READ-ONLY is set, send EXAMINE rather than SELECT to the server." (forward-line 1))) (buffer-substring (point) end)))) -(defun nnimap-get-responses (sequences) - (let (responses) - (dolist (sequence sequences) - (goto-char (point-min)) - (when (re-search-forward (format "^%d " sequence) nil t) - (push (list sequence (nnimap-parse-response)) - responses))) - responses)) - (defvar nnimap-incoming-split-list nil) (defun nnimap-fetch-inbox (articles)