31717
|
1 ;;; nnimap.el --- imap backend for Gnus
|
64754
|
2
|
|
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
|
4 ;; 2005 Free Software Foundation, Inc.
|
31717
|
5
|
|
6 ;; Author: Simon Josefsson <jas@pdc.kth.se>
|
|
7 ;; Jim Radford <radford@robby.caltech.edu>
|
|
8 ;; Keywords: mail
|
|
9
|
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
15 ;; any later version.
|
|
16
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
20 ;; GNU General Public License for more details.
|
|
21
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64085
|
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
25 ;; Boston, MA 02110-1301, USA.
|
31717
|
26
|
|
27 ;;; Commentary:
|
|
28
|
|
29 ;; Todo, major things:
|
|
30 ;;
|
|
31 ;; o Fix Gnus to view correct number of unread/total articles in group buffer
|
|
32 ;; o Fix Gnus to handle leading '.' in group names (fixed?)
|
|
33 ;; o Finish disconnected mode (moving articles between mailboxes unplugged)
|
|
34 ;; o Sieve
|
|
35 ;; o MIME (partial article fetches)
|
|
36 ;; o Split to other backends, different split rules for different
|
|
37 ;; servers/inboxes
|
|
38 ;;
|
|
39 ;; Todo, minor things:
|
|
40 ;;
|
|
41 ;; o Don't require half of Gnus -- backends should be standalone
|
|
42 ;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
|
|
43 ;; o Dont uid fetch 1,* in nnimap-retrive-groups (slow)
|
|
44 ;; o Split up big fetches (1,* header especially) in smaller chunks
|
|
45 ;; o What do I do with gnus-newsgroup-*?
|
|
46 ;; o Tell Gnus about new groups (how can we tell?)
|
48588
|
47 ;; o Respooling (fix Gnus?) (unnecessary?)
|
31717
|
48 ;; o Add support for the following: (if applicable)
|
|
49 ;; request-list-newsgroups, request-regenerate
|
|
50 ;; list-active-group,
|
|
51 ;; request-associate-buffer, request-restore-buffer,
|
|
52 ;; o Do The Right Thing when UIDVALIDITY changes (what's the right thing?)
|
|
53 ;; o Support RFC2221 (Login referrals)
|
|
54 ;; o IMAP2BIS compatibility? (RFC2061)
|
|
55 ;; o ACAP stuff (perhaps a different project, would be nice to ACAPify
|
|
56 ;; .newsrc.eld)
|
|
57 ;; o What about Gnus's article editing, can we support it? NO!
|
|
58 ;; o Use \Draft to support the draft group??
|
|
59 ;; o Duplicate suppression
|
56927
|
60 ;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers
|
31717
|
61
|
|
62 ;;; Code:
|
|
63
|
56927
|
64 (require 'imap)
|
31717
|
65 (require 'nnoo)
|
|
66 (require 'nnmail)
|
|
67 (require 'nnheader)
|
|
68 (require 'mm-util)
|
|
69 (require 'gnus)
|
|
70 (require 'gnus-range)
|
|
71 (require 'gnus-start)
|
|
72 (require 'gnus-int)
|
|
73
|
56927
|
74 (eval-when-compile (require 'cl))
|
|
75
|
31717
|
76 (nnoo-declare nnimap)
|
|
77
|
56927
|
78 (defconst nnimap-version "nnimap 1.0")
|
|
79
|
|
80 (defgroup nnimap nil
|
|
81 "Reading IMAP mail with Gnus."
|
|
82 :group 'gnus)
|
31717
|
83
|
|
84 (defvoo nnimap-address nil
|
|
85 "Address of physical IMAP server. If nil, use the virtual server's name.")
|
|
86
|
|
87 (defvoo nnimap-server-port nil
|
|
88 "Port number on physical IMAP server.
|
56927
|
89 If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.")
|
31717
|
90
|
|
91 ;; Splitting variables
|
|
92
|
56927
|
93 (defcustom nnimap-split-crosspost t
|
31717
|
94 "If non-nil, do crossposting if several split methods match the mail.
|
56927
|
95 If nil, the first match found will be used."
|
|
96 :group 'nnimap
|
|
97 :type 'boolean)
|
31717
|
98
|
56927
|
99 (defcustom nnimap-split-inbox nil
|
|
100 "Name of mailbox to split mail from.
|
31717
|
101
|
|
102 Mail is read from this mailbox and split according to rules in
|
56927
|
103 `nnimap-split-rule'.
|
|
104
|
|
105 This can be a string or a list of strings."
|
|
106 :group 'nnimap
|
|
107 :type '(choice (string)
|
|
108 (repeat string)))
|
|
109
|
|
110 (define-widget 'nnimap-strict-function 'function
|
|
111 "This widget only matches values that are functionp.
|
31717
|
112
|
56927
|
113 Warning: This means that a value that is the symbol of a not yet
|
|
114 loaded function will not match. Use with care."
|
|
115 :match 'nnimap-strict-function-match)
|
31717
|
116
|
56927
|
117 (defun nnimap-strict-function-match (widget value)
|
|
118 "Ignoring WIDGET, match if VALUE is a function."
|
|
119 (functionp value))
|
|
120
|
|
121 (defcustom nnimap-split-rule nil
|
|
122 "Mail will be split according to these rules.
|
31717
|
123
|
|
124 Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
|
|
125
|
|
126 If you'd like, for instance, one mail group for mail from the
|
|
127 \"gnus-imap\" mailing list, one group for junk mail and leave
|
|
128 everything else in the incoming mailbox, you could do something like
|
|
129 this:
|
|
130
|
48216
e5026995ea82
(nnimap-split-rule): Doc fix - escape open parens in column 0.
Markus Rost <rost@math.uni-bielefeld.de>
diff
changeset
|
131 \(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\")
|
31717
|
132 (\"INBOX.junk\" \"Subject:.*buy\")))
|
|
133
|
56927
|
134 As you can see, `nnimap-split-rule' is a list of lists, where the
|
|
135 first element in each \"rule\" is the name of the IMAP mailbox (or the
|
|
136 symbol `junk' if you want to remove the mail), and the second is a
|
|
137 regexp that nnimap will try to match on the header to find a fit.
|
31717
|
138
|
|
139 The second element can also be a function. In that case, it will be
|
|
140 called narrowed to the headers with the first element of the rule as
|
|
141 the argument. It should return a non-nil value if it thinks that the
|
|
142 mail belongs in that group.
|
|
143
|
|
144 This variable can also have a function as its value, the function will
|
|
145 be called with the headers narrowed and should return a group where it
|
|
146 thinks the article should be splitted to. See `nnimap-split-fancy'.
|
|
147
|
|
148 To allow for different split rules on different virtual servers, and
|
|
149 even different split rules in different inboxes on the same server,
|
|
150 the syntax of this variable have been extended along the lines of:
|
|
151
|
48216
e5026995ea82
(nnimap-split-rule): Doc fix - escape open parens in column 0.
Markus Rost <rost@math.uni-bielefeld.de>
diff
changeset
|
152 \(setq nnimap-split-rule
|
31717
|
153 '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\")
|
56927
|
154 (\"junk\" \"From:.*Simon\")))
|
|
155 (\"my2server\" (\"INBOX\" nnimap-split-fancy))
|
|
156 (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\")
|
|
157 (\"junk\" my-junk-func)))))
|
31717
|
158
|
|
159 The virtual server name is in fact a regexp, so that the same rules
|
|
160 may apply to several servers. In the example, the servers
|
|
161 \"my3server\" and \"my4server\" both use the same rules. Similarly,
|
|
162 the inbox string is also a regexp. The actual splitting rules are as
|
|
163 before, either a function, or a list with group/regexp or
|
56927
|
164 group/function elements."
|
|
165 :group 'nnimap
|
|
166 :type '(choice :tag "Rule type"
|
|
167 (repeat :menu-tag "Single-server"
|
|
168 :tag "Single-server list"
|
|
169 (list (string :tag "Mailbox")
|
|
170 (choice :tag "Predicate"
|
|
171 (regexp :tag "A regexp")
|
|
172 (nnimap-strict-function :tag "A function"))))
|
|
173 (choice :menu-tag "A function"
|
|
174 :tag "A function"
|
|
175 (function-item nnimap-split-fancy)
|
|
176 (function-item nnmail-split-fancy)
|
|
177 (nnimap-strict-function :tag "User-defined function"))
|
|
178 (repeat :menu-tag "Multi-server (extended)"
|
|
179 :tag "Multi-server list"
|
|
180 (list (regexp :tag "Server regexp")
|
|
181 (list (regexp :tag "Incoming Mailbox regexp")
|
|
182 (repeat :tag "Rules for matching server(s) and mailbox(es)"
|
|
183 (list (string :tag "Destination mailbox")
|
|
184 (choice :tag "Predicate"
|
|
185 (regexp :tag "A Regexp")
|
|
186 (nnimap-strict-function :tag "A Function")))))))))
|
31717
|
187
|
56927
|
188 (defcustom nnimap-split-predicate "UNSEEN UNDELETED"
|
31717
|
189 "The predicate used to find articles to split.
|
|
190 If you use another IMAP client to peek on articles but always would
|
|
191 like nnimap to split them once it's started, you could change this to
|
|
192 \"UNDELETED\". Other available predicates are available in
|
56927
|
193 RFC2060 section 6.4.4."
|
|
194 :group 'nnimap
|
|
195 :type 'string)
|
|
196
|
|
197 (defcustom nnimap-split-fancy nil
|
|
198 "Like the variable `nnmail-split-fancy'."
|
|
199 :group 'nnimap
|
|
200 :type 'sexp)
|
|
201
|
|
202 (defvar nnimap-split-download-body-default nil
|
|
203 "Internal variable with default value for `nnimap-split-download-body'.")
|
|
204
|
|
205 (defcustom nnimap-split-download-body 'default
|
|
206 "Whether to download entire articles during splitting.
|
|
207 This is generally not required, and will slow things down considerably.
|
|
208 You may need it if you want to use an advanced splitting function that
|
63617
|
209 analyzes the body before splitting the article.
|
56927
|
210 If this variable is nil, bodies will not be downloaded; if this
|
|
211 variable is the symbol `default' the default behaviour is
|
|
212 used (which currently is nil, unless you use a statistical
|
|
213 spam.el test); if this variable is another non-nil value bodies
|
|
214 will be downloaded."
|
59996
|
215 :version "22.1"
|
56927
|
216 :group 'nnimap
|
|
217 :type '(choice (const :tag "Let system decide" deault)
|
|
218 boolean))
|
|
219
|
|
220 ;; Performance / bug workaround variables
|
31717
|
221
|
56927
|
222 (defcustom nnimap-close-asynchronous t
|
|
223 "Close mailboxes asynchronously in `nnimap-close-group'.
|
57153
|
224 This means that errors caught by nnimap when closing the mailbox will
|
56927
|
225 not prevent Gnus from updating the group status, which may be harmful.
|
|
226 However, it increases speed."
|
59996
|
227 :version "22.1"
|
56927
|
228 :type 'boolean
|
|
229 :group 'nnimap)
|
|
230
|
|
231 (defcustom nnimap-dont-close t
|
|
232 "Never close mailboxes.
|
|
233 This increases the speed of closing mailboxes (quiting group) but may
|
|
234 decrease the speed of selecting another mailbox later. Re-selecting
|
|
235 the same mailbox will be faster though."
|
59996
|
236 :version "22.1"
|
56927
|
237 :type 'boolean
|
|
238 :group 'nnimap)
|
|
239
|
|
240 (defcustom nnimap-retrieve-groups-asynchronous t
|
|
241 "Send asynchronous STATUS commands for each mailbox before checking mail.
|
|
242 If you have mailboxes that rarely receives mail, this speeds up new
|
|
243 mail checking. It works by first sending STATUS commands for each
|
|
244 mailbox, and then only checking groups which has a modified UIDNEXT
|
|
245 more carefully for new mail.
|
|
246
|
|
247 In summary, the default is O((1-p)*k+p*n) and changing it to nil makes
|
|
248 it O(n). If p is small, then the default is probably faster."
|
59996
|
249 :version "22.1"
|
56927
|
250 :type 'boolean
|
|
251 :group 'nnimap)
|
|
252
|
|
253 (defvoo nnimap-need-unselect-to-notice-new-mail nil
|
|
254 "Unselect mailboxes before looking for new mail in them.
|
|
255 Some servers seem to need this under some circumstances.")
|
31717
|
256
|
|
257 ;; Authorization / Privacy variables
|
|
258
|
|
259 (defvoo nnimap-auth-method nil
|
|
260 "Obsolete.")
|
|
261
|
|
262 (defvoo nnimap-stream nil
|
|
263 "How nnimap will connect to the server.
|
|
264
|
|
265 The default, nil, will try to use the \"best\" method the server can
|
|
266 handle.
|
|
267
|
|
268 Change this if
|
|
269
|
56927
|
270 1) you want to connect with TLS/SSL. The TLS/SSL integration
|
|
271 with IMAP is suboptimal so you'll have to tell it
|
|
272 specifically.
|
31717
|
273
|
|
274 2) your server is more capable than your environment -- i.e. your
|
|
275 server accept Kerberos login's but you haven't installed the
|
|
276 `imtest' program or your machine isn't configured for Kerberos.
|
|
277
|
56927
|
278 Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell.
|
|
279 See also `imap-streams' and `imap-stream-alist'.")
|
31717
|
280
|
|
281 (defvoo nnimap-authenticator nil
|
|
282 "How nnimap authenticate itself to the server.
|
|
283
|
|
284 The default, nil, will try to use the \"best\" method the server can
|
|
285 handle.
|
|
286
|
|
287 There is only one reason for fiddling with this variable, and that is
|
|
288 if your server is more capable than your environment -- i.e. you
|
|
289 connect to a server that accept Kerberos login's but you haven't
|
|
290 installed the `imtest' program or your machine isn't configured for
|
|
291 Kerberos.
|
|
292
|
56927
|
293 Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous.
|
|
294 See also `imap-authenticators' and `imap-authenticator-alist'")
|
31717
|
295
|
|
296 (defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")
|
|
297 "Directory to keep NOV cache files for nnimap groups.
|
|
298 See also `nnimap-nov-file-name'.")
|
|
299
|
|
300 (defvoo nnimap-nov-file-name "nnimap."
|
|
301 "NOV cache base filename.
|
|
302 The group name and `nnimap-nov-file-name-suffix' will be appended. A
|
|
303 typical complete file name would be
|
|
304 ~/News/overview/nnimap.pdc.INBOX.ding.nov, or
|
|
305 ~/News/overview/nnimap/pdc/INBOX/ding/nov if
|
|
306 `nnmail-use-long-file-names' is nil")
|
|
307
|
|
308 (defvoo nnimap-nov-file-name-suffix ".novcache"
|
|
309 "Suffix for NOV cache base filename.")
|
|
310
|
56927
|
311 (defvoo nnimap-nov-is-evil gnus-agent
|
|
312 "If non-nil, never generate or use a local nov database for this backend.
|
|
313 Using nov databases should speed up header fetching considerably.
|
|
314 However, it will invoke a UID SEARCH UID command on the server, and
|
|
315 some servers implement this command inefficiently by opening each and
|
|
316 every message in the group, thus making it quite slow.
|
31717
|
317 Unlike other backends, you do not need to take special care if you
|
|
318 flip this variable.")
|
|
319
|
|
320 (defvoo nnimap-expunge-on-close 'always ; 'ask, 'never
|
|
321 "Whether to expunge a group when it is closed.
|
|
322 When a IMAP group with articles marked for deletion is closed, this
|
|
323 variable determine if nnimap should actually remove the articles or
|
|
324 not.
|
|
325
|
|
326 If always, nnimap always perform a expunge when closing the group.
|
|
327 If never, nnimap never expunges articles marked for deletion.
|
|
328 If ask, nnimap will ask you if you wish to expunge marked articles.
|
|
329
|
|
330 When setting this variable to `never', you can only expunge articles
|
|
331 by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.")
|
|
332
|
|
333 (defvoo nnimap-list-pattern "*"
|
|
334 "A string LIMIT or list of strings with mailbox wildcards used to limit available groups.
|
|
335 See below for available wildcards.
|
|
336
|
|
337 The LIMIT string can be a cons cell (REFERENCE . LIMIT), where
|
|
338 REFERENCE will be passed as the first parameter to LIST/LSUB. The
|
|
339 semantics of this are server specific, on the University of Washington
|
|
340 server you can specify a directory.
|
|
341
|
|
342 Example:
|
|
343 '(\"INBOX\" \"mail/*\" (\"~friend/mail/\" . \"list/*\"))
|
|
344
|
|
345 There are two wildcards * and %. * matches everything, % matches
|
|
346 everything in the current hierarchy.")
|
|
347
|
|
348 (defvoo nnimap-news-groups nil
|
56927
|
349 "IMAP support a news-like mode, also known as bulletin board mode,
|
|
350 where replies is sent via IMAP instead of SMTP.
|
31717
|
351
|
|
352 This variable should contain a regexp matching groups where you wish
|
|
353 replies to be stored to the mailbox directly.
|
|
354
|
|
355 Example:
|
|
356 '(\"^[^I][^N][^B][^O][^X].*$\")
|
|
357
|
|
358 This will match all groups not beginning with \"INBOX\".
|
|
359
|
|
360 Note that there is nothing technically different between mail-like and
|
|
361 news-like mailboxes. If you wish to have a group with todo items or
|
|
362 similar which you wouldn't want to set up a mailing list for, you can
|
|
363 use this to make replies go directly to the group.")
|
|
364
|
56927
|
365 (defvoo nnimap-expunge-search-string "UID %s NOT SINCE %s"
|
|
366 "IMAP search command to use for articles that are to be expired.
|
|
367 The first %s is replaced by a UID set of articles to search on,
|
|
368 and the second %s is replaced by a date criterium.
|
|
369
|
|
370 One useful (and perhaps the only useful) value to change this to would
|
|
371 be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header
|
|
372 instead of the internal date of messages. See section 6.4.4 of RFC
|
|
373 2060 for more information on valid strings.")
|
|
374
|
|
375 (defvoo nnimap-importantize-dormant t
|
|
376 "If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients.
|
|
377 Note that within Gnus, dormant articles will still (only) be
|
|
378 marked as ticked. This is to make \"dormant\" articles stand out,
|
|
379 just like \"ticked\" articles, in other IMAP clients.")
|
|
380
|
31717
|
381 (defvoo nnimap-server-address nil
|
|
382 "Obsolete. Use `nnimap-address'.")
|
|
383
|
|
384 (defcustom nnimap-authinfo-file "~/.authinfo"
|
|
385 "Authorization information for IMAP servers. In .netrc format."
|
|
386 :type
|
|
387 '(choice file
|
|
388 (repeat :tag "Entries"
|
|
389 :menu-tag "Inline"
|
|
390 (list :format "%v"
|
|
391 :value ("" ("login" . "") ("password" . ""))
|
|
392 (string :tag "Host")
|
|
393 (checklist :inline t
|
|
394 (cons :format "%v"
|
|
395 (const :format "" "login")
|
|
396 (string :format "Login: %v"))
|
|
397 (cons :format "%v"
|
|
398 (const :format "" "password")
|
56280
|
399 (string :format "Password: %v"))))))
|
|
400 :group 'nnimap)
|
31717
|
401
|
|
402 (defcustom nnimap-prune-cache t
|
|
403 "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache."
|
56280
|
404 :type 'boolean
|
|
405 :group 'nnimap)
|
31717
|
406
|
|
407 (defvar nnimap-request-list-method 'imap-mailbox-list
|
|
408 "Method to use to request a list of all folders from the server.
|
|
409 If this is 'imap-mailbox-lsub, then use a server-side subscription list to
|
|
410 restrict visible folders.")
|
|
411
|
56927
|
412 (defcustom nnimap-debug nil
|
60161
|
413 "If non-nil, random debug spews are placed in *nnimap-debug* buffer.
|
|
414 Note that username, passwords and other privacy sensitive
|
|
415 information (such as e-mail) may be stored in the *nnimap-debug*
|
|
416 buffer. It is not written to disk, however. Do not enable this
|
|
417 variable unless you are comfortable with that."
|
56927
|
418 :group 'nnimap
|
|
419 :type 'boolean)
|
|
420
|
31717
|
421 ;; Internal variables:
|
|
422
|
56927
|
423 (defvar nnimap-debug-buffer "*nnimap-debug*")
|
|
424 (defvar nnimap-mailbox-info (gnus-make-hashtable 997))
|
31717
|
425 (defvar nnimap-current-move-server nil)
|
|
426 (defvar nnimap-current-move-group nil)
|
|
427 (defvar nnimap-current-move-article nil)
|
|
428 (defvar nnimap-length)
|
|
429 (defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
|
|
430 (defvar nnimap-progress-how-often 20)
|
|
431 (defvar nnimap-counter)
|
|
432 (defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
|
56927
|
433 (defvar nnimap-current-server nil) ;; Current server
|
|
434 (defvar nnimap-server-buffer nil) ;; Current servers' buffer
|
31717
|
435
|
|
436
|
|
437
|
|
438 (nnoo-define-basics nnimap)
|
|
439
|
|
440 ;; Utility functions:
|
|
441
|
|
442 (defsubst nnimap-get-server-buffer (server)
|
|
443 "Return buffer for SERVER, if nil use current server."
|
|
444 (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
|
|
445
|
|
446 (defun nnimap-possibly-change-server (server)
|
|
447 "Return buffer for SERVER, changing the current server as a side-effect.
|
|
448 If SERVER is nil, uses the current server."
|
|
449 (setq nnimap-current-server (or server nnimap-current-server)
|
|
450 nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server)))
|
|
451
|
|
452 (defun nnimap-verify-uidvalidity (group server)
|
|
453 "Verify stored uidvalidity match current one in GROUP on SERVER."
|
|
454 (let* ((gnusgroup (gnus-group-prefixed-name
|
|
455 group (gnus-server-to-method
|
|
456 (format "nnimap:%s" server))))
|
|
457 (new-uidvalidity (imap-mailbox-get 'uidvalidity))
|
32995
|
458 (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
|
|
459 (dir (file-name-as-directory (expand-file-name nnimap-directory)))
|
56927
|
460 (nameuid (nnheader-translate-file-chars
|
|
461 (concat nnimap-nov-file-name
|
|
462 (if (equal server "")
|
|
463 "unnamed"
|
|
464 server) "." group "." old-uidvalidity
|
|
465 nnimap-nov-file-name-suffix) t))
|
|
466 (file (if (or nnmail-use-long-file-names
|
32995
|
467 (file-exists-p (expand-file-name nameuid dir)))
|
|
468 (expand-file-name nameuid dir)
|
|
469 (expand-file-name
|
|
470 (mm-encode-coding-string
|
|
471 (nnheader-replace-chars-in-string nameuid ?. ?/)
|
|
472 nnmail-pathname-coding-system)
|
|
473 dir))))
|
31717
|
474 (if old-uidvalidity
|
|
475 (if (not (equal old-uidvalidity new-uidvalidity))
|
32995
|
476 ;; uidvalidity clash
|
|
477 (gnus-delete-file file)
|
31717
|
478 (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
|
|
479 t)
|
|
480 (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
|
|
481 t)))
|
|
482
|
|
483 (defun nnimap-before-find-minmax-bugworkaround ()
|
|
484 "Function called before iterating through mailboxes with
|
|
485 `nnimap-find-minmax-uid'."
|
56927
|
486 (when nnimap-need-unselect-to-notice-new-mail
|
|
487 ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
|
|
488 ;; currently selected mailbox without a re-select/examine.
|
|
489 (or (null (imap-current-mailbox nnimap-server-buffer))
|
|
490 (imap-mailbox-unselect nnimap-server-buffer))))
|
31717
|
491
|
|
492 (defun nnimap-find-minmax-uid (group &optional examine)
|
48588
|
493 "Find lowest and highest active article number in GROUP.
|
31717
|
494 If EXAMINE is non-nil the group is selected read-only."
|
|
495 (with-current-buffer nnimap-server-buffer
|
56927
|
496 (when (or (string= group (imap-current-mailbox))
|
|
497 (imap-mailbox-select group examine))
|
31717
|
498 (let (minuid maxuid)
|
|
499 (when (> (imap-mailbox-get 'exists) 0)
|
|
500 (imap-fetch "1,*" "UID" nil 'nouidfetch)
|
|
501 (imap-message-map (lambda (uid Uid)
|
|
502 (setq minuid (if minuid (min minuid uid) uid)
|
|
503 maxuid (if maxuid (max maxuid uid) uid)))
|
|
504 'UID))
|
|
505 (list (imap-mailbox-get 'exists) minuid maxuid)))))
|
49598
|
506
|
31717
|
507 (defun nnimap-possibly-change-group (group &optional server)
|
|
508 "Make GROUP the current group, and SERVER the current server."
|
|
509 (when (nnimap-possibly-change-server server)
|
|
510 (with-current-buffer nnimap-server-buffer
|
|
511 (if (or (null group) (imap-current-mailbox-p group))
|
|
512 imap-current-mailbox
|
|
513 (if (imap-mailbox-select group)
|
|
514 (if (or (nnimap-verify-uidvalidity
|
|
515 group (or server nnimap-current-server))
|
|
516 (zerop (imap-mailbox-get 'exists group))
|
56927
|
517 t ;; for OGnus to see if ignoring uidvalidity
|
|
518 ;; changes has any bad effects.
|
31717
|
519 (yes-or-no-p
|
|
520 (format
|
|
521 "nnimap: Group %s is not uidvalid. Continue? " group)))
|
|
522 imap-current-mailbox
|
|
523 (imap-mailbox-unselect)
|
38413
|
524 (error "nnimap: Group %s is not uid-valid" group))
|
31717
|
525 (nnheader-report 'nnimap (imap-error-text)))))))
|
|
526
|
|
527 (defun nnimap-replace-whitespace (string)
|
|
528 "Return STRING with all whitespace replaced with space."
|
|
529 (when string
|
|
530 (while (string-match "[\r\n\t]+" string)
|
|
531 (setq string (replace-match " " t t string)))
|
|
532 string))
|
|
533
|
|
534 ;; Required backend functions
|
|
535
|
|
536 (defun nnimap-retrieve-headers-progress ()
|
|
537 "Hook to insert NOV line for current article into `nntp-server-buffer'."
|
|
538 (and (numberp nnmail-large-newsgroup)
|
|
539 (zerop (% (incf nnimap-counter) nnimap-progress-how-often))
|
|
540 (> nnimap-length nnmail-large-newsgroup)
|
|
541 (nnheader-message 6 "nnimap: Retrieving headers... %c"
|
|
542 (nth (/ (% nnimap-counter
|
|
543 (* (length nnimap-progress-chars)
|
|
544 nnimap-progress-how-often))
|
|
545 nnimap-progress-how-often)
|
|
546 nnimap-progress-chars)))
|
|
547 (with-current-buffer nntp-server-buffer
|
|
548 (let (headers lines chars uid mbx)
|
|
549 (with-current-buffer nnimap-server-buffer
|
|
550 (setq uid imap-current-message
|
|
551 mbx imap-current-mailbox
|
|
552 headers (nnimap-demule
|
|
553 (if (imap-capability 'IMAP4rev1)
|
|
554 ;; xxx don't just use car? alist doesn't contain
|
|
555 ;; anything else now, but it might...
|
|
556 (nth 2 (car (imap-message-get uid 'BODYDETAIL)))
|
|
557 (imap-message-get uid 'RFC822.HEADER)))
|
|
558 lines (imap-body-lines (imap-message-body imap-current-message))
|
|
559 chars (imap-message-get imap-current-message 'RFC822.SIZE)))
|
|
560 (nnheader-insert-nov
|
|
561 (with-temp-buffer
|
|
562 (buffer-disable-undo)
|
|
563 (insert headers)
|
56927
|
564 (let ((head (nnheader-parse-naked-head)))
|
31717
|
565 (mail-header-set-number head uid)
|
|
566 (mail-header-set-chars head chars)
|
|
567 (mail-header-set-lines head lines)
|
|
568 (mail-header-set-xref
|
|
569 head (format "%s %s:%d" (system-name) mbx uid))
|
|
570 head))))))
|
|
571
|
|
572 (defun nnimap-retrieve-which-headers (articles fetch-old)
|
|
573 "Get a range of articles to fetch based on ARTICLES and FETCH-OLD."
|
|
574 (with-current-buffer nnimap-server-buffer
|
|
575 (if (numberp (car-safe articles))
|
|
576 (imap-search
|
|
577 (concat "UID "
|
|
578 (imap-range-to-message-set
|
|
579 (gnus-compress-sequence
|
|
580 (append (gnus-uncompress-sequence
|
|
581 (and fetch-old
|
|
582 (cons (if (numberp fetch-old)
|
|
583 (max 1 (- (car articles) fetch-old))
|
|
584 1)
|
|
585 (1- (car articles)))))
|
|
586 articles)))))
|
|
587 (mapcar (lambda (msgid)
|
|
588 (imap-search
|
56927
|
589 (format "HEADER Message-Id \"%s\"" msgid)))
|
31717
|
590 articles))))
|
|
591
|
|
592 (defun nnimap-group-overview-filename (group server)
|
49274
|
593 "Make file name for GROUP on SERVER."
|
32995
|
594 (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
|
56927
|
595 (uidvalidity (gnus-group-get-parameter
|
|
596 (gnus-group-prefixed-name
|
|
597 group (gnus-server-to-method
|
|
598 (format "nnimap:%s" server)))
|
|
599 'uidvalidity))
|
|
600 (name (nnheader-translate-file-chars
|
|
601 (concat nnimap-nov-file-name
|
|
602 (if (equal server "")
|
|
603 "unnamed"
|
|
604 server) "." group nnimap-nov-file-name-suffix) t))
|
|
605 (nameuid (nnheader-translate-file-chars
|
|
606 (concat nnimap-nov-file-name
|
|
607 (if (equal server "")
|
|
608 "unnamed"
|
|
609 server) "." group "." uidvalidity
|
|
610 nnimap-nov-file-name-suffix) t))
|
|
611 (oldfile (if (or nnmail-use-long-file-names
|
|
612 (file-exists-p (expand-file-name name dir)))
|
|
613 (expand-file-name name dir)
|
|
614 (expand-file-name
|
|
615 (mm-encode-coding-string
|
|
616 (nnheader-replace-chars-in-string name ?. ?/)
|
|
617 nnmail-pathname-coding-system)
|
|
618 dir)))
|
|
619 (newfile (if (or nnmail-use-long-file-names
|
|
620 (file-exists-p (expand-file-name nameuid dir)))
|
|
621 (expand-file-name nameuid dir)
|
|
622 (expand-file-name
|
|
623 (mm-encode-coding-string
|
|
624 (nnheader-replace-chars-in-string nameuid ?. ?/)
|
|
625 nnmail-pathname-coding-system)
|
|
626 dir))))
|
32995
|
627 (when (and (file-exists-p oldfile) (not (file-exists-p newfile)))
|
|
628 (message "nnimap: Upgrading novcache filename...")
|
|
629 (sit-for 1)
|
|
630 (gnus-make-directory (file-name-directory newfile))
|
|
631 (unless (ignore-errors (rename-file oldfile newfile) t)
|
|
632 (if (ignore-errors (copy-file oldfile newfile) t)
|
|
633 (delete-file oldfile)
|
|
634 (error "Can't rename `%s' to `%s'" oldfile newfile))))
|
|
635 newfile))
|
31717
|
636
|
|
637 (defun nnimap-retrieve-headers-from-file (group server)
|
|
638 (with-current-buffer nntp-server-buffer
|
|
639 (let ((nov (nnimap-group-overview-filename group server)))
|
|
640 (when (file-exists-p nov)
|
|
641 (mm-insert-file-contents nov)
|
|
642 (set-buffer-modified-p nil)
|
|
643 (let ((min (ignore-errors (goto-char (point-min))
|
|
644 (read (current-buffer))))
|
|
645 (max (ignore-errors (goto-char (point-max))
|
|
646 (forward-line -1)
|
|
647 (read (current-buffer)))))
|
|
648 (if (and (numberp min) (numberp max))
|
|
649 (cons min max)
|
|
650 ;; junk, remove it, it's saved later
|
|
651 (erase-buffer)
|
|
652 nil))))))
|
|
653
|
|
654 (defun nnimap-retrieve-headers-from-server (articles group server)
|
|
655 (with-current-buffer nnimap-server-buffer
|
|
656 (let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
|
|
657 (nnimap-length (gnus-range-length articles))
|
|
658 (nnimap-counter 0))
|
|
659 (imap-fetch (imap-range-to-message-set articles)
|
|
660 (concat "(UID RFC822.SIZE BODY "
|
|
661 (let ((headers
|
|
662 (append '(Subject From Date Message-Id
|
|
663 References In-Reply-To Xref)
|
|
664 (copy-sequence
|
|
665 nnmail-extra-headers))))
|
|
666 (if (imap-capability 'IMAP4rev1)
|
|
667 (format "BODY.PEEK[HEADER.FIELDS %s])" headers)
|
|
668 (format "RFC822.HEADER.LINES %s)" headers)))))
|
60526
|
669 (with-current-buffer nntp-server-buffer
|
60558
474d659beb95
(nnimap-retrieve-headers-from-server): Fix last change.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
670 (sort-numeric-fields 1 (point-min) (point-max)))
|
31717
|
671 (and (numberp nnmail-large-newsgroup)
|
|
672 (> nnimap-length nnmail-large-newsgroup)
|
|
673 (nnheader-message 6 "nnimap: Retrieving headers...done")))))
|
|
674
|
56927
|
675 (defun nnimap-dont-use-nov-p (group server)
|
31717
|
676 (or gnus-nov-is-evil nnimap-nov-is-evil
|
|
677 (unless (and (gnus-make-directory
|
|
678 (file-name-directory
|
|
679 (nnimap-group-overview-filename group server)))
|
|
680 (file-writable-p
|
|
681 (nnimap-group-overview-filename group server)))
|
|
682 (message "nnimap: Nov cache not writable, %s"
|
|
683 (nnimap-group-overview-filename group server)))))
|
|
684
|
|
685 (deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
|
|
686 (when (nnimap-possibly-change-group group server)
|
|
687 (with-current-buffer nntp-server-buffer
|
|
688 (erase-buffer)
|
56927
|
689 (if (nnimap-dont-use-nov-p group server)
|
31717
|
690 (nnimap-retrieve-headers-from-server
|
|
691 (gnus-compress-sequence articles) group server)
|
|
692 (let (uids cached low high)
|
|
693 (when (setq uids (nnimap-retrieve-which-headers articles fetch-old)
|
|
694 low (car uids)
|
|
695 high (car (last uids)))
|
|
696 (if (setq cached (nnimap-retrieve-headers-from-file group server))
|
|
697 (progn
|
|
698 ;; fetch articles with uids before cache block
|
|
699 (when (< low (car cached))
|
|
700 (goto-char (point-min))
|
|
701 (nnimap-retrieve-headers-from-server
|
|
702 (cons low (1- (car cached))) group server))
|
|
703 ;; fetch articles with uids after cache block
|
|
704 (when (> high (cdr cached))
|
|
705 (goto-char (point-max))
|
|
706 (nnimap-retrieve-headers-from-server
|
|
707 (cons (1+ (cdr cached)) high) group server))
|
|
708 (when nnimap-prune-cache
|
|
709 ;; remove nov's for articles which has expired on server
|
|
710 (goto-char (point-min))
|
|
711 (dolist (uid (gnus-set-difference articles uids))
|
56927
|
712 (when (re-search-forward (format "^%d\t" uid) nil t)
|
|
713 (gnus-delete-line)))))
|
31717
|
714 ;; nothing cached, fetch whole range from server
|
|
715 (nnimap-retrieve-headers-from-server
|
|
716 (cons low high) group server))
|
|
717 (when (buffer-modified-p)
|
|
718 (nnmail-write-region
|
44512
d9d12d6d22cc
(nnimap-retrieve-headers): Don't assume point-min == 1.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
719 (point-min) (point-max)
|
d9d12d6d22cc
(nnimap-retrieve-headers): Don't assume point-min == 1.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
720 (nnimap-group-overview-filename group server) nil 'nomesg))
|
31717
|
721 (nnheader-nov-delete-outside-range low high))))
|
|
722 'nov)))
|
|
723
|
|
724 (defun nnimap-open-connection (server)
|
|
725 (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
|
|
726 nnimap-authenticator nnimap-server-buffer))
|
|
727 (nnheader-report 'nnimap "Can't open connection to server %s" server)
|
|
728 (unless (or (imap-capability 'IMAP4 nnimap-server-buffer)
|
|
729 (imap-capability 'IMAP4rev1 nnimap-server-buffer))
|
|
730 (imap-close nnimap-server-buffer)
|
|
731 (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
|
60696
|
732 (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'."
|
|
733 nnimap-authinfo-file)
|
|
734 (gnus-parse-netrc nnimap-authinfo-file)))
|
31717
|
735 (port (if nnimap-server-port
|
|
736 (int-to-string nnimap-server-port)
|
|
737 "imap"))
|
56927
|
738 (alist (or (gnus-netrc-machine list server port "imap")
|
57055
|
739 (gnus-netrc-machine list server port "imaps")
|
56927
|
740 (gnus-netrc-machine list
|
|
741 (or nnimap-server-address
|
|
742 nnimap-address)
|
57056
|
743 port "imap")
|
57055
|
744 (gnus-netrc-machine list
|
|
745 (or nnimap-server-address
|
|
746 nnimap-address)
|
|
747 port "imaps")))
|
31717
|
748 (user (gnus-netrc-get alist "login"))
|
|
749 (passwd (gnus-netrc-get alist "password")))
|
|
750 (if (imap-authenticate user passwd nnimap-server-buffer)
|
|
751 (prog1
|
|
752 (push (list server nnimap-server-buffer)
|
|
753 nnimap-server-buffer-alist)
|
|
754 (nnimap-possibly-change-server server))
|
|
755 (imap-close nnimap-server-buffer)
|
|
756 (kill-buffer nnimap-server-buffer)
|
|
757 (nnheader-report 'nnimap "Could not authenticate to %s" server)))))
|
|
758
|
|
759 (deffoo nnimap-open-server (server &optional defs)
|
|
760 (nnheader-init-server-buffer)
|
|
761 (if (nnimap-server-opened server)
|
|
762 t
|
|
763 (unless (assq 'nnimap-server-buffer defs)
|
|
764 (push (list 'nnimap-server-buffer (concat " *nnimap* " server)) defs))
|
|
765 ;; translate `nnimap-server-address' to `nnimap-address' in defs
|
|
766 ;; for people that configured nnimap with a very old version
|
|
767 (unless (assq 'nnimap-address defs)
|
|
768 (if (assq 'nnimap-server-address defs)
|
|
769 (push (list 'nnimap-address
|
|
770 (cadr (assq 'nnimap-server-address defs))) defs)
|
|
771 (push (list 'nnimap-address server) defs)))
|
|
772 (nnoo-change-server 'nnimap server defs)
|
56927
|
773 (or nnimap-server-buffer
|
|
774 (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
|
31717
|
775 (with-current-buffer (get-buffer-create nnimap-server-buffer)
|
|
776 (nnoo-change-server 'nnimap server defs))
|
|
777 (or (and nnimap-server-buffer
|
56927
|
778 (imap-opened nnimap-server-buffer)
|
|
779 (if (with-current-buffer nnimap-server-buffer
|
|
780 (memq imap-state '(auth select examine)))
|
|
781 t
|
|
782 (imap-close nnimap-server-buffer)
|
|
783 (nnimap-open-connection server)))
|
31717
|
784 (nnimap-open-connection server))))
|
|
785
|
|
786 (deffoo nnimap-server-opened (&optional server)
|
|
787 "Whether SERVER is opened.
|
|
788 If SERVER is the current virtual server, and the connection to the
|
|
789 physical server is alive, this function return a non-nil value. If
|
|
790 SERVER is nil, it is treated as the current server."
|
|
791 ;; clean up autologouts??
|
|
792 (and (or server nnimap-current-server)
|
|
793 (nnoo-server-opened 'nnimap (or server nnimap-current-server))
|
|
794 (imap-opened (nnimap-get-server-buffer server))))
|
|
795
|
|
796 (deffoo nnimap-close-server (&optional server)
|
|
797 "Close connection to server and free all resources connected to it.
|
|
798 Return nil if the server couldn't be closed for some reason."
|
|
799 (let ((server (or server nnimap-current-server)))
|
|
800 (when (or (nnimap-server-opened server)
|
|
801 (imap-opened (nnimap-get-server-buffer server)))
|
|
802 (imap-close (nnimap-get-server-buffer server))
|
|
803 (kill-buffer (nnimap-get-server-buffer server))
|
|
804 (setq nnimap-server-buffer nil
|
|
805 nnimap-current-server nil
|
|
806 nnimap-server-buffer-alist
|
|
807 (delq server nnimap-server-buffer-alist)))
|
|
808 (nnoo-close-server 'nnimap server)))
|
|
809
|
|
810 (deffoo nnimap-request-close ()
|
|
811 "Close connection to all servers and free all resources that the backend have reserved.
|
|
812 All buffers that have been created by that
|
|
813 backend should be killed. (Not the nntp-server-buffer, though.) This
|
|
814 function is generally only called when Gnus is shutting down."
|
|
815 (mapcar (lambda (server) (nnimap-close-server (car server)))
|
|
816 nnimap-server-buffer-alist)
|
|
817 (setq nnimap-server-buffer-alist nil))
|
|
818
|
|
819 (deffoo nnimap-status-message (&optional server)
|
|
820 "This function returns the last error message from server."
|
|
821 (when (nnimap-possibly-change-server server)
|
|
822 (nnoo-status-message 'nnimap server)))
|
|
823
|
|
824 (defun nnimap-demule (string)
|
55398
|
825 ;; BEWARE: we used to use string-as-multibyte here which is braindead
|
|
826 ;; because it will turn accidental emacs-mule-valid byte sequences
|
|
827 ;; into multibyte chars. --Stef
|
57120
|
828 ;; Reverted, braindead got 7.5 out of 10 on imdb, so it can't be
|
|
829 ;; that bad. --Simon
|
|
830 (funcall (if (and (fboundp 'string-as-multibyte)
|
|
831 (subrp (symbol-function 'string-as-multibyte)))
|
|
832 'string-as-multibyte
|
31717
|
833 'identity)
|
|
834 (or string "")))
|
|
835
|
56927
|
836 (defun nnimap-make-callback (article gnus-callback buffer)
|
|
837 "Return a callback function."
|
59996
|
838 `(lambda ()
|
56927
|
839 (nnimap-callback ,article ,gnus-callback ,buffer)))
|
|
840
|
|
841 (defun nnimap-callback (article gnus-callback buffer)
|
|
842 (when (eq article (imap-current-message))
|
|
843 (remove-hook 'imap-fetch-data-hook
|
|
844 (nnimap-make-callback article gnus-callback buffer))
|
|
845 (with-current-buffer buffer
|
|
846 (insert
|
|
847 (with-current-buffer nnimap-server-buffer
|
|
848 (nnimap-demule
|
|
849 (if (imap-capability 'IMAP4rev1)
|
|
850 ;; xxx don't just use car? alist doesn't contain
|
|
851 ;; anything else now, but it might...
|
|
852 (nth 2 (car (imap-message-get article 'BODYDETAIL)))
|
|
853 (imap-message-get article 'RFC822)))))
|
|
854 (nnheader-ms-strip-cr)
|
|
855 (funcall gnus-callback t))))
|
31717
|
856
|
|
857 (defun nnimap-request-article-part (article part prop &optional
|
56927
|
858 group server to-buffer detail)
|
31717
|
859 (when (nnimap-possibly-change-group group server)
|
|
860 (let ((article (if (stringp article)
|
|
861 (car-safe (imap-search
|
56927
|
862 (format "HEADER Message-Id \"%s\"" article)
|
31717
|
863 nnimap-server-buffer))
|
|
864 article)))
|
|
865 (when article
|
56927
|
866 (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
|
|
867 article (or group imap-current-mailbox
|
|
868 gnus-newsgroup-name))
|
31717
|
869 (if (not nnheader-callback-function)
|
|
870 (with-current-buffer (or to-buffer nntp-server-buffer)
|
|
871 (erase-buffer)
|
56927
|
872 (let ((data (imap-fetch article part prop nil
|
|
873 nnimap-server-buffer)))
|
|
874 (insert (nnimap-demule (if detail
|
|
875 (nth 2 (car data))
|
|
876 data))))
|
|
877 (nnheader-ms-strip-cr)
|
|
878 (gnus-message
|
|
879 10 "nnimap: Fetching (part of) article %d from %s...done"
|
|
880 article (or group imap-current-mailbox gnus-newsgroup-name))
|
31717
|
881 (if (bobp)
|
56927
|
882 (nnheader-report 'nnimap "No such article %d in %s: %s"
|
|
883 article (or group imap-current-mailbox
|
|
884 gnus-newsgroup-name)
|
31717
|
885 (imap-error-text nnimap-server-buffer))
|
|
886 (cons group article)))
|
56927
|
887 (add-hook 'imap-fetch-data-hook
|
59996
|
888 (nnimap-make-callback article
|
|
889 nnheader-callback-function
|
56927
|
890 nntp-server-buffer))
|
31717
|
891 (imap-fetch-asynch article part nil nnimap-server-buffer)
|
|
892 (cons group article))))))
|
|
893
|
|
894 (deffoo nnimap-asynchronous-p ()
|
|
895 t)
|
|
896
|
|
897 (deffoo nnimap-request-article (article &optional group server to-buffer)
|
|
898 (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
|
|
899 (nnimap-request-article-part
|
|
900 article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer 'detail)
|
|
901 (nnimap-request-article-part
|
|
902 article "RFC822.PEEK" 'RFC822 group server to-buffer)))
|
|
903
|
|
904 (deffoo nnimap-request-head (article &optional group server to-buffer)
|
|
905 (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
|
|
906 (nnimap-request-article-part
|
|
907 article "BODY.PEEK[HEADER]" 'BODYDETAIL group server to-buffer 'detail)
|
|
908 (nnimap-request-article-part
|
|
909 article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer)))
|
|
910
|
|
911 (deffoo nnimap-request-body (article &optional group server to-buffer)
|
|
912 (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
|
|
913 (nnimap-request-article-part
|
|
914 article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer 'detail)
|
|
915 (nnimap-request-article-part
|
|
916 article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer)))
|
|
917
|
|
918 (deffoo nnimap-request-group (group &optional server fast)
|
|
919 (nnimap-request-update-info-internal
|
|
920 group
|
|
921 (gnus-get-info (gnus-group-prefixed-name
|
|
922 group (gnus-server-to-method (format "nnimap:%s" server))))
|
|
923 server)
|
|
924 (when (nnimap-possibly-change-group group server)
|
|
925 (nnimap-before-find-minmax-bugworkaround)
|
|
926 (let (info)
|
|
927 (cond (fast group)
|
|
928 ((null (setq info (nnimap-find-minmax-uid group t)))
|
|
929 (nnheader-report 'nnimap "Could not get active info for %s"
|
|
930 group))
|
|
931 (t
|
|
932 (nnheader-insert "211 %d %d %d %s\n" (or (nth 0 info) 0)
|
|
933 (max 1 (or (nth 1 info) 1))
|
|
934 (or (nth 2 info) 0) group)
|
|
935 (nnheader-report 'nnimap "Group %s selected" group)
|
|
936 t)))))
|
|
937
|
56927
|
938 (defun nnimap-update-unseen (group &optional server)
|
|
939 "Update the unseen count in `nnimap-mailbox-info'."
|
|
940 (gnus-sethash
|
|
941 (gnus-group-prefixed-name group server)
|
59996
|
942 (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
|
56927
|
943 nnimap-mailbox-info)))
|
|
944 (list (nth 0 old) (nth 1 old)
|
|
945 (imap-mailbox-status group 'unseen nnimap-server-buffer)
|
|
946 (nth 3 old)))
|
|
947 nnimap-mailbox-info))
|
|
948
|
31717
|
949 (defun nnimap-close-group (group &optional server)
|
|
950 (with-current-buffer nnimap-server-buffer
|
|
951 (when (and (imap-opened)
|
|
952 (nnimap-possibly-change-group group server))
|
56927
|
953 (nnimap-update-unseen group server)
|
31717
|
954 (case nnimap-expunge-on-close
|
56927
|
955 (always (progn
|
|
956 (imap-mailbox-expunge nnimap-close-asynchronous)
|
|
957 (unless nnimap-dont-close
|
|
958 (imap-mailbox-close nnimap-close-asynchronous))))
|
|
959 (ask (if (and (imap-search "DELETED")
|
|
960 (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
|
|
961 imap-current-mailbox)))
|
|
962 (progn
|
|
963 (imap-mailbox-expunge nnimap-close-asynchronous)
|
|
964 (unless nnimap-dont-close
|
|
965 (imap-mailbox-close nnimap-close-asynchronous)))
|
|
966 (imap-mailbox-unselect)))
|
31717
|
967 (t (imap-mailbox-unselect)))
|
|
968 (not imap-current-mailbox))))
|
|
969
|
|
970 (defun nnimap-pattern-to-list-arguments (pattern)
|
|
971 (mapcar (lambda (p)
|
|
972 (cons (car-safe p) (or (cdr-safe p) p)))
|
|
973 (if (and (listp pattern)
|
|
974 (listp (cdr pattern)))
|
|
975 pattern
|
|
976 (list pattern))))
|
|
977
|
|
978 (deffoo nnimap-request-list (&optional server)
|
|
979 (when (nnimap-possibly-change-server server)
|
|
980 (with-current-buffer nntp-server-buffer
|
|
981 (erase-buffer))
|
|
982 (gnus-message 5 "nnimap: Generating active list%s..."
|
|
983 (if (> (length server) 0) (concat " for " server) ""))
|
|
984 (nnimap-before-find-minmax-bugworkaround)
|
|
985 (with-current-buffer nnimap-server-buffer
|
|
986 (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
|
|
987 (dolist (mbx (funcall nnimap-request-list-method
|
|
988 (cdr pattern) (car pattern)))
|
|
989 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
|
|
990 (let ((info (nnimap-find-minmax-uid mbx 'examine)))
|
|
991 (when info
|
|
992 (with-current-buffer nntp-server-buffer
|
56927
|
993 (insert (format "\"%s\" %d %d y\n"
|
|
994 mbx (or (nth 2 info) 0)
|
|
995 (max 1 (or (nth 1 info) 1)))))))))))
|
31717
|
996 (gnus-message 5 "nnimap: Generating active list%s...done"
|
|
997 (if (> (length server) 0) (concat " for " server) ""))
|
|
998 t))
|
|
999
|
|
1000 (deffoo nnimap-request-post (&optional server)
|
|
1001 (let ((success t))
|
|
1002 (dolist (mbx (message-unquote-tokens
|
56927
|
1003 (message-tokenize-header
|
|
1004 (message-fetch-field "Newsgroups") ", ")) success)
|
31717
|
1005 (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
|
|
1006 (or (gnus-active to-newsgroup)
|
|
1007 (gnus-activate-group to-newsgroup)
|
|
1008 (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
|
|
1009 to-newsgroup))
|
|
1010 (or (and (gnus-request-create-group
|
|
1011 to-newsgroup gnus-command-method)
|
|
1012 (gnus-activate-group to-newsgroup nil nil
|
|
1013 gnus-command-method))
|
|
1014 (error "Couldn't create group %s" to-newsgroup)))
|
|
1015 (error "No such group: %s" to-newsgroup))
|
|
1016 (unless (nnimap-request-accept-article mbx (nth 1 gnus-command-method))
|
|
1017 (setq success nil))))))
|
|
1018
|
|
1019 ;; Optional backend functions
|
|
1020
|
56927
|
1021 (defun nnimap-string-lessp-numerical (s1 s2)
|
|
1022 "Return t if first arg string is less than second in numerical order."
|
|
1023 (cond ((string= s1 s2)
|
|
1024 nil)
|
|
1025 ((> (length s1) (length s2))
|
|
1026 nil)
|
|
1027 ((< (length s1) (length s2))
|
|
1028 t)
|
|
1029 ((< (string-to-number (substring s1 0 1))
|
|
1030 (string-to-number (substring s2 0 1)))
|
|
1031 t)
|
|
1032 ((> (string-to-number (substring s1 0 1))
|
|
1033 (string-to-number (substring s2 0 1)))
|
|
1034 nil)
|
|
1035 (t
|
|
1036 (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1)))))
|
|
1037
|
31717
|
1038 (deffoo nnimap-retrieve-groups (groups &optional server)
|
|
1039 (when (nnimap-possibly-change-server server)
|
|
1040 (gnus-message 5 "nnimap: Checking mailboxes...")
|
|
1041 (with-current-buffer nntp-server-buffer
|
|
1042 (erase-buffer)
|
|
1043 (nnimap-before-find-minmax-bugworkaround)
|
56927
|
1044 (let (asyncgroups slowgroups)
|
|
1045 (if (null nnimap-retrieve-groups-asynchronous)
|
|
1046 (setq slowgroups groups)
|
|
1047 (dolist (group groups)
|
|
1048 (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
|
|
1049 (add-to-list (if (gnus-gethash-safe
|
|
1050 (gnus-group-prefixed-name group server)
|
|
1051 nnimap-mailbox-info)
|
|
1052 'asyncgroups
|
|
1053 'slowgroups)
|
|
1054 (list group (imap-mailbox-status-asynch
|
59996
|
1055 group '(uidvalidity uidnext unseen)
|
56927
|
1056 nnimap-server-buffer))))
|
|
1057 (dolist (asyncgroup asyncgroups)
|
|
1058 (let ((group (nth 0 asyncgroup))
|
|
1059 (tag (nth 1 asyncgroup))
|
|
1060 new old)
|
|
1061 (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
|
|
1062 (if (or (not (string=
|
|
1063 (nth 0 (gnus-gethash (gnus-group-prefixed-name
|
|
1064 group server)
|
|
1065 nnimap-mailbox-info))
|
59996
|
1066 (imap-mailbox-get 'uidvalidity group
|
56927
|
1067 nnimap-server-buffer)))
|
|
1068 (not (string=
|
|
1069 (nth 1 (gnus-gethash (gnus-group-prefixed-name
|
|
1070 group server)
|
|
1071 nnimap-mailbox-info))
|
|
1072 (imap-mailbox-get 'uidnext group
|
|
1073 nnimap-server-buffer))))
|
|
1074 (push (list group) slowgroups)
|
|
1075 (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
|
|
1076 group server)
|
|
1077 nnimap-mailbox-info))))))))
|
|
1078 (dolist (group slowgroups)
|
|
1079 (if nnimap-retrieve-groups-asynchronous
|
|
1080 (setq group (car group)))
|
|
1081 (gnus-message 7 "nnimap: Mailbox %s modified" group)
|
|
1082 (imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
|
|
1083 (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
|
|
1084 nnimap-server-buffer))
|
|
1085 (let* ((info (nnimap-find-minmax-uid group 'examine))
|
|
1086 (str (format "\"%s\" %d %d y\n" group
|
|
1087 (or (nth 2 info) 0)
|
|
1088 (max 1 (or (nth 1 info) 1)))))
|
|
1089 (when (> (or (imap-mailbox-get 'recent group
|
|
1090 nnimap-server-buffer) 0)
|
|
1091 0)
|
|
1092 (push (list (cons group 0)) nnmail-split-history))
|
|
1093 (insert str)
|
|
1094 (when nnimap-retrieve-groups-asynchronous
|
|
1095 (gnus-sethash
|
|
1096 (gnus-group-prefixed-name group server)
|
|
1097 (list (or (imap-mailbox-get
|
|
1098 'uidvalidity group nnimap-server-buffer)
|
|
1099 (imap-mailbox-status
|
|
1100 group 'uidvalidity nnimap-server-buffer))
|
|
1101 (or (imap-mailbox-get
|
|
1102 'uidnext group nnimap-server-buffer)
|
|
1103 (imap-mailbox-status
|
|
1104 group 'uidnext nnimap-server-buffer))
|
|
1105 (or (imap-mailbox-get
|
|
1106 'unseen group nnimap-server-buffer)
|
|
1107 (imap-mailbox-status
|
|
1108 group 'unseen nnimap-server-buffer))
|
|
1109 str)
|
|
1110 nnimap-mailbox-info)))))))
|
31717
|
1111 (gnus-message 5 "nnimap: Checking mailboxes...done")
|
|
1112 'active))
|
|
1113
|
|
1114 (deffoo nnimap-request-update-info-internal (group info &optional server)
|
|
1115 (when (nnimap-possibly-change-group group server)
|
56927
|
1116 (when info ;; xxx what does this mean? should we create a info?
|
31717
|
1117 (with-current-buffer nnimap-server-buffer
|
|
1118 (gnus-message 5 "nnimap: Updating info for %s..."
|
|
1119 (gnus-info-group info))
|
49598
|
1120
|
31717
|
1121 (when (nnimap-mark-permanent-p 'read)
|
|
1122 (let (seen unseen)
|
|
1123 ;; read info could contain articles marked unread by other
|
|
1124 ;; imap clients! we correct this
|
|
1125 (setq seen (gnus-uncompress-range (gnus-info-read info))
|
|
1126 unseen (imap-search "UNSEEN UNDELETED")
|
|
1127 seen (gnus-set-difference seen unseen)
|
|
1128 ;; seen might lack articles marked as read by other
|
|
1129 ;; imap clients! we correct this
|
|
1130 seen (append seen (imap-search "SEEN"))
|
|
1131 ;; remove dupes
|
|
1132 seen (sort seen '<)
|
|
1133 seen (gnus-compress-sequence seen t)
|
|
1134 ;; we can't return '(1) since this isn't a "list of ranges",
|
|
1135 ;; and we can't return '((1)) since g-list-of-unread-articles
|
|
1136 ;; is buggy so we return '((1 . 1)).
|
|
1137 seen (if (and (integerp (car seen))
|
|
1138 (null (cdr seen)))
|
|
1139 (list (cons (car seen) (car seen)))
|
|
1140 seen))
|
|
1141 (gnus-info-set-read info seen)))
|
|
1142
|
|
1143 (mapcar (lambda (pred)
|
56927
|
1144 (when (or (eq (cdr pred) 'recent)
|
|
1145 (and (nnimap-mark-permanent-p (cdr pred))
|
|
1146 (member (nnimap-mark-to-flag (cdr pred))
|
|
1147 (imap-mailbox-get 'flags))))
|
31717
|
1148 (gnus-info-set-marks
|
|
1149 info
|
56927
|
1150 (gnus-update-alist-soft
|
31717
|
1151 (cdr pred)
|
|
1152 (gnus-compress-sequence
|
|
1153 (imap-search (nnimap-mark-to-predicate (cdr pred))))
|
|
1154 (gnus-info-marks info))
|
|
1155 t)))
|
|
1156 gnus-article-mark-lists)
|
|
1157
|
56927
|
1158 (when nnimap-importantize-dormant
|
|
1159 ;; nnimap mark dormant article as ticked too (for other clients)
|
|
1160 ;; so we remove that mark for gnus since we support dormant
|
|
1161 (gnus-info-set-marks
|
|
1162 info
|
|
1163 (gnus-update-alist-soft
|
|
1164 'tick
|
|
1165 (gnus-remove-from-range
|
|
1166 (cdr-safe (assoc 'tick (gnus-info-marks info)))
|
|
1167 (cdr-safe (assoc 'dormant (gnus-info-marks info))))
|
|
1168 (gnus-info-marks info))
|
|
1169 t))
|
49598
|
1170
|
31717
|
1171 (gnus-message 5 "nnimap: Updating info for %s...done"
|
|
1172 (gnus-info-group info))
|
|
1173
|
|
1174 info))))
|
|
1175
|
|
1176 (deffoo nnimap-request-type (group &optional article)
|
|
1177 (if (and nnimap-news-groups (string-match nnimap-news-groups group))
|
|
1178 'news
|
|
1179 'mail))
|
|
1180
|
|
1181 (deffoo nnimap-request-set-mark (group actions &optional server)
|
|
1182 (when (nnimap-possibly-change-group group server)
|
|
1183 (with-current-buffer nnimap-server-buffer
|
|
1184 (let (action)
|
|
1185 (gnus-message 7 "nnimap: Setting marks in %s..." group)
|
|
1186 (while (setq action (pop actions))
|
|
1187 (let ((range (nth 0 action))
|
|
1188 (what (nth 1 action))
|
|
1189 (cmdmarks (nth 2 action))
|
|
1190 marks)
|
56927
|
1191 ;; bookmark can't be stored (not list/range
|
|
1192 (setq cmdmarks (delq 'bookmark cmdmarks))
|
|
1193 ;; killed can't be stored (not list/range
|
|
1194 (setq cmdmarks (delq 'killed cmdmarks))
|
|
1195 ;; unsent are for nndraft groups only
|
|
1196 (setq cmdmarks (delq 'unsent cmdmarks))
|
31717
|
1197 ;; cache flags are pointless on the server
|
|
1198 (setq cmdmarks (delq 'cache cmdmarks))
|
56927
|
1199 ;; seen flags are local to each gnus
|
|
1200 (setq cmdmarks (delq 'seen cmdmarks))
|
|
1201 ;; recent marks can't be set
|
|
1202 (setq cmdmarks (delq 'recent cmdmarks))
|
|
1203 (when nnimap-importantize-dormant
|
|
1204 ;; flag dormant articles as ticked
|
|
1205 (if (memq 'dormant cmdmarks)
|
|
1206 (setq cmdmarks (cons 'tick cmdmarks))))
|
31717
|
1207 ;; remove stuff we are forbidden to store
|
|
1208 (mapcar (lambda (mark)
|
|
1209 (if (imap-message-flag-permanent-p
|
|
1210 (nnimap-mark-to-flag mark))
|
|
1211 (setq marks (cons mark marks))))
|
|
1212 cmdmarks)
|
|
1213 (when (and range marks)
|
|
1214 (cond ((eq what 'del)
|
|
1215 (imap-message-flags-del
|
|
1216 (imap-range-to-message-set range)
|
|
1217 (nnimap-mark-to-flag marks nil t)))
|
|
1218 ((eq what 'add)
|
|
1219 (imap-message-flags-add
|
|
1220 (imap-range-to-message-set range)
|
|
1221 (nnimap-mark-to-flag marks nil t)))
|
|
1222 ((eq what 'set)
|
|
1223 (imap-message-flags-set
|
|
1224 (imap-range-to-message-set range)
|
|
1225 (nnimap-mark-to-flag marks nil t)))))))
|
|
1226 (gnus-message 7 "nnimap: Setting marks in %s...done" group))))
|
|
1227 nil)
|
|
1228
|
|
1229 (defun nnimap-split-fancy ()
|
56927
|
1230 "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'."
|
31717
|
1231 (let ((nnmail-split-fancy nnimap-split-fancy))
|
|
1232 (nnmail-split-fancy)))
|
|
1233
|
|
1234 (defun nnimap-split-to-groups (rules)
|
|
1235 ;; tries to match all rules in nnimap-split-rule against content of
|
|
1236 ;; nntp-server-buffer, returns a list of groups that matched.
|
|
1237 (with-current-buffer nntp-server-buffer
|
|
1238 ;; Fold continuation lines.
|
|
1239 (goto-char (point-min))
|
|
1240 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
|
|
1241 (replace-match " " t t))
|
|
1242 (if (functionp rules)
|
|
1243 (funcall rules)
|
|
1244 (let (to-groups regrepp)
|
|
1245 (catch 'split-done
|
|
1246 (dolist (rule rules to-groups)
|
|
1247 (let ((group (car rule))
|
|
1248 (regexp (cadr rule)))
|
|
1249 (goto-char (point-min))
|
|
1250 (when (and (if (stringp regexp)
|
|
1251 (progn
|
56927
|
1252 (if (not (stringp group))
|
|
1253 (setq group (eval group))
|
|
1254 (setq regrepp
|
|
1255 (string-match "\\\\[0-9&]" group)))
|
31717
|
1256 (re-search-forward regexp nil t))
|
|
1257 (funcall regexp group))
|
|
1258 ;; Don't enter the article into the same group twice.
|
|
1259 (not (assoc group to-groups)))
|
|
1260 (push (if regrepp
|
|
1261 (nnmail-expand-newtext group)
|
|
1262 group)
|
|
1263 to-groups)
|
|
1264 (or nnimap-split-crosspost
|
|
1265 (throw 'split-done to-groups))))))))))
|
49598
|
1266
|
31717
|
1267 (defun nnimap-assoc-match (key alist)
|
|
1268 (let (element)
|
|
1269 (while (and alist (not element))
|
|
1270 (if (string-match (car (car alist)) key)
|
|
1271 (setq element (car alist)))
|
|
1272 (setq alist (cdr alist)))
|
|
1273 element))
|
|
1274
|
|
1275 (defun nnimap-split-find-rule (server inbox)
|
|
1276 (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule))
|
56927
|
1277 (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))
|
31717
|
1278 ;; extended format
|
49598
|
1279 (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match
|
31717
|
1280 server nnimap-split-rule))))
|
|
1281 nnimap-split-rule))
|
|
1282
|
|
1283 (defun nnimap-split-find-inbox (server)
|
|
1284 (if (listp nnimap-split-inbox)
|
|
1285 nnimap-split-inbox
|
|
1286 (list nnimap-split-inbox)))
|
|
1287
|
|
1288 (defun nnimap-split-articles (&optional group server)
|
|
1289 (when (nnimap-possibly-change-server server)
|
|
1290 (with-current-buffer nnimap-server-buffer
|
|
1291 (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))
|
|
1292 ;; iterate over inboxes
|
|
1293 (while (and (setq inbox (pop inboxes))
|
56927
|
1294 (nnimap-possibly-change-group inbox)) ;; SELECT
|
31717
|
1295 ;; find split rule for this server / inbox
|
|
1296 (when (setq rule (nnimap-split-find-rule server inbox))
|
|
1297 ;; iterate over articles
|
|
1298 (dolist (article (imap-search nnimap-split-predicate))
|
56927
|
1299 (when (if (if (eq nnimap-split-download-body 'default)
|
|
1300 nnimap-split-download-body-default
|
|
1301 nnimap-split-download-body)
|
|
1302 (and (nnimap-request-article article)
|
|
1303 (with-current-buffer nntp-server-buffer (mail-narrow-to-head)))
|
|
1304 (nnimap-request-head article))
|
31717
|
1305 ;; copy article to right group(s)
|
|
1306 (setq removeorig nil)
|
|
1307 (dolist (to-group (nnimap-split-to-groups rule))
|
56927
|
1308 (cond ((eq to-group 'junk)
|
|
1309 (message "IMAP split removed %s:%s:%d" server inbox
|
|
1310 article)
|
|
1311 (setq removeorig t))
|
|
1312 ((imap-message-copy (number-to-string article)
|
|
1313 to-group nil 'nocopyuid)
|
|
1314 (message "IMAP split moved %s:%s:%d to %s" server
|
|
1315 inbox article to-group)
|
|
1316 (setq removeorig t)
|
|
1317 (when nnmail-cache-accepted-message-ids
|
|
1318 (with-current-buffer nntp-server-buffer
|
|
1319 (let (msgid)
|
|
1320 (and (setq msgid
|
|
1321 (nnmail-fetch-field "message-id"))
|
59996
|
1322 (nnmail-cache-insert msgid
|
56927
|
1323 to-group
|
|
1324 (nnmail-fetch-field "subject"))))))
|
|
1325 ;; Add the group-art list to the history list.
|
|
1326 (push (list (cons to-group 0)) nnmail-split-history))
|
|
1327 (t
|
|
1328 (message "IMAP split failed to move %s:%s:%d to %s"
|
|
1329 server inbox article to-group))))
|
|
1330 (if (if (eq nnimap-split-download-body 'default)
|
|
1331 nnimap-split-download-body-default
|
|
1332 nnimap-split-download-body)
|
|
1333 (widen))
|
31717
|
1334 ;; remove article if it was successfully copied somewhere
|
|
1335 (and removeorig
|
|
1336 (imap-message-flags-add (format "%d" article)
|
|
1337 "\\Seen \\Deleted")))))
|
56927
|
1338 (when (imap-mailbox-select inbox) ;; just in case
|
31717
|
1339 ;; todo: UID EXPUNGE (if available) to remove splitted articles
|
|
1340 (imap-mailbox-expunge)
|
|
1341 (imap-mailbox-close)))
|
56927
|
1342 (when nnmail-cache-accepted-message-ids
|
|
1343 (nnmail-cache-close))
|
31717
|
1344 t))))
|
|
1345
|
|
1346 (deffoo nnimap-request-scan (&optional group server)
|
|
1347 (nnimap-split-articles group server))
|
|
1348
|
|
1349 (deffoo nnimap-request-newgroups (date &optional server)
|
|
1350 (when (nnimap-possibly-change-server server)
|
|
1351 (with-current-buffer nntp-server-buffer
|
|
1352 (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..."
|
|
1353 (if (> (length server) 0) " on " "") server)
|
|
1354 (erase-buffer)
|
|
1355 (nnimap-before-find-minmax-bugworkaround)
|
|
1356 (dolist (pattern (nnimap-pattern-to-list-arguments
|
|
1357 nnimap-list-pattern))
|
56927
|
1358 (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil
|
31717
|
1359 nnimap-server-buffer))
|
|
1360 (or (catch 'found
|
|
1361 (dolist (mailbox (imap-mailbox-get 'list-flags mbx
|
|
1362 nnimap-server-buffer))
|
|
1363 (if (string= (downcase mailbox) "\\noselect")
|
|
1364 (throw 'found t)))
|
|
1365 nil)
|
|
1366 (let ((info (nnimap-find-minmax-uid mbx 'examine)))
|
|
1367 (when info
|
56927
|
1368 (insert (format "\"%s\" %d %d y\n"
|
|
1369 mbx (or (nth 2 info) 0)
|
|
1370 (max 1 (or (nth 1 info) 1)))))))))
|
31717
|
1371 (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
|
|
1372 (if (> (length server) 0) " on " "") server))
|
|
1373 t))
|
49598
|
1374
|
31717
|
1375 (deffoo nnimap-request-create-group (group &optional server args)
|
|
1376 (when (nnimap-possibly-change-server server)
|
|
1377 (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)
|
56927
|
1378 (imap-mailbox-create group nnimap-server-buffer)
|
|
1379 (nnheader-report 'nnimap "%S"
|
|
1380 (imap-error-text nnimap-server-buffer)))))
|
31717
|
1381
|
|
1382 (defun nnimap-time-substract (time1 time2)
|
|
1383 "Return TIME for TIME1 - TIME2."
|
|
1384 (let* ((ms (- (car time1) (car time2)))
|
|
1385 (ls (- (nth 1 time1) (nth 1 time2))))
|
|
1386 (if (< ls 0)
|
|
1387 (list (- ms 1) (+ (expt 2 16) ls))
|
|
1388 (list ms ls))))
|
|
1389
|
61463
|
1390 (eval-when-compile (require 'parse-time))
|
31717
|
1391 (defun nnimap-date-days-ago (daysago)
|
|
1392 "Return date, in format \"3-Aug-1998\", for DAYSAGO days ago."
|
61304
|
1393 (require 'parse-time)
|
40494
|
1394 (let* ((time (nnimap-time-substract (current-time) (days-to-time daysago)))
|
|
1395 (date (format-time-string
|
|
1396 (format "%%d-%s-%%Y"
|
|
1397 (capitalize (car (rassoc (nth 4 (decode-time time))
|
|
1398 parse-time-months))))
|
|
1399 time)))
|
31717
|
1400 (if (eq ?0 (string-to-char date))
|
|
1401 (substring date 1)
|
|
1402 date)))
|
|
1403
|
|
1404 (defun nnimap-request-expire-articles-progress ()
|
|
1405 (gnus-message 5 "nnimap: Marking article %d for deletion..."
|
|
1406 imap-current-message))
|
|
1407
|
56927
|
1408 (defun nnimap-expiry-target (arts group server)
|
|
1409 (unless (eq nnmail-expiry-target 'delete)
|
|
1410 (with-temp-buffer
|
|
1411 (dolist (art arts)
|
|
1412 (nnimap-request-article art group server (current-buffer))
|
|
1413 ;; hints for optimization in `nnimap-request-accept-article'
|
|
1414 (let ((nnimap-current-move-article art)
|
|
1415 (nnimap-current-move-group group)
|
|
1416 (nnimap-current-move-server server))
|
|
1417 (nnmail-expiry-target-group nnmail-expiry-target group))))
|
|
1418 ;; It is not clear if `nnmail-expiry-target' somehow cause the
|
|
1419 ;; current group to be changed or not, so we make sure here.
|
|
1420 (nnimap-possibly-change-group group server)))
|
|
1421
|
31717
|
1422 ;; Notice that we don't actually delete anything, we just mark them deleted.
|
|
1423 (deffoo nnimap-request-expire-articles (articles group &optional server force)
|
|
1424 (let ((artseq (gnus-compress-sequence articles)))
|
|
1425 (when (and artseq (nnimap-possibly-change-group group server))
|
|
1426 (with-current-buffer nnimap-server-buffer
|
56927
|
1427 (let ((days (or (and nnmail-expiry-wait-function
|
|
1428 (funcall nnmail-expiry-wait-function group))
|
|
1429 nnmail-expiry-wait)))
|
|
1430 (cond ((or force (eq days 'immediate))
|
|
1431 (let ((oldarts (imap-search
|
59996
|
1432 (concat "UID "
|
56927
|
1433 (imap-range-to-message-set artseq)))))
|
|
1434 (when oldarts
|
|
1435 (nnimap-expiry-target oldarts group server)
|
|
1436 (when (imap-message-flags-add
|
59996
|
1437 (imap-range-to-message-set
|
56927
|
1438 (gnus-compress-sequence oldarts)) "\\Deleted")
|
|
1439 (setq articles (gnus-set-difference
|
|
1440 articles oldarts))))))
|
|
1441 ((numberp days)
|
|
1442 (let ((oldarts (imap-search
|
|
1443 (format nnimap-expunge-search-string
|
|
1444 (imap-range-to-message-set artseq)
|
|
1445 (nnimap-date-days-ago days))))
|
|
1446 (imap-fetch-data-hook
|
|
1447 '(nnimap-request-expire-articles-progress)))
|
|
1448 (when oldarts
|
|
1449 (nnimap-expiry-target oldarts group server)
|
|
1450 (when (imap-message-flags-add
|
59996
|
1451 (imap-range-to-message-set
|
56927
|
1452 (gnus-compress-sequence oldarts)) "\\Deleted")
|
59996
|
1453 (setq articles (gnus-set-difference
|
56927
|
1454 articles oldarts)))))))))))
|
31717
|
1455 ;; return articles not deleted
|
|
1456 articles)
|
|
1457
|
|
1458 (deffoo nnimap-request-move-article (article group server
|
|
1459 accept-form &optional last)
|
|
1460 (when (nnimap-possibly-change-server server)
|
|
1461 (save-excursion
|
|
1462 (let ((buf (get-buffer-create " *nnimap move*"))
|
|
1463 (nnimap-current-move-article article)
|
|
1464 (nnimap-current-move-group group)
|
|
1465 (nnimap-current-move-server nnimap-current-server)
|
|
1466 result)
|
|
1467 (and (nnimap-request-article article group server)
|
|
1468 (save-excursion
|
|
1469 (set-buffer buf)
|
|
1470 (buffer-disable-undo (current-buffer))
|
|
1471 (insert-buffer-substring nntp-server-buffer)
|
|
1472 (setq result (eval accept-form))
|
|
1473 (kill-buffer buf)
|
|
1474 result)
|
56927
|
1475 (imap-message-flags-add
|
|
1476 (imap-range-to-message-set (list article))
|
|
1477 "\\Deleted" 'silent nnimap-server-buffer))
|
31717
|
1478 result))))
|
49598
|
1479
|
31717
|
1480 (deffoo nnimap-request-accept-article (group &optional server last)
|
|
1481 (when (nnimap-possibly-change-server server)
|
|
1482 (let (uid)
|
|
1483 (if (setq uid
|
|
1484 (if (string= nnimap-current-server nnimap-current-move-server)
|
|
1485 ;; moving article within same server, speed it up...
|
|
1486 (and (nnimap-possibly-change-group
|
|
1487 nnimap-current-move-group)
|
|
1488 (imap-message-copy (number-to-string
|
|
1489 nnimap-current-move-article)
|
|
1490 group 'dontcreate nil
|
|
1491 nnimap-server-buffer))
|
|
1492 (with-current-buffer (current-buffer)
|
|
1493 (goto-char (point-min))
|
32995
|
1494 ;; remove any 'From blabla' lines, some IMAP servers
|
|
1495 ;; reject the entire message otherwise.
|
|
1496 (when (looking-at "^From[^:]")
|
56927
|
1497 (delete-region (point) (progn (forward-line) (point))))
|
32995
|
1498 ;; turn into rfc822 format (\r\n eol's)
|
31717
|
1499 (while (search-forward "\n" nil t)
|
56927
|
1500 (replace-match "\r\n"))
|
|
1501 (when nnmail-cache-accepted-message-ids
|
|
1502 (nnmail-cache-insert (nnmail-fetch-field "message-id")
|
|
1503 group
|
|
1504 (nnmail-fetch-field "subject"))))
|
|
1505 (when (and last nnmail-cache-accepted-message-ids)
|
|
1506 (nnmail-cache-close))
|
|
1507 ;; this 'or' is for Cyrus server bug
|
|
1508 (or (null (imap-current-mailbox nnimap-server-buffer))
|
|
1509 (imap-mailbox-unselect nnimap-server-buffer))
|
31717
|
1510 (imap-message-append group (current-buffer) nil nil
|
|
1511 nnimap-server-buffer)))
|
|
1512 (cons group (nth 1 uid))
|
|
1513 (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer))))))
|
|
1514
|
|
1515 (deffoo nnimap-request-delete-group (group force &optional server)
|
|
1516 (when (nnimap-possibly-change-server server)
|
|
1517 (with-current-buffer nnimap-server-buffer
|
|
1518 (if force
|
|
1519 (or (null (imap-mailbox-status group 'uidvalidity))
|
|
1520 (imap-mailbox-delete group))
|
|
1521 ;; UNSUBSCRIBE?
|
|
1522 t))))
|
|
1523
|
|
1524 (deffoo nnimap-request-rename-group (group new-name &optional server)
|
|
1525 (when (nnimap-possibly-change-server server)
|
|
1526 (imap-mailbox-rename group new-name nnimap-server-buffer)))
|
|
1527
|
|
1528 (defun nnimap-expunge (mailbox server)
|
|
1529 (when (nnimap-possibly-change-group mailbox server)
|
56927
|
1530 (imap-mailbox-expunge nil nnimap-server-buffer)))
|
31717
|
1531
|
|
1532 (defun nnimap-acl-get (mailbox server)
|
|
1533 (when (nnimap-possibly-change-server server)
|
32995
|
1534 (and (imap-capability 'ACL nnimap-server-buffer)
|
|
1535 (imap-mailbox-acl-get mailbox nnimap-server-buffer))))
|
31717
|
1536
|
|
1537 (defun nnimap-acl-edit (mailbox method old-acls new-acls)
|
|
1538 (when (nnimap-possibly-change-server (cadr method))
|
|
1539 (unless (imap-capability 'ACL nnimap-server-buffer)
|
|
1540 (error "Your server does not support ACL editing"))
|
|
1541 (with-current-buffer nnimap-server-buffer
|
|
1542 ;; delete all removed identifiers
|
|
1543 (mapcar (lambda (old-acl)
|
|
1544 (unless (assoc (car old-acl) new-acls)
|
|
1545 (or (imap-mailbox-acl-delete (car old-acl) mailbox)
|
|
1546 (error "Can't delete ACL for %s" (car old-acl)))))
|
|
1547 old-acls)
|
|
1548 ;; set all changed acl's
|
|
1549 (mapcar (lambda (new-acl)
|
|
1550 (let ((new-rights (cdr new-acl))
|
|
1551 (old-rights (cdr (assoc (car new-acl) old-acls))))
|
|
1552 (unless (and old-rights new-rights
|
|
1553 (string= old-rights new-rights))
|
|
1554 (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
|
|
1555 (error "Can't set ACL for %s to %s" (car new-acl)
|
|
1556 new-rights)))))
|
|
1557 new-acls)
|
|
1558 t)))
|
|
1559
|
|
1560
|
|
1561 ;;; Internal functions
|
|
1562
|
|
1563 ;;
|
|
1564 ;; This is confusing.
|
|
1565 ;;
|
|
1566 ;; mark => read, tick, draft, reply etc
|
|
1567 ;; flag => "\\Seen", "\\Flagged", "\\Draft", "gnus-expire" etc
|
|
1568 ;; predicate => "SEEN", "FLAGGED", "DRAFT", "KEYWORD gnus-expire" etc
|
|
1569 ;;
|
|
1570 ;; Mark should not really contain 'read since it's not a "mark" in the Gnus
|
|
1571 ;; world, but we cheat. Mark == gnus-article-mark-lists + '(read . read).
|
|
1572 ;;
|
|
1573
|
|
1574 (defconst nnimap-mark-to-predicate-alist
|
|
1575 (mapcar
|
|
1576 (lambda (pair) ; cdr is the mark
|
|
1577 (or (assoc (cdr pair)
|
56927
|
1578 '((read . "SEEN")
|
|
1579 (tick . "FLAGGED")
|
|
1580 (draft . "DRAFT")
|
|
1581 (recent . "RECENT")
|
|
1582 (reply . "ANSWERED")))
|
|
1583 (cons (cdr pair)
|
|
1584 (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
|
31717
|
1585 (cons '(read . read) gnus-article-mark-lists)))
|
|
1586
|
|
1587 (defun nnimap-mark-to-predicate (pred)
|
|
1588 "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP predicate.
|
|
1589 This is a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD gnus-expire\",
|
|
1590 to be used within a IMAP SEARCH query."
|
|
1591 (cdr (assq pred nnimap-mark-to-predicate-alist)))
|
|
1592
|
|
1593 (defconst nnimap-mark-to-flag-alist
|
|
1594 (mapcar
|
|
1595 (lambda (pair)
|
|
1596 (or (assoc (cdr pair)
|
56927
|
1597 '((read . "\\Seen")
|
|
1598 (tick . "\\Flagged")
|
|
1599 (draft . "\\Draft")
|
|
1600 (recent . "\\Recent")
|
|
1601 (reply . "\\Answered")))
|
|
1602 (cons (cdr pair)
|
|
1603 (format "gnus-%s" (symbol-name (cdr pair))))))
|
31717
|
1604 (cons '(read . read) gnus-article-mark-lists)))
|
|
1605
|
|
1606 (defun nnimap-mark-to-flag-1 (preds)
|
|
1607 (if (and (not (null preds)) (listp preds))
|
|
1608 (cons (nnimap-mark-to-flag (car preds))
|
|
1609 (nnimap-mark-to-flag (cdr preds)))
|
|
1610 (cdr (assoc preds nnimap-mark-to-flag-alist))))
|
|
1611
|
|
1612 (defun nnimap-mark-to-flag (preds &optional always-list make-string)
|
|
1613 "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP flag.
|
|
1614 This is a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\", to
|
|
1615 be used in a STORE FLAGS command."
|
|
1616 (let ((result (nnimap-mark-to-flag-1 preds)))
|
|
1617 (setq result (if (and (or make-string always-list)
|
|
1618 (not (listp result)))
|
|
1619 (list result)
|
|
1620 result))
|
|
1621 (if make-string
|
|
1622 (mapconcat (lambda (flag)
|
|
1623 (if (listp flag)
|
|
1624 (mapconcat 'identity flag " ")
|
|
1625 flag))
|
|
1626 result " ")
|
|
1627 result)))
|
|
1628
|
|
1629 (defun nnimap-mark-permanent-p (mark &optional group)
|
|
1630 "Return t iff MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
|
|
1631 (imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
|
|
1632
|
|
1633 (when nnimap-debug
|
|
1634 (require 'trace)
|
56927
|
1635 (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
|
|
1636 (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
|
|
1637 '(
|
|
1638 nnimap-possibly-change-server
|
|
1639 nnimap-verify-uidvalidity
|
|
1640 nnimap-find-minmax-uid
|
|
1641 nnimap-before-find-minmax-bugworkaround
|
|
1642 nnimap-possibly-change-group
|
|
1643 ;;nnimap-replace-whitespace
|
|
1644 nnimap-retrieve-headers-progress
|
|
1645 nnimap-retrieve-which-headers
|
|
1646 nnimap-group-overview-filename
|
|
1647 nnimap-retrieve-headers-from-file
|
|
1648 nnimap-retrieve-headers-from-server
|
|
1649 nnimap-retrieve-headers
|
|
1650 nnimap-open-connection
|
|
1651 nnimap-open-server
|
|
1652 nnimap-server-opened
|
|
1653 nnimap-close-server
|
|
1654 nnimap-request-close
|
|
1655 nnimap-status-message
|
|
1656 ;;nnimap-demule
|
|
1657 nnimap-request-article-part
|
|
1658 nnimap-request-article
|
|
1659 nnimap-request-head
|
|
1660 nnimap-request-body
|
|
1661 nnimap-request-group
|
|
1662 nnimap-close-group
|
|
1663 nnimap-pattern-to-list-arguments
|
|
1664 nnimap-request-list
|
|
1665 nnimap-request-post
|
|
1666 nnimap-retrieve-groups
|
|
1667 nnimap-request-update-info-internal
|
|
1668 nnimap-request-type
|
|
1669 nnimap-request-set-mark
|
|
1670 nnimap-split-to-groups
|
|
1671 nnimap-split-find-rule
|
|
1672 nnimap-split-find-inbox
|
|
1673 nnimap-split-articles
|
|
1674 nnimap-request-scan
|
|
1675 nnimap-request-newgroups
|
|
1676 nnimap-request-create-group
|
|
1677 nnimap-time-substract
|
|
1678 nnimap-date-days-ago
|
|
1679 nnimap-request-expire-articles-progress
|
|
1680 nnimap-request-expire-articles
|
|
1681 nnimap-request-move-article
|
|
1682 nnimap-request-accept-article
|
|
1683 nnimap-request-delete-group
|
|
1684 nnimap-request-rename-group
|
|
1685 gnus-group-nnimap-expunge
|
|
1686 gnus-group-nnimap-edit-acl
|
|
1687 gnus-group-nnimap-edit-acl-done
|
|
1688 nnimap-group-mode-hook
|
|
1689 nnimap-mark-to-predicate
|
|
1690 nnimap-mark-to-flag-1
|
|
1691 nnimap-mark-to-flag
|
|
1692 nnimap-mark-permanent-p
|
|
1693 )))
|
31717
|
1694
|
|
1695 (provide 'nnimap)
|
|
1696
|
55398
|
1697 ;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b
|
31717
|
1698 ;;; nnimap.el ends here
|