;;; nnimap.el --- imap backend for Gnus
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; Free Software Foundation, Inc.
-;; Author: Simon Josefsson <jas@pdc.kth.se>
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
;; Jim Radford <radford@robby.caltech.edu>
;; Keywords: mail
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+;; For Emacs < 22.2.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+
(require 'imap)
(require 'nnoo)
(require 'nnmail)
(eval-when-compile (require 'cl))
+(autoload 'auth-source-user-or-password "auth-source")
+
(nnoo-declare nnimap)
(defconst nnimap-version "nnimap 1.0")
before, either a function, or a list with group/regexp or
group/function elements."
:group 'nnimap
+ ;; FIXME: Doesn't allow `("my2server" ("INBOX" nnimap-split-fancy))'
+ ;; per example above. -- fx
:type '(choice :tag "Rule type"
(repeat :menu-tag "Single-server"
:tag "Single-server list"
"Whether to download entire articles during splitting.
This is generally not required, and will slow things down considerably.
You may need it if you want to use an advanced splitting function that
-analyses the body before splitting the article.
+analyzes the body before splitting the article.
If this variable is nil, bodies will not be downloaded; if this
-variable is the symbol `default' the default behaviour is
+variable is the symbol `default' the default behavior is
used (which currently is nil, unless you use a statistical
spam.el test); if this variable is another non-nil value bodies
will be downloaded."
+ :version "22.1"
:group 'nnimap
:type '(choice (const :tag "Let system decide" deault)
boolean))
(defcustom nnimap-close-asynchronous t
"Close mailboxes asynchronously in `nnimap-close-group'.
-This means that errors cought by nnimap when closing the mailbox will
+This means that errors caught by nnimap when closing the mailbox will
not prevent Gnus from updating the group status, which may be harmful.
However, it increases speed."
+ :version "22.1"
:type 'boolean
:group 'nnimap)
This increases the speed of closing mailboxes (quiting group) but may
decrease the speed of selecting another mailbox later. Re-selecting
the same mailbox will be faster though."
+ :version "22.1"
:type 'boolean
:group 'nnimap)
In summary, the default is O((1-p)*k+p*n) and changing it to nil makes
it O(n). If p is small, then the default is probably faster."
+ :version "22.1"
:type 'boolean
:group 'nnimap)
-(defvoo nnimap-need-unselect-to-notice-new-mail nil
+(defvoo nnimap-need-unselect-to-notice-new-mail t
"Unselect mailboxes before looking for new mail in them.
Some servers seem to need this under some circumstances.")
+(defvoo nnimap-logout-timeout nil
+ "Close server immediately if it can't logout in this number of seconds.
+If it is nil, never close server until logout completes. This variable
+overrides `imap-logout-timeout' on a per-server basis.")
+
;; Authorization / Privacy variables
(defvoo nnimap-auth-method nil
Unlike other backends, you do not need to take special care if you
flip this variable.")
+(defvoo nnimap-search-uids-not-since-is-evil nil
+ "If non-nil, avoid \"UID SEARCH UID ... NOT SINCE\" queries when expiring.
+Instead, use \"UID SEARCH SINCE\" to prune the list of expirable
+articles within Gnus. This seems to be faster on Courier in some cases.")
+
(defvoo nnimap-expunge-on-close 'always ; 'ask, 'never
"Whether to expunge a group when it is closed.
When a IMAP group with articles marked for deletion is closed, this
One useful (and perhaps the only useful) value to change this to would
be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header
instead of the internal date of messages. See section 6.4.4 of RFC
-2060 for more information on valid strings.")
+2060 for more information on valid strings.
+
+However, if `nnimap-search-uids-not-since-is-evil' is true, this
+variable has no effect since the search logic is reversed.")
(defvoo nnimap-importantize-dormant t
"If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients.
(defcustom nnimap-id nil
"Plist with client identity to send to server upon login.
-Nil means no information is sent, symbol `no' to disable ID query
-alltogheter, or plist with identifier-value pairs to send to
+A nil value means no information is sent, symbol `no' to disable ID query
+altogether, or plist with identifier-value pairs to send to
server. RFC 2971 describes the list as follows:
Any string may be sent as a field, but the following are defined to
(plist :key-type string :value-type string)))
(defcustom nnimap-debug nil
- "If non-nil, random debug spews are placed in *nnimap-debug* buffer."
+ "If non-nil, trace nnimap- functions into `nnimap-debug-buffer'.
+Uses `trace-function-background', so you can turn it off with,
+say, `untrace-all'.
+
+Note that username, passwords and other privacy sensitive
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however. Do not enable this
+variable unless you are comfortable with that.
+
+This variable only takes effect when loading the `nnimap' library.
+See also `nnimap-log'."
:group 'nnimap
:type 'boolean)
;; Utility functions:
+(defsubst nnimap-decode-group-name (group)
+ (and group
+ (gnus-group-decoded-name group)))
+
+(defsubst nnimap-encode-group-name (group)
+ (and group
+ (mm-encode-coding-string group (gnus-group-name-charset nil group))))
+
+(defun nnimap-group-prefixed-name (group &optional server)
+ (gnus-group-prefixed-name group
+ (gnus-server-to-method
+ (format "nnimap:%s"
+ (or server nnimap-current-server)))))
+
(defsubst nnimap-get-server-buffer (server)
"Return buffer for SERVER, if nil use current server."
(cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
+(defun nnimap-remove-server-from-buffer-alist (server list)
+ "Remove SERVER from LIST."
+ (let (l)
+ (dolist (e list)
+ (unless (equal server (car-safe e))
+ (push e l)))
+ l))
+
(defun nnimap-possibly-change-server (server)
"Return buffer for SERVER, changing the current server as a side-effect.
If SERVER is nil, uses the current server."
(defun nnimap-verify-uidvalidity (group server)
"Verify stored uidvalidity match current one in GROUP on SERVER."
- (let* ((gnusgroup (gnus-group-prefixed-name
- group (gnus-server-to-method
- (format "nnimap:%s" server))))
+ (let* ((gnusgroup (nnimap-group-prefixed-name group server))
(new-uidvalidity (imap-mailbox-get 'uidvalidity))
(old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
(dir (file-name-as-directory (expand-file-name nnimap-directory)))
(if old-uidvalidity
(if (not (equal old-uidvalidity new-uidvalidity))
;; uidvalidity clash
- (gnus-delete-file file)
- (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
+ (progn
+ (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
+ (gnus-group-remove-parameter gnusgroup 'imap-status)
+ (gnus-sethash (gnus-group-prefixed-name group server)
+ nil nnimap-mailbox-info)
+ (gnus-delete-file file))
t)
(gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
+ (gnus-group-remove-parameter gnusgroup 'imap-status)
+ (gnus-sethash ; Maybe not necessary here.
+ (gnus-group-prefixed-name group server)
+ nil nnimap-mailbox-info)
t)))
(defun nnimap-before-find-minmax-bugworkaround ()
"Find lowest and highest active article number in GROUP.
If EXAMINE is non-nil the group is selected read-only."
(with-current-buffer nnimap-server-buffer
- (when (or (string= group (imap-current-mailbox))
- (imap-mailbox-select group examine))
- (let (minuid maxuid)
- (when (> (imap-mailbox-get 'exists) 0)
- (imap-fetch "1,*" "UID" nil 'nouidfetch)
- (imap-message-map (lambda (uid Uid)
- (setq minuid (if minuid (min minuid uid) uid)
- maxuid (if maxuid (max maxuid uid) uid)))
- 'UID))
- (list (imap-mailbox-get 'exists) minuid maxuid)))))
+ (let ((decoded-group (nnimap-decode-group-name group)))
+ (when (or (string= decoded-group (imap-current-mailbox))
+ (imap-mailbox-select decoded-group examine))
+ (let (minuid maxuid)
+ (when (> (imap-mailbox-get 'exists) 0)
+ (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch)
+ (imap-message-map (lambda (uid Uid)
+ (setq minuid (if minuid (min minuid uid) uid)
+ maxuid (if maxuid (max maxuid uid) uid)))
+ 'UID))
+ (list (imap-mailbox-get 'exists) minuid maxuid))))))
(defun nnimap-possibly-change-group (group &optional server)
"Make GROUP the current group, and SERVER the current server."
(when (nnimap-possibly-change-server server)
- (with-current-buffer nnimap-server-buffer
- (if (or (null group) (imap-current-mailbox-p group))
- imap-current-mailbox
- (if (imap-mailbox-select group)
- (if (or (nnimap-verify-uidvalidity
- group (or server nnimap-current-server))
- (zerop (imap-mailbox-get 'exists group))
- t ;; for OGnus to see if ignoring uidvalidity
- ;; changes has any bad effects.
- (yes-or-no-p
- (format
- "nnimap: Group %s is not uidvalid. Continue? " group)))
- imap-current-mailbox
- (imap-mailbox-unselect)
- (error "nnimap: Group %s is not uid-valid" group))
- (nnheader-report 'nnimap (imap-error-text)))))))
+ (let ((decoded-group (nnimap-decode-group-name group)))
+ (with-current-buffer nnimap-server-buffer
+ (if (or (null group) (imap-current-mailbox-p decoded-group))
+ imap-current-mailbox ; Note: utf-7 encoded.
+ (if (imap-mailbox-select decoded-group)
+ (if (or (nnimap-verify-uidvalidity
+ group (or server nnimap-current-server))
+ (zerop (imap-mailbox-get 'exists decoded-group))
+ t ;; for OGnus to see if ignoring uidvalidity
+ ;; changes has any bad effects.
+ (yes-or-no-p
+ (format
+ "nnimap: Group %s is not uidvalid. Continue? "
+ decoded-group)))
+ imap-current-mailbox ; Note: utf-7 encoded.
+ (imap-mailbox-unselect)
+ (error "nnimap: Group %s is not uid-valid" decoded-group))
+ (nnheader-report 'nnimap (imap-error-text))))))))
(defun nnimap-replace-whitespace (string)
"Return STRING with all whitespace replaced with space."
(let (headers lines chars uid mbx)
(with-current-buffer nnimap-server-buffer
(setq uid imap-current-message
- mbx imap-current-mailbox
- headers (nnimap-demule
- (if (imap-capability 'IMAP4rev1)
- ;; xxx don't just use car? alist doesn't contain
- ;; anything else now, but it might...
- (nth 2 (car (imap-message-get uid 'BODYDETAIL)))
- (imap-message-get uid 'RFC822.HEADER)))
+ mbx (nnimap-encode-group-name (imap-current-mailbox))
+ headers (if (imap-capability 'IMAP4rev1)
+ ;; xxx don't just use car? alist doesn't contain
+ ;; anything else now, but it might...
+ (nth 2 (car (imap-message-get uid 'BODYDETAIL)))
+ (imap-message-get uid 'RFC822.HEADER))
lines (imap-body-lines (imap-message-body imap-current-message))
chars (imap-message-get imap-current-message 'RFC822.SIZE)))
(nnheader-insert-nov
- (with-temp-buffer
+ ;; At this stage, we only have bytes, so let's use unibyte buffers
+ ;; to make it more clear.
+ (mm-with-unibyte-buffer
(buffer-disable-undo)
- (insert headers)
+ ;; headers can be nil if article is write-only
+ (when headers (insert headers))
(let ((head (nnheader-parse-naked-head uid)))
(mail-header-set-number head uid)
(mail-header-set-chars head chars)
"Make file name for GROUP on SERVER."
(let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
(uidvalidity (gnus-group-get-parameter
- (gnus-group-prefixed-name
- group (gnus-server-to-method
- (format "nnimap:%s" server)))
+ (nnimap-group-prefixed-name group server)
'uidvalidity))
(name (nnheader-translate-file-chars
(concat nnimap-nov-file-name
(if (imap-capability 'IMAP4rev1)
(format "BODY.PEEK[HEADER.FIELDS %s])" headers)
(format "RFC822.HEADER.LINES %s)" headers)))))
+ (with-current-buffer nntp-server-buffer
+ (sort-numeric-fields 1 (point-min) (point-max)))
(and (numberp nnmail-large-newsgroup)
(> nnimap-length nnmail-large-newsgroup)
(nnheader-message 6 "nnimap: Retrieving headers...done")))))
(nnheader-nov-delete-outside-range low high))))
'nov)))
+(declare-function netrc-parse "netrc" (file))
+(declare-function netrc-machine-user-or-password "netrc"
+ (mode authinfo-file-or-list machines ports defaults))
+
(defun nnimap-open-connection (server)
+ ;; Note: `nnimap-open-server' that calls this function binds
+ ;; `imap-logout-timeout' to `nnimap-logout-timeout'.
(if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
nnimap-authenticator nnimap-server-buffer))
(nnheader-report 'nnimap "Can't open connection to server %s" server)
+ (require 'netrc)
(unless (or (imap-capability 'IMAP4 nnimap-server-buffer)
(imap-capability 'IMAP4rev1 nnimap-server-buffer))
(imap-close nnimap-server-buffer)
(nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
- (let* ((list (netrc-parse nnimap-authinfo-file))
- (port (if nnimap-server-port
- (int-to-string nnimap-server-port)
- "imap"))
- (alist (or (netrc-machine list server port "imap")
- (netrc-machine list
- (or nnimap-server-address
- nnimap-address)
- port "imap")
- (netrc-machine list server port "imaps")
- (netrc-machine list
- (or nnimap-server-address
- nnimap-address)
- port "imaps")))
- (user (netrc-get alist "login"))
- (passwd (netrc-get alist "password")))
+ (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'."
+ nnimap-authinfo-file)
+ (netrc-parse nnimap-authinfo-file)))
+ (port (if nnimap-server-port
+ (int-to-string nnimap-server-port)
+ "imap"))
+ (auth-info
+ (auth-source-user-or-password '("login" "password") server port))
+ (auth-user (nth 0 auth-info))
+ (auth-passwd (nth 1 auth-info))
+ (user (or
+ auth-user ; this is preferred to netrc-*
+ (netrc-machine-user-or-password
+ "login"
+ list
+ (list server
+ (or nnimap-server-address
+ nnimap-address))
+ (list port)
+ (list "imap" "imaps" "143" "993"))))
+ (passwd (or
+ auth-passwd ; this is preferred to netrc-*
+ (netrc-machine-user-or-password
+ "password"
+ list
+ (list server
+ (or nnimap-server-address
+ nnimap-address))
+ (list port)
+ (list "imap" "imaps" "143" "993")))))
(if (imap-authenticate user passwd nnimap-server-buffer)
- (prog1
+ (prog2
+ (setq nnimap-server-buffer-alist
+ (nnimap-remove-server-from-buffer-alist
+ server
+ nnimap-server-buffer-alist))
(push (list server nnimap-server-buffer)
nnimap-server-buffer-alist)
(imap-id nnimap-id nnimap-server-buffer)
(setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
(with-current-buffer (get-buffer-create nnimap-server-buffer)
(nnoo-change-server 'nnimap server defs))
- (or (and nnimap-server-buffer
- (imap-opened nnimap-server-buffer)
- (if (with-current-buffer nnimap-server-buffer
- (memq imap-state '(auth select examine)))
- t
- (imap-close nnimap-server-buffer)
- (nnimap-open-connection server)))
- (nnimap-open-connection server))))
+ (let ((imap-logout-timeout nnimap-logout-timeout))
+ (or (and nnimap-server-buffer
+ (imap-opened nnimap-server-buffer)
+ (if (with-current-buffer nnimap-server-buffer
+ (memq imap-state '(auth selected examine)))
+ t
+ (imap-close nnimap-server-buffer)
+ (nnimap-open-connection server)))
+ (nnimap-open-connection server)))))
(deffoo nnimap-server-opened (&optional server)
"Whether SERVER is opened.
(deffoo nnimap-close-server (&optional server)
"Close connection to server and free all resources connected to it.
Return nil if the server couldn't be closed for some reason."
- (let ((server (or server nnimap-current-server)))
+ (let ((server (or server nnimap-current-server))
+ (imap-logout-timeout nnimap-logout-timeout))
(when (or (nnimap-server-opened server)
(imap-opened (nnimap-get-server-buffer server)))
(imap-close (nnimap-get-server-buffer server))
(setq nnimap-server-buffer nil
nnimap-current-server nil
nnimap-server-buffer-alist
- (delq server nnimap-server-buffer-alist)))
+ (nnimap-remove-server-from-buffer-alist
+ server
+ nnimap-server-buffer-alist)))
(nnoo-close-server 'nnimap server)))
(deffoo nnimap-request-close ()
(when (nnimap-possibly-change-server server)
(nnoo-status-message 'nnimap server)))
-(defun nnimap-demule (string)
- ;; BEWARE: we used to use string-as-multibyte here which is braindead
- ;; because it will turn accidental emacs-mule-valid byte sequences
- ;; into multibyte chars. --Stef
- (funcall (if (and (fboundp 'string-to-multibyte)
- (subrp (symbol-function 'string-to-multibyte)))
- 'string-to-multibyte
- 'identity)
- (or string "")))
+;; We used to use a string-as-multibyte here, but it is really incorrect.
+;; This function is used when we're about to insert a unibyte string
+;; into a potentially multibyte buffer. The string is either an article
+;; header or body (or both?), undecoded. When Emacs is asked to convert
+;; a unibyte string to multibyte, it may either use the equivalent of
+;; nothing (e.g. non-Mule XEmacs), string-make-unibyte (i.e. decode using
+;; locale), string-as-multibyte (decode using emacs-internal coding system)
+;; or string-to-multibyte (keep the data undecoded as a sequence of bytes).
+;; Only the last one preserves the data such that we can reliably later on
+;; decode the text using the mime info.
+(defalias 'nnimap-demule 'mm-string-to-multibyte)
(defun nnimap-make-callback (article gnus-callback buffer)
"Return a callback function."
- `(lambda ()
+ `(lambda ()
(nnimap-callback ,article ,gnus-callback ,buffer)))
(defun nnimap-callback (article gnus-callback buffer)
article)))
(when article
(gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
- article (or group imap-current-mailbox
- gnus-newsgroup-name))
+ article (or (nnimap-decode-group-name group)
+ (imap-current-mailbox)
+ (nnimap-decode-group-name
+ gnus-newsgroup-name)))
(if (not nnheader-callback-function)
(with-current-buffer (or to-buffer nntp-server-buffer)
(erase-buffer)
(let ((data (imap-fetch article part prop nil
nnimap-server-buffer)))
- (insert (nnimap-demule (if detail
- (nth 2 (car data))
- data))))
+ ;; data can be nil if article is write-only
+ (when data
+ (insert (nnimap-demule (if detail
+ (nth 2 (car data))
+ data)))))
(nnheader-ms-strip-cr)
(gnus-message
10 "nnimap: Fetching (part of) article %d from %s...done"
- article (or group imap-current-mailbox gnus-newsgroup-name))
+ article (or (nnimap-decode-group-name group)
+ (imap-current-mailbox)
+ (nnimap-decode-group-name gnus-newsgroup-name)))
(if (bobp)
(nnheader-report 'nnimap "No such article %d in %s: %s"
- article (or group imap-current-mailbox
- gnus-newsgroup-name)
+ article (or (nnimap-decode-group-name group)
+ (imap-current-mailbox)
+ (nnimap-decode-group-name
+ gnus-newsgroup-name))
(imap-error-text nnimap-server-buffer))
(cons group article)))
(add-hook 'imap-fetch-data-hook
- (nnimap-make-callback article
- nnheader-callback-function
+ (nnimap-make-callback article
+ nnheader-callback-function
nntp-server-buffer))
(imap-fetch-asynch article part nil nnimap-server-buffer)
(cons group article))))))
(deffoo nnimap-request-group (group &optional server fast)
(nnimap-request-update-info-internal
group
- (gnus-get-info (gnus-group-prefixed-name
- group (gnus-server-to-method (format "nnimap:%s" server))))
+ (gnus-get-info (nnimap-group-prefixed-name group server))
server)
(when (nnimap-possibly-change-group group server)
(nnimap-before-find-minmax-bugworkaround)
"Update the unseen count in `nnimap-mailbox-info'."
(gnus-sethash
(gnus-group-prefixed-name group server)
- (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
+ (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
nnimap-mailbox-info)))
(list (nth 0 old) (nth 1 old)
- (imap-mailbox-status group 'unseen nnimap-server-buffer)
- (nth 3 old)))
+ (imap-mailbox-status (nnimap-decode-group-name group)
+ 'unseen nnimap-server-buffer)))
nnimap-mailbox-info))
(defun nnimap-close-group (group &optional server)
(imap-mailbox-close nnimap-close-asynchronous))))
(ask (if (and (imap-search "DELETED")
(gnus-y-or-n-p (format "Expunge articles in group `%s'? "
- imap-current-mailbox)))
+ (imap-current-mailbox))))
(progn
(imap-mailbox-expunge nnimap-close-asynchronous)
(unless nnimap-dont-close
(dolist (mbx (funcall nnimap-request-list-method
(cdr pattern) (car pattern)))
(or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
- (let ((info (nnimap-find-minmax-uid mbx 'examine)))
+ (let* ((encoded-mbx (nnimap-encode-group-name mbx))
+ (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
(when info
(with-current-buffer nntp-server-buffer
(insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
+ encoded-mbx (or (nth 2 info) 0)
(max 1 (or (nth 1 info) 1)))))))))))
(gnus-message 5 "nnimap: Generating active list%s...done"
(if (> (length server) 0) (concat " for " server) ""))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(nnimap-before-find-minmax-bugworkaround)
- (let (asyncgroups slowgroups)
+ (let (asyncgroups slowgroups decoded-group)
(if (null nnimap-retrieve-groups-asynchronous)
(setq slowgroups groups)
(dolist (group groups)
- (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
- (add-to-list (if (gnus-gethash-safe
- (gnus-group-prefixed-name group server)
- nnimap-mailbox-info)
+ (setq decoded-group (nnimap-decode-group-name group))
+ (gnus-message 9 "nnimap: Quickly checking mailbox %s"
+ decoded-group)
+ (add-to-list (if (gnus-group-get-parameter
+ (nnimap-group-prefixed-name group)
+ 'imap-status)
'asyncgroups
'slowgroups)
(list group (imap-mailbox-status-asynch
- group '(uidvalidity uidnext unseen)
+ decoded-group
+ '(uidvalidity uidnext unseen)
nnimap-server-buffer))))
(dolist (asyncgroup asyncgroups)
- (let ((group (nth 0 asyncgroup))
- (tag (nth 1 asyncgroup))
- new old)
+ (let* ((group (nth 0 asyncgroup))
+ (tag (nth 1 asyncgroup))
+ (gnusgroup (nnimap-group-prefixed-name group))
+ (saved-uidvalidity (gnus-group-get-parameter gnusgroup
+ 'uidvalidity))
+ (saved-imap-status (gnus-group-get-parameter gnusgroup
+ 'imap-status))
+ (saved-info (and saved-imap-status
+ (split-string saved-imap-status " "))))
+ (setq decoded-group (nnimap-decode-group-name group))
(when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
- (if (or (not (string=
- (nth 0 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))
- (imap-mailbox-get 'uidvalidity group
+ (if (or (not (equal
+ saved-uidvalidity
+ (imap-mailbox-get 'uidvalidity decoded-group
nnimap-server-buffer)))
- (not (string=
- (nth 1 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))
- (imap-mailbox-get 'uidnext group
+ (not (equal
+ (nth 0 saved-info)
+ (imap-mailbox-get 'uidnext decoded-group
nnimap-server-buffer))))
(push (list group) slowgroups)
- (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))))))))
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ (list (imap-mailbox-get 'uidvalidity
+ decoded-group nnimap-server-buffer)
+ (imap-mailbox-get 'uidnext
+ decoded-group nnimap-server-buffer)
+ (imap-mailbox-get 'unseen
+ decoded-group nnimap-server-buffer))
+ nnimap-mailbox-info)
+ (insert (format "\"%s\" %s %s y\n" group
+ (nth 2 saved-info)
+ (nth 1 saved-info))))))))
(dolist (group slowgroups)
(if nnimap-retrieve-groups-asynchronous
(setq group (car group)))
- (gnus-message 7 "nnimap: Mailbox %s modified" group)
- (imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
- (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
+ (setq decoded-group (nnimap-decode-group-name group))
+ (gnus-message 7 "nnimap: Mailbox %s modified" decoded-group)
+ (or (member "\\NoSelect" (imap-mailbox-get 'list-flags decoded-group
nnimap-server-buffer))
- (let* ((info (nnimap-find-minmax-uid group 'examine))
- (str (format "\"%s\" %d %d y\n" group
- (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))
- (when (> (or (imap-mailbox-get 'recent group
+ (let* ((gnusgroup (nnimap-group-prefixed-name group))
+ (status (imap-mailbox-status
+ decoded-group '(uidvalidity uidnext unseen)
+ nnimap-server-buffer))
+ (info (nnimap-find-minmax-uid group 'examine))
+ (min-uid (max 1 (or (nth 1 info) 1)))
+ (max-uid (or (nth 2 info) 0)))
+ (when (> (or (imap-mailbox-get 'recent decoded-group
nnimap-server-buffer) 0)
0)
- (push (list (cons group 0)) nnmail-split-history))
- (insert str)
- (when nnimap-retrieve-groups-asynchronous
- (gnus-sethash
- (gnus-group-prefixed-name group server)
- (list (or (imap-mailbox-get
- 'uidvalidity group nnimap-server-buffer)
- (imap-mailbox-status
- group 'uidvalidity nnimap-server-buffer))
- (or (imap-mailbox-get
- 'uidnext group nnimap-server-buffer)
- (imap-mailbox-status
- group 'uidnext nnimap-server-buffer))
- (or (imap-mailbox-get
- 'unseen group nnimap-server-buffer)
- (imap-mailbox-status
- group 'unseen nnimap-server-buffer))
- str)
- nnimap-mailbox-info)))))))
+ (push (list (cons decoded-group 0)) nnmail-split-history))
+ (insert (format "\"%s\" %d %d y\n" group max-uid min-uid))
+ (gnus-sethash
+ (gnus-group-prefixed-name group server)
+ status
+ nnimap-mailbox-info)
+ (if (not (equal (nth 0 status)
+ (gnus-group-get-parameter gnusgroup
+ 'uidvalidity)))
+ (nnimap-verify-uidvalidity group nnimap-current-server))
+ ;; The imap-status parameter is a string on the form
+ ;; "<uidnext> <min-uid> <max-uid>".
+ (gnus-group-add-parameter
+ gnusgroup
+ (cons 'imap-status
+ (format "%s %s %s" (nth 1 status) min-uid max-uid))))))))
(gnus-message 5 "nnimap: Checking mailboxes...done")
'active))
(when info ;; xxx what does this mean? should we create a info?
(with-current-buffer nnimap-server-buffer
(gnus-message 5 "nnimap: Updating info for %s..."
- (gnus-info-group info))
+ (nnimap-decode-group-name (gnus-info-group info)))
(when (nnimap-mark-permanent-p 'read)
(let (seen unseen)
;; read info could contain articles marked unread by other
;; imap clients! we correct this
- (setq seen (gnus-uncompress-range (gnus-info-read info))
- unseen (imap-search "UNSEEN UNDELETED")
- seen (gnus-set-difference seen unseen)
- ;; seen might lack articles marked as read by other
- ;; imap clients! we correct this
- seen (append seen (imap-search "SEEN"))
- ;; remove dupes
- seen (sort seen '<)
- seen (gnus-compress-sequence seen t)
- ;; we can't return '(1) since this isn't a "list of ranges",
- ;; and we can't return '((1)) since g-list-of-unread-articles
- ;; is buggy so we return '((1 . 1)).
+ (setq unseen (gnus-compress-sequence
+ (imap-search "UNSEEN UNDELETED"))
+ seen (gnus-range-difference (gnus-info-read info) unseen)
+ seen (gnus-range-add seen
+ (gnus-compress-sequence
+ (imap-search "SEEN")))
seen (if (and (integerp (car seen))
(null (cdr seen)))
(list (cons (car seen) (car seen)))
seen))
(gnus-info-set-read info seen)))
- (mapcar (lambda (pred)
- (when (or (eq (cdr pred) 'recent)
- (and (nnimap-mark-permanent-p (cdr pred))
- (member (nnimap-mark-to-flag (cdr pred))
- (imap-mailbox-get 'flags))))
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (gnus-compress-sequence
- (imap-search (nnimap-mark-to-predicate (cdr pred))))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
+ (dolist (pred gnus-article-mark-lists)
+ (when (or (eq (cdr pred) 'recent)
+ (and (nnimap-mark-permanent-p (cdr pred))
+ (member (nnimap-mark-to-flag (cdr pred))
+ (imap-mailbox-get 'flags))))
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (gnus-compress-sequence
+ (imap-search (nnimap-mark-to-predicate (cdr pred))))
+ (gnus-info-marks info))
+ t)))
(when nnimap-importantize-dormant
;; nnimap mark dormant article as ticked too (for other clients)
t))
(gnus-message 5 "nnimap: Updating info for %s...done"
- (gnus-info-group info))
+ (nnimap-decode-group-name (gnus-info-group info)))
info))))
(when (nnimap-possibly-change-group group server)
(with-current-buffer nnimap-server-buffer
(let (action)
- (gnus-message 7 "nnimap: Setting marks in %s..." group)
+ (gnus-message 7 "nnimap: Setting marks in %s..."
+ (nnimap-decode-group-name group))
(while (setq action (pop actions))
(let ((range (nth 0 action))
(what (nth 1 action))
(imap-message-flags-set
(imap-range-to-message-set range)
(nnimap-mark-to-flag marks nil t)))))))
- (gnus-message 7 "nnimap: Setting marks in %s...done" group))))
+ (gnus-message 7 "nnimap: Setting marks in %s...done"
+ (nnimap-decode-group-name group)))))
nil)
(defun nnimap-split-fancy ()
(defun nnimap-split-to-groups (rules)
;; tries to match all rules in nnimap-split-rule against content of
;; nntp-server-buffer, returns a list of groups that matched.
+ ;; Note: This function takes and returns decoded group names.
(with-current-buffer nntp-server-buffer
;; Fold continuation lines.
(goto-char (point-min))
(list nnimap-split-inbox)))
(defun nnimap-split-articles (&optional group server)
+ ;; Note: Assumes decoded group names in nnimap-split-inbox,
+ ;; nnimap-split-rule, nnimap-split-fancy, and nnmail-split-history.
(when (nnimap-possibly-change-server server)
(with-current-buffer nnimap-server-buffer
- (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))
+ (let (rule inbox removeorig
+ (inboxes (nnimap-split-find-inbox server)))
;; iterate over inboxes
(while (and (setq inbox (pop inboxes))
- (nnimap-possibly-change-group inbox)) ;; SELECT
+ (nnimap-possibly-change-group
+ (nnimap-encode-group-name inbox))) ;; SELECT
;; find split rule for this server / inbox
(when (setq rule (nnimap-split-find-rule server inbox))
;; iterate over articles
(let (msgid)
(and (setq msgid
(nnmail-fetch-field "message-id"))
- (nnmail-cache-insert msgid
- to-group
+ (nnmail-cache-insert msgid
+ (nnimap-encode-group-name to-group)
(nnmail-fetch-field "subject"))))))
;; Add the group-art list to the history list.
(push (list (cons to-group 0)) nnmail-split-history))
(if (string= (downcase mailbox) "\\noselect")
(throw 'found t)))
nil)
- (let ((info (nnimap-find-minmax-uid mbx 'examine)))
+ (let* ((encoded-mbx (nnimap-encode-group-name mbx))
+ (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
(when info
(insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
+ encoded-mbx (or (nth 2 info) 0)
(max 1 (or (nth 1 info) 1)))))))))
(gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
(if (> (length server) 0) " on " "") server))
(deffoo nnimap-request-create-group (group &optional server args)
(when (nnimap-possibly-change-server server)
- (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)
- (imap-mailbox-create group nnimap-server-buffer)
- (nnheader-report 'nnimap "%S"
- (imap-error-text nnimap-server-buffer)))))
+ (let ((decoded-group (nnimap-decode-group-name group)))
+ (or (imap-mailbox-status decoded-group 'uidvalidity nnimap-server-buffer)
+ (imap-mailbox-create decoded-group nnimap-server-buffer)
+ (nnheader-report 'nnimap "%S"
+ (imap-error-text nnimap-server-buffer))))))
(defun nnimap-time-substract (time1 time2)
"Return TIME for TIME1 - TIME2."
(list (- ms 1) (+ (expt 2 16) ls))
(list ms ls))))
+(eval-when-compile (require 'parse-time))
(defun nnimap-date-days-ago (daysago)
"Return date, in format \"3-Aug-1998\", for DAYSAGO days ago."
+ (require 'parse-time)
(let* ((time (nnimap-time-substract (current-time) (days-to-time daysago)))
(date (format-time-string
(format "%%d-%s-%%Y"
nnmail-expiry-wait)))
(cond ((or force (eq days 'immediate))
(let ((oldarts (imap-search
- (concat "UID "
+ (concat "UID "
(imap-range-to-message-set artseq)))))
(when oldarts
(nnimap-expiry-target oldarts group server)
(when (imap-message-flags-add
- (imap-range-to-message-set
+ (imap-range-to-message-set
(gnus-compress-sequence oldarts)) "\\Deleted")
(setq articles (gnus-set-difference
articles oldarts))))))
+ ((and nnimap-search-uids-not-since-is-evil (numberp days))
+ (let* ((all-new-articles
+ (gnus-compress-sequence
+ (imap-search (format "SINCE %s"
+ (nnimap-date-days-ago days)))))
+ (oldartseq
+ (gnus-range-difference artseq all-new-articles))
+ (oldarts (gnus-uncompress-range oldartseq)))
+ (when oldarts
+ (nnimap-expiry-target oldarts group server)
+ (when (imap-message-flags-add
+ (imap-range-to-message-set oldartseq)
+ "\\Deleted")
+ (setq articles (gnus-set-difference
+ articles oldarts))))))
((numberp days)
(let ((oldarts (imap-search
(format nnimap-expunge-search-string
(when oldarts
(nnimap-expiry-target oldarts group server)
(when (imap-message-flags-add
- (imap-range-to-message-set
+ (imap-range-to-message-set
(gnus-compress-sequence oldarts)) "\\Deleted")
- (setq articles (gnus-set-difference
+ (setq articles (gnus-set-difference
articles oldarts)))))))))))
;; return articles not deleted
articles)
-(deffoo nnimap-request-move-article (article group server
- accept-form &optional last)
+(deffoo nnimap-request-move-article (article group server accept-form
+ &optional last move-is-internal)
(when (nnimap-possibly-change-server server)
(save-excursion
(let ((buf (get-buffer-create " *nnimap move*"))
(nnimap-current-move-group group)
(nnimap-current-move-server nnimap-current-server)
result)
- (and (nnimap-request-article article group server)
- (save-excursion
- (set-buffer buf)
+ (gnus-message 10 "nnimap-request-move-article: this is an %s move"
+ (if move-is-internal
+ "internal"
+ "external"))
+ ;; request the article only when the move is NOT internal
+ (and (or move-is-internal
+ (nnimap-request-article article group server))
+ (with-current-buffer buf
(buffer-disable-undo (current-buffer))
(insert-buffer-substring nntp-server-buffer)
(setq result (eval accept-form))
(kill-buffer buf)
result)
+ (nnimap-possibly-change-group group server)
(imap-message-flags-add
(imap-range-to-message-set (list article))
"\\Deleted" 'silent nnimap-server-buffer))
nnimap-current-move-group)
(imap-message-copy (number-to-string
nnimap-current-move-article)
- group 'dontcreate nil
+ (nnimap-decode-group-name group)
+ 'dontcreate nil
nnimap-server-buffer))
(with-current-buffer (current-buffer)
(goto-char (point-min))
;; this 'or' is for Cyrus server bug
(or (null (imap-current-mailbox nnimap-server-buffer))
(imap-mailbox-unselect nnimap-server-buffer))
- (imap-message-append group (current-buffer) nil nil
+ (imap-message-append (nnimap-decode-group-name group)
+ (current-buffer) nil nil
nnimap-server-buffer)))
(cons group (nth 1 uid))
(nnheader-report 'nnimap (imap-error-text nnimap-server-buffer))))))
(deffoo nnimap-request-delete-group (group force &optional server)
(when (nnimap-possibly-change-server server)
+ (setq group (nnimap-decode-group-name group))
+ (when (string= group (imap-current-mailbox nnimap-server-buffer))
+ (imap-mailbox-unselect nnimap-server-buffer))
(with-current-buffer nnimap-server-buffer
(if force
(or (null (imap-mailbox-status group 'uidvalidity))
(deffoo nnimap-request-rename-group (group new-name &optional server)
(when (nnimap-possibly-change-server server)
- (imap-mailbox-rename group new-name nnimap-server-buffer)))
+ (imap-mailbox-rename (nnimap-decode-group-name group)
+ (nnimap-decode-group-name new-name)
+ nnimap-server-buffer)))
(defun nnimap-expunge (mailbox server)
(when (nnimap-possibly-change-group mailbox server)
(defun nnimap-acl-get (mailbox server)
(when (nnimap-possibly-change-server server)
(and (imap-capability 'ACL nnimap-server-buffer)
- (imap-mailbox-acl-get mailbox nnimap-server-buffer))))
+ (imap-mailbox-acl-get (nnimap-decode-group-name mailbox)
+ nnimap-server-buffer))))
(defun nnimap-acl-edit (mailbox method old-acls new-acls)
(when (nnimap-possibly-change-server (cadr method))
;; delete all removed identifiers
(mapc (lambda (old-acl)
(unless (assoc (car old-acl) new-acls)
- (or (imap-mailbox-acl-delete (car old-acl) mailbox)
+ (or (imap-mailbox-acl-delete (car old-acl)
+ (nnimap-decode-group-name mailbox))
(error "Can't delete ACL for %s" (car old-acl)))))
old-acls)
;; set all changed acl's
(old-rights (cdr (assoc (car new-acl) old-acls))))
(unless (and old-rights new-rights
(string= old-rights new-rights))
- (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
+ (or (imap-mailbox-acl-set (car new-acl) new-rights
+ (nnimap-decode-group-name mailbox))
(error "Can't set ACL for %s to %s" (car new-acl)
new-rights)))))
new-acls)
result)))
(defun nnimap-mark-permanent-p (mark &optional group)
- "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
+ "Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
(imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
(when nnimap-debug
(require 'trace)
(buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
- (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
- '(
- nnimap-possibly-change-server
- nnimap-verify-uidvalidity
- nnimap-find-minmax-uid
- nnimap-before-find-minmax-bugworkaround
- nnimap-possibly-change-group
- ;;nnimap-replace-whitespace
- nnimap-retrieve-headers-progress
- nnimap-retrieve-which-headers
- nnimap-group-overview-filename
- nnimap-retrieve-headers-from-file
- nnimap-retrieve-headers-from-server
- nnimap-retrieve-headers
- nnimap-open-connection
- nnimap-open-server
- nnimap-server-opened
- nnimap-close-server
- nnimap-request-close
- nnimap-status-message
- ;;nnimap-demule
- nnimap-request-article-part
- nnimap-request-article
- nnimap-request-head
- nnimap-request-body
- nnimap-request-group
- nnimap-close-group
- nnimap-pattern-to-list-arguments
- nnimap-request-list
- nnimap-request-post
- nnimap-retrieve-groups
- nnimap-request-update-info-internal
- nnimap-request-type
- nnimap-request-set-mark
- nnimap-split-to-groups
- nnimap-split-find-rule
- nnimap-split-find-inbox
- nnimap-split-articles
- nnimap-request-scan
- nnimap-request-newgroups
- nnimap-request-create-group
- nnimap-time-substract
- nnimap-date-days-ago
- nnimap-request-expire-articles-progress
- nnimap-request-expire-articles
- nnimap-request-move-article
- nnimap-request-accept-article
- nnimap-request-delete-group
- nnimap-request-rename-group
- gnus-group-nnimap-expunge
- gnus-group-nnimap-edit-acl
- gnus-group-nnimap-edit-acl-done
- nnimap-group-mode-hook
- nnimap-mark-to-predicate
- nnimap-mark-to-flag-1
- nnimap-mark-to-flag
- nnimap-mark-permanent-p
- )))
+ (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer))
+ '(
+ nnimap-possibly-change-server
+ nnimap-verify-uidvalidity
+ nnimap-find-minmax-uid
+ nnimap-before-find-minmax-bugworkaround
+ nnimap-possibly-change-group
+ ;;nnimap-replace-whitespace
+ nnimap-retrieve-headers-progress
+ nnimap-retrieve-which-headers
+ nnimap-group-overview-filename
+ nnimap-retrieve-headers-from-file
+ nnimap-retrieve-headers-from-server
+ nnimap-retrieve-headers
+ nnimap-open-connection
+ nnimap-open-server
+ nnimap-server-opened
+ nnimap-close-server
+ nnimap-request-close
+ nnimap-status-message
+ ;;nnimap-demule
+ nnimap-request-article-part
+ nnimap-request-article
+ nnimap-request-head
+ nnimap-request-body
+ nnimap-request-group
+ nnimap-close-group
+ nnimap-pattern-to-list-arguments
+ nnimap-request-list
+ nnimap-request-post
+ nnimap-retrieve-groups
+ nnimap-request-update-info-internal
+ nnimap-request-type
+ nnimap-request-set-mark
+ nnimap-split-to-groups
+ nnimap-split-find-rule
+ nnimap-split-find-inbox
+ nnimap-split-articles
+ nnimap-request-scan
+ nnimap-request-newgroups
+ nnimap-request-create-group
+ nnimap-time-substract
+ nnimap-date-days-ago
+ nnimap-request-expire-articles-progress
+ nnimap-request-expire-articles
+ nnimap-request-move-article
+ nnimap-request-accept-article
+ nnimap-request-delete-group
+ nnimap-request-rename-group
+ gnus-group-nnimap-expunge
+ gnus-group-nnimap-edit-acl
+ gnus-group-nnimap-edit-acl-done
+ nnimap-group-mode-hook
+ nnimap-mark-to-predicate
+ nnimap-mark-to-flag-1
+ nnimap-mark-to-flag
+ nnimap-mark-permanent-p
+ )))
(provide 'nnimap)
projects / gnus / blobdiff