|
0
|
1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
|
|
98
|
2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
|
|
0
|
3
|
|
|
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
|
|
5 ;; Keywords: news, mail
|
|
|
6
|
|
|
7 ;; This file is part of GNU Emacs.
|
|
|
8
|
|
|
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
10 ;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
22 ;; Boston, MA 02111-1307, USA.
|
|
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Code:
|
|
|
27
|
|
|
28 (require 'nnheader)
|
|
|
29 (require 'timezone)
|
|
|
30 (require 'message)
|
|
108
|
31 (require 'cl)
|
|
98
|
32 (require 'custom)
|
|
24
|
33
|
|
108
|
34 (eval-and-compile
|
|
|
35 (autoload 'gnus-error "gnus-util"))
|
|
|
36
|
|
100
|
37 (defgroup nnmail nil
|
|
|
38 "Reading mail with Gnus."
|
|
98
|
39 :group 'gnus)
|
|
|
40
|
|
100
|
41 (defgroup nnmail-retrieve nil
|
|
|
42 "Retrieving new mail."
|
|
|
43 :group 'nnmail)
|
|
|
44
|
|
|
45 (defgroup nnmail-prepare nil
|
|
|
46 "Preparing (or mangling) new mail after retrival."
|
|
|
47 :group 'nnmail)
|
|
|
48
|
|
|
49 (defgroup nnmail-duplicate nil
|
|
|
50 "Handling of duplicate mail messages."
|
|
|
51 :group 'nnmail)
|
|
|
52
|
|
|
53 (defgroup nnmail-split nil
|
|
|
54 "Organizing the incomming mail in folders."
|
|
|
55 :group 'nnmail)
|
|
|
56
|
|
|
57 (defgroup nnmail-files nil
|
|
|
58 "Mail files."
|
|
|
59 :group 'gnus-files
|
|
|
60 :group 'nnmail)
|
|
|
61
|
|
|
62 (defgroup nnmail-expire nil
|
|
|
63 "Expiring old mail."
|
|
|
64 :group 'nnmail)
|
|
|
65
|
|
|
66 (defgroup nnmail-procmail nil
|
|
|
67 "Interfacing with procmail and other mail agents."
|
|
|
68 :group 'nnmail)
|
|
|
69
|
|
|
70 (defgroup nnmail-various nil
|
|
|
71 "Various mail options."
|
|
|
72 :group 'nnmail)
|
|
|
73
|
|
98
|
74 (defcustom nnmail-split-methods
|
|
0
|
75 '(("mail.misc" ""))
|
|
98
|
76 "Incoming mail will be split according to this variable.
|
|
0
|
77
|
|
|
78 If you'd like, for instance, one mail group for mail from the
|
|
|
79 \"4ad-l\" mailing list, one group for junk mail and one for everything
|
|
|
80 else, you could do something like this:
|
|
|
81
|
|
|
82 (setq nnmail-split-methods
|
|
|
83 '((\"mail.4ad\" \"From:.*4ad\")
|
|
|
84 (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
|
|
|
85 (\"mail.misc\" \"\")))
|
|
|
86
|
|
|
87 As you can see, this variable is a list of lists, where the first
|
|
|
88 element in each \"rule\" is the name of the group (which, by the way,
|
|
|
89 does not have to be called anything beginning with \"mail\",
|
|
|
90 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
|
|
|
91 nnmail will try to match on the header to find a fit.
|
|
|
92
|
|
|
93 The second element can also be a function. In that case, it will be
|
|
|
94 called narrowed to the headers with the first element of the rule as
|
|
|
95 the argument. It should return a non-nil value if it thinks that the
|
|
|
96 mail belongs in that group.
|
|
|
97
|
|
|
98 The last element should always have \"\" as the regexp.
|
|
|
99
|
|
98
|
100 This variable can also have a function as its value."
|
|
100
|
101 :group 'nnmail-split
|
|
98
|
102 :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
|
|
|
103 (function-item nnmail-split-fancy)
|
|
|
104 (function :tag "Other")))
|
|
0
|
105
|
|
|
106 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
98
|
107 (defcustom nnmail-crosspost t
|
|
|
108 "If non-nil, do crossposting if several split methods match the mail.
|
|
|
109 If nil, the first match found will be used."
|
|
100
|
110 :group 'nnmail-split
|
|
98
|
111 :type 'boolean)
|
|
0
|
112
|
|
|
113 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
|
|
98
|
114 (defcustom nnmail-keep-last-article nil
|
|
155
|
115 "If non-nil, nnmail will never delete/move a group's last article.
|
|
|
116 It can be marked expirable, so it will be deleted when it is no longer last.
|
|
|
117
|
|
0
|
118 You may need to set this variable if other programs are putting
|
|
98
|
119 new mail into folder numbers that Gnus has marked as expired."
|
|
100
|
120 :group 'nnmail-procmail
|
|
|
121 :group 'nnmail-various
|
|
98
|
122 :type 'boolean)
|
|
0
|
123
|
|
98
|
124 (defcustom nnmail-use-long-file-names nil
|
|
|
125 "If non-nil the mail backends will use long file and directory names.
|
|
0
|
126 If nil, groups like \"mail.misc\" will end up in directories like
|
|
98
|
127 \"mail/misc/\"."
|
|
100
|
128 :group 'nnmail-files
|
|
98
|
129 :type 'boolean)
|
|
0
|
130
|
|
98
|
131 (defcustom nnmail-default-file-modes 384
|
|
|
132 "Set the mode bits of all new mail files to this integer."
|
|
100
|
133 :group 'nnmail-files
|
|
98
|
134 :type 'integer)
|
|
|
135
|
|
|
136 (defcustom nnmail-expiry-wait 7
|
|
0
|
137 "*Expirable articles that are older than this will be expired.
|
|
|
138 This variable can either be a number (which will be interpreted as a
|
|
|
139 number of days) -- this doesn't have to be an integer. This variable
|
|
98
|
140 can also be `immediate' and `never'."
|
|
100
|
141 :group 'nnmail-expire
|
|
98
|
142 :type '(choice (const immediate)
|
|
|
143 (integer :tag "days")
|
|
|
144 (const never)))
|
|
0
|
145
|
|
98
|
146 (defcustom nnmail-expiry-wait-function nil
|
|
|
147 "Variable that holds function to specify how old articles should be before they are expired.
|
|
0
|
148 The function will be called with the name of the group that the
|
|
|
149 expiry is to be performed in, and it should return an integer that
|
|
|
150 says how many days an article can be stored before it is considered
|
|
|
151 \"old\". It can also return the values `never' and `immediate'.
|
|
|
152
|
|
|
153 Eg.:
|
|
|
154
|
|
98
|
155 \(setq nnmail-expiry-wait-function
|
|
0
|
156 (lambda (newsgroup)
|
|
|
157 (cond ((string-match \"private\" newsgroup) 31)
|
|
|
158 ((string-match \"junk\" newsgroup) 1)
|
|
|
159 ((string-match \"important\" newsgroup) 'never)
|
|
98
|
160 (t 7))))"
|
|
100
|
161 :group 'nnmail-expire
|
|
98
|
162 :type '(choice (const :tag "nnmail-expiry-wait" nil)
|
|
|
163 (function :format "%v" nnmail-)))
|
|
0
|
164
|
|
114
|
165 (defcustom nnmail-cache-accepted-message-ids nil
|
|
|
166 "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache."
|
|
|
167 :group 'nnmail
|
|
|
168 :type 'boolean)
|
|
|
169
|
|
108
|
170 (defcustom nnmail-spool-file
|
|
0
|
171 (or (getenv "MAIL")
|
|
|
172 (concat "/usr/spool/mail/" (user-login-name)))
|
|
|
173 "Where the mail backends will look for incoming mail.
|
|
|
174 This variable is \"/usr/spool/mail/$user\" by default.
|
|
|
175 If this variable is nil, no mail backends will read incoming mail.
|
|
|
176 If this variable is a list, all files mentioned in this list will be
|
|
98
|
177 used as incoming mailboxes.
|
|
|
178 If this variable is a directory (i. e., it's name ends with a \"/\"),
|
|
|
179 treat all files in that directory as incoming spool files."
|
|
100
|
180 :group 'nnmail-files
|
|
98
|
181 :type 'file)
|
|
0
|
182
|
|
98
|
183 (defcustom nnmail-crash-box "~/.gnus-crash-box"
|
|
|
184 "File where Gnus will store mail while processing it."
|
|
100
|
185 :group 'nnmail-files
|
|
98
|
186 :type 'file)
|
|
0
|
187
|
|
98
|
188 (defcustom nnmail-use-procmail nil
|
|
0
|
189 "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
|
|
98
|
190 The file(s) in `nnmail-spool-file' will also be read."
|
|
100
|
191 :group 'nnmail-procmail
|
|
98
|
192 :type 'boolean)
|
|
0
|
193
|
|
98
|
194 (defcustom nnmail-procmail-directory "~/incoming/"
|
|
0
|
195 "*When using procmail (and the like), incoming mail is put in this directory.
|
|
98
|
196 The Gnus mail backends will read the mail from this directory."
|
|
100
|
197 :group 'nnmail-procmail
|
|
98
|
198 :type 'directory)
|
|
0
|
199
|
|
98
|
200 (defcustom nnmail-procmail-suffix "\\.spool"
|
|
0
|
201 "*Suffix of files created by procmail (and the like).
|
|
|
202 This variable might be a suffix-regexp to match the suffixes of
|
|
98
|
203 several files - eg. \".spool[0-9]*\"."
|
|
100
|
204 :group 'nnmail-procmail
|
|
98
|
205 :type 'regexp)
|
|
0
|
206
|
|
98
|
207 (defcustom nnmail-resplit-incoming nil
|
|
|
208 "*If non-nil, re-split incoming procmail sorted mail."
|
|
100
|
209 :group 'nnmail-procmail
|
|
98
|
210 :type 'boolean)
|
|
16
|
211
|
|
98
|
212 (defcustom nnmail-delete-file-function 'delete-file
|
|
|
213 "Function called to delete files in some mail backends."
|
|
100
|
214 :group 'nnmail-files
|
|
98
|
215 :type 'function)
|
|
|
216
|
|
112
|
217 (defcustom nnmail-crosspost-link-function
|
|
|
218 (if (string-match "windows-nt\\|emx" (format "%s" system-type))
|
|
|
219 'copy-file
|
|
|
220 'add-name-to-file)
|
|
0
|
221 "Function called to create a copy of a file.
|
|
|
222 This is `add-name-to-file' by default, which means that crossposts
|
|
|
223 will use hard links. If your file system doesn't allow hard
|
|
98
|
224 links, you could set this variable to `copy-file' instead."
|
|
100
|
225 :group 'nnmail-files
|
|
98
|
226 :type '(radio (function-item add-name-to-file)
|
|
|
227 (function-item copy-file)
|
|
|
228 (function :tag "Other")))
|
|
0
|
229
|
|
98
|
230 (defcustom nnmail-movemail-program "movemail"
|
|
0
|
231 "*A command to be executed to move mail from the inbox.
|
|
98
|
232 The default is \"movemail\".
|
|
0
|
233
|
|
98
|
234 This can also be a function. In that case, the function will be
|
|
|
235 called with two parameters -- the name of the INBOX file, and the file
|
|
|
236 to be moved to."
|
|
100
|
237 :group 'nnmail-files
|
|
|
238 :group 'nnmail-retrieve
|
|
98
|
239 :type 'string)
|
|
0
|
240
|
|
98
|
241 (defcustom nnmail-pop-password-required nil
|
|
|
242 "*Non-nil if a password is required when reading mail using POP."
|
|
100
|
243 :group 'nnmail-retrieve
|
|
98
|
244 :type 'boolean)
|
|
|
245
|
|
108
|
246 (defcustom nnmail-read-incoming-hook
|
|
98
|
247 (if (eq system-type 'windows-nt)
|
|
|
248 '(nnheader-ms-strip-cr)
|
|
|
249 nil)
|
|
|
250 "Hook that will be run after the incoming mail has been transferred.
|
|
0
|
251 The incoming mail is moved from `nnmail-spool-file' (which normally is
|
|
|
252 something like \"/usr/spool/mail/$user\") to the user's home
|
|
98
|
253 directory. This hook is called after the incoming mail box has been
|
|
0
|
254 emptied, and can be used to call any mail box programs you have
|
|
|
255 running (\"xwatch\", etc.)
|
|
|
256
|
|
|
257 Eg.
|
|
|
258
|
|
108
|
259 \(add-hook 'nnmail-read-incoming-hook
|
|
98
|
260 (lambda ()
|
|
108
|
261 (start-process \"mailsend\" nil
|
|
0
|
262 \"/local/bin/mailsend\" \"read\" \"mbox\")))
|
|
|
263
|
|
|
264 If you have xwatch running, this will alert it that mail has been
|
|
108
|
265 read.
|
|
0
|
266
|
|
|
267 If you use `display-time', you could use something like this:
|
|
|
268
|
|
|
269 \(add-hook 'nnmail-read-incoming-hook
|
|
|
270 (lambda ()
|
|
|
271 ;; Update the displayed time, since that will clear out
|
|
|
272 ;; the flag that says you have mail.
|
|
98
|
273 (when (eq (process-status \"display-time\") 'run)
|
|
|
274 (display-time-filter display-time-process \"\"))))"
|
|
100
|
275 :group 'nnmail-prepare
|
|
98
|
276 :type 'hook)
|
|
0
|
277
|
|
|
278 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
98
|
279 (defcustom nnmail-prepare-incoming-hook nil
|
|
|
280 "Hook called before treating incoming mail.
|
|
|
281 The hook is run in a buffer with all the new, incoming mail."
|
|
100
|
282 :group 'nnmail-prepare
|
|
98
|
283 :type 'hook)
|
|
|
284
|
|
|
285 (defcustom nnmail-prepare-incoming-header-hook nil
|
|
|
286 "Hook called narrowed to the headers of each message.
|
|
|
287 This can be used to remove excessive spaces (and stuff like
|
|
|
288 that) from the headers before splitting and saving the messages."
|
|
100
|
289 :group 'nnmail-prepare
|
|
98
|
290 :type 'hook)
|
|
|
291
|
|
|
292 (defcustom nnmail-prepare-incoming-message-hook nil
|
|
|
293 "Hook called narrowed to each message."
|
|
100
|
294 :group 'nnmail-prepare
|
|
98
|
295 :type 'hook)
|
|
0
|
296
|
|
98
|
297 (defcustom nnmail-list-identifiers nil
|
|
|
298 "Regexp that matches list identifiers to be removed.
|
|
|
299 This can also be a list of regexps."
|
|
100
|
300 :group 'nnmail-prepare
|
|
|
301 :type '(choice (const :tag "none" nil)
|
|
|
302 regexp
|
|
98
|
303 (repeat regexp)))
|
|
|
304
|
|
|
305 (defcustom nnmail-pre-get-new-mail-hook nil
|
|
|
306 "Hook called just before starting to handle new incoming mail."
|
|
100
|
307 :group 'nnmail-retrieve
|
|
98
|
308 :type 'hook)
|
|
0
|
309
|
|
98
|
310 (defcustom nnmail-post-get-new-mail-hook nil
|
|
|
311 "Hook called just after finishing handling new incoming mail."
|
|
100
|
312 :group 'nnmail-retrieve
|
|
98
|
313 :type 'hook)
|
|
|
314
|
|
|
315 (defcustom nnmail-split-hook nil
|
|
|
316 "Hook called before deciding where to split an article.
|
|
|
317 The functions in this hook are free to modify the buffer
|
|
|
318 contents in any way they choose -- the buffer contents are
|
|
|
319 discarded after running the split process."
|
|
100
|
320 :group 'nnmail-split
|
|
98
|
321 :type 'hook)
|
|
0
|
322
|
|
|
323 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
|
|
98
|
324 (defcustom nnmail-tmp-directory nil
|
|
100
|
325 "*If non-nil, use this directory for temporary storage.
|
|
|
326 Used when reading incoming mail."
|
|
|
327 :group 'nnmail-files
|
|
|
328 :group 'nnmail-retrieve
|
|
98
|
329 :type '(choice (const :tag "default" nil)
|
|
|
330 (directory :format "%v")))
|
|
0
|
331
|
|
98
|
332 (defcustom nnmail-large-newsgroup 50
|
|
0
|
333 "*The number of the articles which indicates a large newsgroup.
|
|
|
334 If the number of the articles is greater than the value, verbose
|
|
98
|
335 messages will be shown to indicate the current status."
|
|
100
|
336 :group 'nnmail-various
|
|
98
|
337 :type 'integer)
|
|
0
|
338
|
|
98
|
339 (defcustom nnmail-split-fancy "mail.misc"
|
|
|
340 "Incoming mail can be split according to this fancy variable.
|
|
0
|
341 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
|
|
|
342
|
|
|
343 The format is this variable is SPLIT, where SPLIT can be one of
|
|
|
344 the following:
|
|
|
345
|
|
108
|
346 GROUP: Mail will be stored in GROUP (a string).
|
|
0
|
347
|
|
|
348 \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
|
|
|
349 VALUE (a regexp), store the messages as specified by SPLIT.
|
|
|
350
|
|
|
351 \(| SPLIT...): Process each SPLIT expression until one of them matches.
|
|
|
352 A SPLIT expression is said to match if it will cause the mail
|
|
108
|
353 message to be stored in one or more groups.
|
|
0
|
354
|
|
|
355 \(& SPLIT...): Process each SPLIT expression.
|
|
|
356
|
|
98
|
357 \(: FUNCTION optional args): Call FUNCTION with the optional args, in
|
|
|
358 the buffer containing the message headers. The return value FUNCTION
|
|
|
359 should be a split, which is then recursively processed.
|
|
|
360
|
|
0
|
361 FIELD must match a complete field name. VALUE must match a complete
|
|
|
362 word according to the `nnmail-split-fancy-syntax-table' syntax table.
|
|
108
|
363 You can use \".*\" in the regexps to match partial field names or words.
|
|
0
|
364
|
|
|
365 FIELD and VALUE can also be lisp symbols, in that case they are expanded
|
|
|
366 as specified in `nnmail-split-abbrev-alist'.
|
|
|
367
|
|
98
|
368 GROUP can contain \\& and \\N which will substitute from matching
|
|
|
369 \\(\\) patterns in the previous VALUE.
|
|
|
370
|
|
0
|
371 Example:
|
|
|
372
|
|
|
373 \(setq nnmail-split-methods 'nnmail-split-fancy
|
|
|
374 nnmail-split-fancy
|
|
98
|
375 ;; Messages from the mailer daemon are not crossposted to any of
|
|
0
|
376 ;; the ordinary groups. Warnings are put in a separate group
|
|
|
377 ;; from real errors.
|
|
|
378 '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
|
|
|
379 \"mail.misc\"))
|
|
|
380 ;; Non-error messages are crossposted to all relevant
|
|
|
381 ;; groups, but we don't crosspost between the group for the
|
|
|
382 ;; (ding) list and the group for other (ding) related mail.
|
|
|
383 (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
|
|
|
384 (\"subject\" \"ding\" \"ding.misc\"))
|
|
|
385 ;; Other mailing lists...
|
|
|
386 (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
|
|
|
387 (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
|
|
|
388 ;; People...
|
|
|
389 (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
|
|
|
390 ;; Unmatched mail goes to the catch all group.
|
|
98
|
391 \"misc.misc\"))"
|
|
100
|
392 :group 'nnmail-split
|
|
98
|
393 ;; Sigh!
|
|
|
394 :type 'sexp)
|
|
0
|
395
|
|
98
|
396 (defcustom nnmail-split-abbrev-alist
|
|
2
|
397 '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
|
|
116
|
398 (mail . "mailer-daemon\\|postmaster\\|uucp")
|
|
|
399 (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
|
|
136
|
400 (from . "from\\|sender\\|resent-from")
|
|
|
401 (nato . "to\\|cc\\|resent-to\\|resent-cc")
|
|
|
402 (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
|
|
98
|
403 "Alist of abbreviations allowed in `nnmail-split-fancy'."
|
|
100
|
404 :group 'nnmail-split
|
|
98
|
405 :type '(repeat (cons :format "%v" symbol regexp)))
|
|
0
|
406
|
|
98
|
407 (defcustom nnmail-delete-incoming t
|
|
|
408 "*If non-nil, the mail backends will delete incoming files after
|
|
|
409 splitting."
|
|
100
|
410 :group 'nnmail-retrieve
|
|
98
|
411 :type 'boolean)
|
|
0
|
412
|
|
98
|
413 (defcustom nnmail-message-id-cache-length 1000
|
|
0
|
414 "*The approximate number of Message-IDs nnmail will keep in its cache.
|
|
|
415 If this variable is nil, no checking on duplicate messages will be
|
|
98
|
416 performed."
|
|
100
|
417 :group 'nnmail-duplicate
|
|
98
|
418 :type '(choice (const :tag "disable" nil)
|
|
|
419 (integer :format "%v")))
|
|
0
|
420
|
|
98
|
421 (defcustom nnmail-message-id-cache-file "~/.nnmail-cache"
|
|
|
422 "*The file name of the nnmail Message-ID cache."
|
|
100
|
423 :group 'nnmail-duplicate
|
|
|
424 :group 'nnmail-files
|
|
98
|
425 :type 'file)
|
|
0
|
426
|
|
98
|
427 (defcustom nnmail-treat-duplicates 'warn
|
|
0
|
428 "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
|
|
|
429 Three values are legal: nil, which means that nnmail is not to keep a
|
|
|
430 Message-ID cache; `warn', which means that nnmail should insert extra
|
|
|
431 headers to warn the user about the duplication (this is the default);
|
|
|
432 and `delete', which means that nnmail will delete duplicated mails.
|
|
|
433
|
|
|
434 This variable can also be a function. It will be called from a buffer
|
|
|
435 narrowed to the article in question with the Message-ID as a
|
|
98
|
436 parameter. It should return nil, `warn' or `delete'."
|
|
100
|
437 :group 'nnmail-duplicate
|
|
98
|
438 :type '(choice (const :tag "off" nil)
|
|
|
439 (const warn)
|
|
|
440 (const delete)))
|
|
0
|
441
|
|
|
442 ;;; Internal variables.
|
|
|
443
|
|
98
|
444 (defvar nnmail-split-history nil
|
|
|
445 "List of group/article elements that say where the previous split put messages.")
|
|
|
446
|
|
0
|
447 (defvar nnmail-pop-password nil
|
|
|
448 "*Password to use when reading mail from a POP server, if required.")
|
|
|
449
|
|
2
|
450 (defvar nnmail-split-fancy-syntax-table nil
|
|
0
|
451 "Syntax table used by `nnmail-split-fancy'.")
|
|
2
|
452 (unless (syntax-table-p nnmail-split-fancy-syntax-table)
|
|
|
453 (setq nnmail-split-fancy-syntax-table
|
|
|
454 (copy-syntax-table (standard-syntax-table)))
|
|
|
455 ;; support the %-hack
|
|
|
456 (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table))
|
|
|
457
|
|
0
|
458 (defvar nnmail-prepare-save-mail-hook nil
|
|
|
459 "Hook called before saving mail.")
|
|
|
460
|
|
|
461 (defvar nnmail-moved-inboxes nil
|
|
|
462 "List of inboxes that have been moved.")
|
|
|
463
|
|
|
464 (defvar nnmail-internal-password nil)
|
|
|
465
|
|
|
466
|
|
|
467
|
|
|
468 (defconst nnmail-version "nnmail 1.0"
|
|
|
469 "nnmail version.")
|
|
|
470
|
|
|
471
|
|
|
472
|
|
|
473 (defun nnmail-request-post (&optional server)
|
|
|
474 (mail-send-and-exit nil))
|
|
|
475
|
|
|
476 (defun nnmail-find-file (file)
|
|
|
477 "Insert FILE in server buffer safely."
|
|
|
478 (set-buffer nntp-server-buffer)
|
|
|
479 (erase-buffer)
|
|
|
480 (let ((format-alist nil)
|
|
|
481 (after-insert-file-functions nil))
|
|
|
482 (condition-case ()
|
|
|
483 (progn (insert-file-contents file) t)
|
|
|
484 (file-error nil))))
|
|
|
485
|
|
|
486 (defun nnmail-group-pathname (group dir &optional file)
|
|
|
487 "Make pathname for GROUP."
|
|
|
488 (concat
|
|
|
489 (let ((dir (file-name-as-directory (expand-file-name dir))))
|
|
|
490 ;; If this directory exists, we use it directly.
|
|
108
|
491 (if (or nnmail-use-long-file-names
|
|
0
|
492 (file-directory-p (concat dir group)))
|
|
|
493 (concat dir group "/")
|
|
|
494 ;; If not, we translate dots into slashes.
|
|
|
495 (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/")))
|
|
|
496 (or file "")))
|
|
98
|
497
|
|
0
|
498 (defun nnmail-date-to-time (date)
|
|
|
499 "Convert DATE into time."
|
|
98
|
500 (condition-case ()
|
|
|
501 (let* ((d1 (timezone-parse-date date))
|
|
|
502 (t1 (timezone-parse-time (aref d1 3))))
|
|
|
503 (apply 'encode-time
|
|
|
504 (mapcar (lambda (el)
|
|
|
505 (and el (string-to-number el)))
|
|
|
506 (list
|
|
|
507 (aref t1 2) (aref t1 1) (aref t1 0)
|
|
|
508 (aref d1 2) (aref d1 1) (aref d1 0)
|
|
|
509 (number-to-string
|
|
|
510 (* 60 (timezone-zone-to-minute (aref d1 4))))))))
|
|
|
511 ;; If we get an error, then we just return a 0 time.
|
|
|
512 (error (list 0 0))))
|
|
0
|
513
|
|
|
514 (defun nnmail-time-less (t1 t2)
|
|
|
515 "Say whether time T1 is less than time T2."
|
|
|
516 (or (< (car t1) (car t2))
|
|
|
517 (and (= (car t1) (car t2))
|
|
|
518 (< (nth 1 t1) (nth 1 t2)))))
|
|
|
519
|
|
|
520 (defun nnmail-days-to-time (days)
|
|
|
521 "Convert DAYS into time."
|
|
|
522 (let* ((seconds (* 1.0 days 60 60 24))
|
|
|
523 (rest (expt 2 16))
|
|
98
|
524 (ms (condition-case nil (round (/ seconds rest))
|
|
0
|
525 (range-error (expt 2 16)))))
|
|
|
526 (list ms (condition-case nil (round (- seconds (* ms rest)))
|
|
|
527 (range-error (expt 2 16))))))
|
|
|
528
|
|
|
529 (defun nnmail-time-since (time)
|
|
|
530 "Return the time since TIME, which is either an internal time or a date."
|
|
|
531 (when (stringp time)
|
|
|
532 ;; Convert date strings to internal time.
|
|
|
533 (setq time (nnmail-date-to-time time)))
|
|
|
534 (let* ((current (current-time))
|
|
98
|
535 (rest (when (< (nth 1 current) (nth 1 time))
|
|
|
536 (expt 2 16))))
|
|
0
|
537 (list (- (+ (car current) (if rest -1 0)) (car time))
|
|
|
538 (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
|
|
|
539
|
|
|
540 ;; Function rewritten from rmail.el.
|
|
|
541 (defun nnmail-move-inbox (inbox)
|
|
|
542 "Move INBOX to `nnmail-crash-box'."
|
|
98
|
543 (if (not (file-writable-p nnmail-crash-box))
|
|
169
|
544 (gnus-error 1 "Can't write to crash box %s. Not moving mail"
|
|
98
|
545 nnmail-crash-box)
|
|
|
546 ;; If the crash box exists and is empty, we delete it.
|
|
|
547 (when (and (file-exists-p nnmail-crash-box)
|
|
|
548 (zerop (nnheader-file-size (file-truename nnmail-crash-box))))
|
|
|
549 (delete-file nnmail-crash-box))
|
|
140
|
550 (let ((tofile (file-truename (expand-file-name nnmail-crash-box)))
|
|
|
551 (popmail (string-match "^po:" inbox))
|
|
|
552 movemail errors result)
|
|
|
553 (unless popmail
|
|
|
554 (setq inbox (file-truename (expand-file-name inbox)))
|
|
98
|
555 (setq movemail t)
|
|
|
556 ;; On some systems, /usr/spool/mail/foo is a directory
|
|
|
557 ;; and the actual inbox is /usr/spool/mail/foo/foo.
|
|
|
558 (when (file-directory-p inbox)
|
|
|
559 (setq inbox (expand-file-name (user-login-name) inbox))))
|
|
|
560 (if (member inbox nnmail-moved-inboxes)
|
|
|
561 ;; We don't try to move an already moved inbox.
|
|
|
562 nil
|
|
|
563 (if popmail
|
|
|
564 (progn
|
|
|
565 (when (and nnmail-pop-password
|
|
|
566 (not nnmail-internal-password))
|
|
|
567 (setq nnmail-internal-password nnmail-pop-password))
|
|
|
568 (when (and nnmail-pop-password-required
|
|
|
569 (not nnmail-internal-password))
|
|
|
570 (setq nnmail-internal-password
|
|
|
571 (nnmail-read-passwd
|
|
|
572 (format "Password for %s: "
|
|
|
573 (substring inbox (+ popmail 3))))))
|
|
155
|
574 (message "Getting mail from the post office..."))
|
|
98
|
575 (when (or (and (file-exists-p tofile)
|
|
|
576 (/= 0 (nnheader-file-size tofile)))
|
|
|
577 (and (file-exists-p inbox)
|
|
|
578 (/= 0 (nnheader-file-size inbox))))
|
|
|
579 (message "Getting mail from %s..." inbox)))
|
|
|
580 ;; Set TOFILE if have not already done so, and
|
|
|
581 ;; rename or copy the file INBOX to TOFILE if and as appropriate.
|
|
108
|
582 (cond
|
|
98
|
583 ((file-exists-p tofile)
|
|
|
584 ;; The crash box exists already.
|
|
|
585 t)
|
|
|
586 ((and (not popmail)
|
|
|
587 (not (file-exists-p inbox)))
|
|
|
588 ;; There is no inbox.
|
|
|
589 (setq tofile nil))
|
|
|
590 (t
|
|
|
591 ;; If getting from mail spool directory, use movemail to move
|
|
|
592 ;; rather than just renaming, so as to interlock with the
|
|
|
593 ;; mailer.
|
|
|
594 (unwind-protect
|
|
|
595 (save-excursion
|
|
|
596 (setq errors (generate-new-buffer " *nnmail loss*"))
|
|
|
597 (buffer-disable-undo errors)
|
|
|
598 (let ((default-directory "/"))
|
|
|
599 (if (nnheader-functionp nnmail-movemail-program)
|
|
108
|
600 (condition-case err
|
|
|
601 (progn
|
|
|
602 (funcall nnmail-movemail-program inbox tofile)
|
|
|
603 (setq result 0))
|
|
|
604 (error
|
|
|
605 (save-excursion
|
|
|
606 (set-buffer errors)
|
|
|
607 (insert (prin1-to-string err))
|
|
|
608 (setq result 255))))
|
|
104
|
609 (setq result
|
|
108
|
610 (apply
|
|
104
|
611 'call-process
|
|
|
612 (append
|
|
|
613 (list
|
|
108
|
614 (expand-file-name
|
|
104
|
615 nnmail-movemail-program exec-directory)
|
|
|
616 nil errors nil inbox tofile)
|
|
|
617 (when nnmail-internal-password
|
|
|
618 (list nnmail-internal-password)))))))
|
|
|
619 (if (and (not (buffer-modified-p errors))
|
|
|
620 (zerop result))
|
|
98
|
621 ;; No output => movemail won
|
|
|
622 (progn
|
|
|
623 (unless popmail
|
|
|
624 (when (file-exists-p tofile)
|
|
|
625 (set-file-modes tofile nnmail-default-file-modes)))
|
|
|
626 (push inbox nnmail-moved-inboxes))
|
|
|
627 (set-buffer errors)
|
|
|
628 ;; There may be a warning about older revisions. We
|
|
|
629 ;; ignore those.
|
|
|
630 (goto-char (point-min))
|
|
|
631 (if (search-forward "older revision" nil t)
|
|
|
632 (progn
|
|
|
633 (unless popmail
|
|
|
634 (when (file-exists-p tofile)
|
|
|
635 (set-file-modes tofile nnmail-default-file-modes)))
|
|
|
636 (push inbox nnmail-moved-inboxes))
|
|
|
637 ;; Probably a real error.
|
|
|
638 (subst-char-in-region (point-min) (point-max) ?\n ?\ )
|
|
|
639 (goto-char (point-max))
|
|
|
640 (skip-chars-backward " \t")
|
|
|
641 (delete-region (point) (point-max))
|
|
|
642 (goto-char (point-min))
|
|
|
643 (when (looking-at "movemail: ")
|
|
|
644 (delete-region (point-min) (match-end 0)))
|
|
|
645 (unless (yes-or-no-p
|
|
104
|
646 (format "movemail: %s (%d return). Continue? "
|
|
|
647 (buffer-string) result))
|
|
98
|
648 (error "%s" (buffer-string)))
|
|
|
649 (setq tofile nil)))))))
|
|
|
650 (message "Getting mail from %s...done" inbox)
|
|
|
651 (and errors
|
|
|
652 (buffer-name errors)
|
|
|
653 (kill-buffer errors))
|
|
|
654 tofile))))
|
|
0
|
655
|
|
|
656 (defun nnmail-get-active ()
|
|
|
657 "Returns an assoc of group names and active ranges.
|
|
|
658 nn*-request-list should have been called before calling this function."
|
|
|
659 (let (group-assoc)
|
|
|
660 ;; Go through all groups from the active list.
|
|
|
661 (save-excursion
|
|
|
662 (set-buffer nntp-server-buffer)
|
|
|
663 (goto-char (point-min))
|
|
108
|
664 (while (re-search-forward
|
|
0
|
665 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
|
|
|
666 ;; We create an alist with `(GROUP (LOW . HIGH))' elements.
|
|
|
667 (push (list (match-string 1)
|
|
|
668 (cons (string-to-int (match-string 3))
|
|
|
669 (string-to-int (match-string 2))))
|
|
|
670 group-assoc)))
|
|
|
671 group-assoc))
|
|
|
672
|
|
|
673 (defun nnmail-save-active (group-assoc file-name)
|
|
|
674 "Save GROUP-ASSOC in ACTIVE-FILE."
|
|
|
675 (when file-name
|
|
98
|
676 (nnheader-temp-write file-name
|
|
|
677 (nnmail-generate-active group-assoc))))
|
|
|
678
|
|
|
679 (defun nnmail-generate-active (alist)
|
|
|
680 "Generate an active file from group-alist ALIST."
|
|
|
681 (erase-buffer)
|
|
|
682 (let (group)
|
|
|
683 (while (setq group (pop alist))
|
|
|
684 (insert (format "%s %d %d y\n" (car group) (cdadr group)
|
|
|
685 (caadr group))))))
|
|
0
|
686
|
|
|
687 (defun nnmail-get-split-group (file group)
|
|
98
|
688 "Find out whether this FILE is to be split into GROUP only.
|
|
|
689 If GROUP is non-nil and we are using procmail, return the group name
|
|
|
690 only when the file is the correct procmail file. When GROUP is nil,
|
|
|
691 return nil if FILE is a spool file or the procmail group for which it
|
|
|
692 is a spool. If not using procmail, return GROUP."
|
|
0
|
693 (if (or (eq nnmail-spool-file 'procmail)
|
|
|
694 nnmail-use-procmail)
|
|
98
|
695 (if (string-match (concat "^" (expand-file-name
|
|
|
696 (file-name-as-directory
|
|
|
697 nnmail-procmail-directory))
|
|
|
698 "\\([^/]*\\)" nnmail-procmail-suffix "$")
|
|
|
699 (expand-file-name file))
|
|
|
700 (let ((procmail-group (substring (expand-file-name file)
|
|
|
701 (match-beginning 1)
|
|
|
702 (match-end 1))))
|
|
108
|
703 (if group
|
|
98
|
704 (if (string-equal group procmail-group)
|
|
|
705 group
|
|
|
706 nil)
|
|
|
707 procmail-group))
|
|
|
708 nil)
|
|
0
|
709 group))
|
|
|
710
|
|
98
|
711 (defun nnmail-process-babyl-mail-format (func artnum-func)
|
|
0
|
712 (let ((case-fold-search t)
|
|
|
713 start message-id content-length do-search end)
|
|
98
|
714 (goto-char (point-min))
|
|
0
|
715 (while (not (eobp))
|
|
|
716 (re-search-forward
|
|
|
717 " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
|
|
|
718 (goto-char (match-end 0))
|
|
|
719 (delete-region (match-beginning 0) (match-end 0))
|
|
98
|
720 (narrow-to-region
|
|
|
721 (setq start (point))
|
|
|
722 (progn
|
|
|
723 ;; Skip all the headers in case there are more "From "s...
|
|
|
724 (or (search-forward "\n\n" nil t)
|
|
|
725 (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
|
|
|
726 (search-forward " "))
|
|
|
727 (point)))
|
|
|
728 ;; Unquote the ">From " line, if any.
|
|
|
729 (goto-char (point-min))
|
|
|
730 (when (looking-at ">From ")
|
|
|
731 (replace-match "X-From-Line: ") )
|
|
|
732 (run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
|
733 (goto-char (point-max))
|
|
0
|
734 ;; Find the Message-ID header.
|
|
|
735 (save-excursion
|
|
104
|
736 (if (re-search-backward
|
|
|
737 "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
|
|
0
|
738 (setq message-id (buffer-substring (match-beginning 1)
|
|
|
739 (match-end 1)))
|
|
|
740 ;; There is no Message-ID here, so we create one.
|
|
|
741 (save-excursion
|
|
104
|
742 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
0
|
743 (beginning-of-line)
|
|
|
744 (insert "Original-")))
|
|
|
745 (forward-line -1)
|
|
|
746 (insert "Message-ID: " (setq message-id (nnmail-message-id))
|
|
|
747 "\n")))
|
|
|
748 ;; Look for a Content-Length header.
|
|
|
749 (if (not (save-excursion
|
|
108
|
750 (and (re-search-backward
|
|
0
|
751 "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
|
|
|
752 (setq content-length (string-to-int
|
|
108
|
753 (buffer-substring
|
|
0
|
754 (match-beginning 1)
|
|
|
755 (match-end 1))))
|
|
|
756 ;; We destroy the header, since none of
|
|
|
757 ;; the backends ever use it, and we do not
|
|
|
758 ;; want to confuse other mailers by having
|
|
|
759 ;; a (possibly) faulty header.
|
|
|
760 (progn (insert "X-") t))))
|
|
|
761 (setq do-search t)
|
|
98
|
762 (widen)
|
|
0
|
763 (if (or (= (+ (point) content-length) (point-max))
|
|
|
764 (save-excursion
|
|
|
765 (goto-char (+ (point) content-length))
|
|
|
766 (looking-at " ")))
|
|
|
767 (progn
|
|
|
768 (goto-char (+ (point) content-length))
|
|
|
769 (setq do-search nil))
|
|
|
770 (setq do-search t)))
|
|
98
|
771 (widen)
|
|
0
|
772 ;; Go to the beginning of the next article - or to the end
|
|
108
|
773 ;; of the buffer.
|
|
98
|
774 (when do-search
|
|
|
775 (if (re-search-forward "^ " nil t)
|
|
|
776 (goto-char (match-beginning 0))
|
|
|
777 (goto-char (1- (point-max)))))
|
|
0
|
778 (delete-char 1) ; delete ^_
|
|
|
779 (save-excursion
|
|
|
780 (save-restriction
|
|
|
781 (narrow-to-region start (point))
|
|
|
782 (goto-char (point-min))
|
|
98
|
783 (nnmail-check-duplication message-id func artnum-func)
|
|
0
|
784 (setq end (point-max))))
|
|
|
785 (goto-char end))))
|
|
|
786
|
|
110
|
787 (defsubst nnmail-search-unix-mail-delim ()
|
|
98
|
788 "Put point at the beginning of the next Unix mbox message."
|
|
|
789 ;; Algorithm used to find the the next article in the
|
|
|
790 ;; brain-dead Unix mbox format:
|
|
|
791 ;;
|
|
|
792 ;; 1) Search for "^From ".
|
|
|
793 ;; 2) If we find it, then see whether the previous
|
|
|
794 ;; line is blank and the next line looks like a header.
|
|
|
795 ;; Then it's possible that this is a mail delim, and we use it.
|
|
|
796 (let ((case-fold-search nil)
|
|
0
|
797 found)
|
|
|
798 (while (not found)
|
|
98
|
799 (if (not (re-search-forward "^From " nil t))
|
|
|
800 (setq found 'no)
|
|
|
801 (save-excursion
|
|
|
802 (beginning-of-line)
|
|
|
803 (when (and (or (bobp)
|
|
|
804 (save-excursion
|
|
|
805 (forward-line -1)
|
|
|
806 (= (following-char) ?\n)))
|
|
|
807 (save-excursion
|
|
|
808 (forward-line 1)
|
|
163
|
809 (while (looking-at ">From \\|From ")
|
|
98
|
810 (forward-line 1))
|
|
104
|
811 (looking-at "[^ \n\t:]+[ \n\t]*:")))
|
|
98
|
812 (setq found 'yes)))))
|
|
|
813 (beginning-of-line)
|
|
0
|
814 (eq found 'yes)))
|
|
|
815
|
|
98
|
816 (defun nnmail-search-unix-mail-delim-backward ()
|
|
|
817 "Put point at the beginning of the current Unix mbox message."
|
|
|
818 ;; Algorithm used to find the the next article in the
|
|
|
819 ;; brain-dead Unix mbox format:
|
|
|
820 ;;
|
|
|
821 ;; 1) Search for "^From ".
|
|
|
822 ;; 2) If we find it, then see whether the previous
|
|
|
823 ;; line is blank and the next line looks like a header.
|
|
|
824 ;; Then it's possible that this is a mail delim, and we use it.
|
|
|
825 (let ((case-fold-search nil)
|
|
|
826 found)
|
|
|
827 (while (not found)
|
|
|
828 (if (not (re-search-backward "^From " nil t))
|
|
|
829 (setq found 'no)
|
|
|
830 (save-excursion
|
|
|
831 (beginning-of-line)
|
|
|
832 (when (and (or (bobp)
|
|
|
833 (save-excursion
|
|
|
834 (forward-line -1)
|
|
|
835 (= (following-char) ?\n)))
|
|
|
836 (save-excursion
|
|
|
837 (forward-line 1)
|
|
163
|
838 (while (looking-at ">From \\|From ")
|
|
98
|
839 (forward-line 1))
|
|
104
|
840 (looking-at "[^ \n\t:]+[ \n\t]*:")))
|
|
98
|
841 (setq found 'yes)))))
|
|
|
842 (beginning-of-line)
|
|
|
843 (eq found 'yes)))
|
|
|
844
|
|
|
845 (defun nnmail-process-unix-mail-format (func artnum-func)
|
|
0
|
846 (let ((case-fold-search t)
|
|
|
847 start message-id content-length end skip head-end)
|
|
|
848 (goto-char (point-min))
|
|
98
|
849 (if (not (and (re-search-forward "^From " nil t)
|
|
0
|
850 (goto-char (match-beginning 0))))
|
|
|
851 ;; Possibly wrong format?
|
|
|
852 (error "Error, unknown mail format! (Possibly corrupted.)")
|
|
|
853 ;; Carry on until the bitter end.
|
|
|
854 (while (not (eobp))
|
|
|
855 (setq start (point)
|
|
|
856 end nil)
|
|
|
857 ;; Find the end of the head.
|
|
|
858 (narrow-to-region
|
|
108
|
859 start
|
|
0
|
860 (if (search-forward "\n\n" nil t)
|
|
|
861 (1- (point))
|
|
|
862 ;; This will never happen, but just to be on the safe side --
|
|
|
863 ;; if there is no head-body delimiter, we search a bit manually.
|
|
|
864 (while (and (looking-at "From \\|[^ \t]+:")
|
|
|
865 (not (eobp)))
|
|
114
|
866 (forward-line 1))
|
|
|
867 (point)))
|
|
0
|
868 ;; Find the Message-ID header.
|
|
|
869 (goto-char (point-min))
|
|
104
|
870 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
|
|
0
|
871 (setq message-id (match-string 1))
|
|
|
872 (save-excursion
|
|
104
|
873 (when (re-search-forward "^Message-ID[ \t]*:" nil t)
|
|
0
|
874 (beginning-of-line)
|
|
|
875 (insert "Original-")))
|
|
|
876 ;; There is no Message-ID here, so we create one.
|
|
|
877 (forward-line 1)
|
|
|
878 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
879 ;; Look for a Content-Length header.
|
|
|
880 (goto-char (point-min))
|
|
|
881 (if (not (re-search-forward
|
|
|
882 "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
|
|
|
883 (setq content-length nil)
|
|
|
884 (setq content-length (string-to-int (match-string 1)))
|
|
108
|
885 ;; We destroy the header, since none of the backends ever
|
|
0
|
886 ;; use it, and we do not want to confuse other mailers by
|
|
|
887 ;; having a (possibly) faulty header.
|
|
|
888 (beginning-of-line)
|
|
|
889 (insert "X-"))
|
|
98
|
890 (run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
0
|
891 ;; Find the end of this article.
|
|
|
892 (goto-char (point-max))
|
|
|
893 (widen)
|
|
|
894 (setq head-end (point))
|
|
|
895 ;; We try the Content-Length value. The idea: skip over the header
|
|
|
896 ;; separator, then check what happens content-length bytes into the
|
|
|
897 ;; message body. This should be either the end ot the buffer, the
|
|
|
898 ;; message separator or a blank line followed by the separator.
|
|
|
899 ;; The blank line should probably be deleted. If neither of the
|
|
|
900 ;; three is met, the content-length header is probably invalid.
|
|
|
901 (when content-length
|
|
|
902 (forward-line 1)
|
|
|
903 (setq skip (+ (point) content-length))
|
|
|
904 (goto-char skip)
|
|
|
905 (cond ((or (= skip (point-max))
|
|
|
906 (= (1+ skip) (point-max)))
|
|
|
907 (setq end (point-max)))
|
|
98
|
908 ((looking-at "From ")
|
|
0
|
909 (setq end skip))
|
|
98
|
910 ((looking-at "[ \t]*\n\\(From \\)")
|
|
0
|
911 (setq end (match-beginning 1)))
|
|
|
912 (t (setq end nil))))
|
|
|
913 (if end
|
|
|
914 (goto-char end)
|
|
108
|
915 ;; No Content-Length, so we find the beginning of the next
|
|
0
|
916 ;; article or the end of the buffer.
|
|
|
917 (goto-char head-end)
|
|
|
918 (or (nnmail-search-unix-mail-delim)
|
|
|
919 (goto-char (point-max))))
|
|
|
920 ;; Allow the backend to save the article.
|
|
|
921 (save-excursion
|
|
|
922 (save-restriction
|
|
|
923 (narrow-to-region start (point))
|
|
|
924 (goto-char (point-min))
|
|
98
|
925 (nnmail-check-duplication message-id func artnum-func)
|
|
0
|
926 (setq end (point-max))))
|
|
|
927 (goto-char end)))))
|
|
|
928
|
|
98
|
929 (defun nnmail-process-mmdf-mail-format (func artnum-func)
|
|
0
|
930 (let ((delim "^\^A\^A\^A\^A$")
|
|
|
931 (case-fold-search t)
|
|
|
932 start message-id end)
|
|
|
933 (goto-char (point-min))
|
|
|
934 (if (not (and (re-search-forward delim nil t)
|
|
|
935 (forward-line 1)))
|
|
|
936 ;; Possibly wrong format?
|
|
|
937 (error "Error, unknown mail format! (Possibly corrupted.)")
|
|
|
938 ;; Carry on until the bitter end.
|
|
|
939 (while (not (eobp))
|
|
|
940 (setq start (point))
|
|
|
941 ;; Find the end of the head.
|
|
|
942 (narrow-to-region
|
|
108
|
943 start
|
|
0
|
944 (if (search-forward "\n\n" nil t)
|
|
|
945 (1- (point))
|
|
|
946 ;; This will never happen, but just to be on the safe side --
|
|
|
947 ;; if there is no head-body delimiter, we search a bit manually.
|
|
|
948 (while (and (looking-at "From \\|[^ \t]+:")
|
|
|
949 (not (eobp)))
|
|
114
|
950 (forward-line 1))
|
|
|
951 (point)))
|
|
0
|
952 ;; Find the Message-ID header.
|
|
|
953 (goto-char (point-min))
|
|
104
|
954 (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
|
|
0
|
955 (setq message-id (match-string 1))
|
|
|
956 ;; There is no Message-ID here, so we create one.
|
|
|
957 (save-excursion
|
|
104
|
958 (when (re-search-backward "^Message-ID[ \t]*:" nil t)
|
|
0
|
959 (beginning-of-line)
|
|
|
960 (insert "Original-")))
|
|
|
961 (forward-line 1)
|
|
|
962 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
98
|
963 (run-hooks 'nnmail-prepare-incoming-header-hook)
|
|
0
|
964 ;; Find the end of this article.
|
|
|
965 (goto-char (point-max))
|
|
|
966 (widen)
|
|
|
967 (if (re-search-forward delim nil t)
|
|
|
968 (beginning-of-line)
|
|
|
969 (goto-char (point-max)))
|
|
|
970 ;; Allow the backend to save the article.
|
|
|
971 (save-excursion
|
|
|
972 (save-restriction
|
|
|
973 (narrow-to-region start (point))
|
|
|
974 (goto-char (point-min))
|
|
98
|
975 (nnmail-check-duplication message-id func artnum-func)
|
|
0
|
976 (setq end (point-max))))
|
|
|
977 (goto-char end)
|
|
|
978 (forward-line 2)))))
|
|
|
979
|
|
98
|
980 (defun nnmail-split-incoming (incoming func &optional exit-func
|
|
|
981 group artnum-func)
|
|
0
|
982 "Go through the entire INCOMING file and pick out each individual mail.
|
|
|
983 FUNC will be called with the buffer narrowed to each mail."
|
|
|
984 (let (;; If this is a group-specific split, we bind the split
|
|
|
985 ;; methods to just this group.
|
|
|
986 (nnmail-split-methods (if (and group
|
|
|
987 (or (eq nnmail-spool-file 'procmail)
|
|
|
988 nnmail-use-procmail)
|
|
|
989 (not nnmail-resplit-incoming))
|
|
|
990 (list (list group ""))
|
|
|
991 nnmail-split-methods)))
|
|
|
992 (save-excursion
|
|
|
993 ;; Insert the incoming file.
|
|
|
994 (set-buffer (get-buffer-create " *nnmail incoming*"))
|
|
|
995 (buffer-disable-undo (current-buffer))
|
|
|
996 (erase-buffer)
|
|
98
|
997 (nnheader-insert-file-contents incoming)
|
|
0
|
998 (unless (zerop (buffer-size))
|
|
|
999 (goto-char (point-min))
|
|
|
1000 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
|
|
|
1001 ;; Handle both babyl, MMDF and unix mail formats, since movemail will
|
|
|
1002 ;; use the former when fetching from a mailbox, the latter when
|
|
110
|
1003 ;; fetching from a file.
|
|
0
|
1004 (cond ((or (looking-at "\^L")
|
|
|
1005 (looking-at "BABYL OPTIONS:"))
|
|
98
|
1006 (nnmail-process-babyl-mail-format func artnum-func))
|
|
0
|
1007 ((looking-at "\^A\^A\^A\^A")
|
|
98
|
1008 (nnmail-process-mmdf-mail-format func artnum-func))
|
|
0
|
1009 (t
|
|
98
|
1010 (nnmail-process-unix-mail-format func artnum-func))))
|
|
|
1011 (when exit-func
|
|
|
1012 (funcall exit-func))
|
|
0
|
1013 (kill-buffer (current-buffer)))))
|
|
|
1014
|
|
108
|
1015 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
|
|
0
|
1016 (defun nnmail-article-group (func)
|
|
|
1017 "Look at the headers and return an alist of groups that match.
|
|
|
1018 FUNC will be called with the group name to determine the article number."
|
|
|
1019 (let ((methods nnmail-split-methods)
|
|
|
1020 (obuf (current-buffer))
|
|
|
1021 (beg (point-min))
|
|
|
1022 end group-art method)
|
|
|
1023 (if (and (sequencep methods) (= (length methods) 1))
|
|
|
1024 ;; If there is only just one group to put everything in, we
|
|
|
1025 ;; just return a list with just this one method in.
|
|
|
1026 (setq group-art
|
|
|
1027 (list (cons (caar methods) (funcall func (caar methods)))))
|
|
|
1028 ;; We do actual comparison.
|
|
|
1029 (save-excursion
|
|
|
1030 ;; Find headers.
|
|
|
1031 (goto-char beg)
|
|
|
1032 (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
|
|
|
1033 (set-buffer nntp-server-buffer)
|
|
|
1034 (erase-buffer)
|
|
|
1035 ;; Copy the headers into the work buffer.
|
|
|
1036 (insert-buffer-substring obuf beg end)
|
|
|
1037 ;; Fold continuation lines.
|
|
|
1038 (goto-char (point-min))
|
|
|
1039 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
|
|
|
1040 (replace-match " " t t))
|
|
98
|
1041 ;; Allow washing.
|
|
|
1042 (run-hooks 'nnmail-split-hook)
|
|
0
|
1043 (if (and (symbolp nnmail-split-methods)
|
|
|
1044 (fboundp nnmail-split-methods))
|
|
98
|
1045 (let ((split
|
|
0
|
1046 (condition-case nil
|
|
153
|
1047 ;; `nnmail-split-methods' is a function, so we
|
|
|
1048 ;; just call this function here and use the
|
|
|
1049 ;; result.
|
|
0
|
1050 (or (funcall nnmail-split-methods)
|
|
|
1051 '("bogus"))
|
|
|
1052 (error
|
|
108
|
1053 (message
|
|
0
|
1054 "Error in `nnmail-split-methods'; using `bogus' mail group")
|
|
|
1055 (sit-for 1)
|
|
|
1056 '("bogus")))))
|
|
153
|
1057 ;; The article may be "cross-posted" to `junk'. What
|
|
|
1058 ;; to do? Just remove the `junk' spec. Don't really
|
|
|
1059 ;; see anything else to do...
|
|
|
1060 (let (elem)
|
|
155
|
1061 (while (setq elem (car (memq 'junk split)))
|
|
153
|
1062 (setq split (delq elem split))))
|
|
|
1063 (when split
|
|
98
|
1064 (setq group-art
|
|
|
1065 (mapcar
|
|
|
1066 (lambda (group) (cons group (funcall func group)))
|
|
|
1067 split))))
|
|
0
|
1068 ;; Go through the split methods to find a match.
|
|
|
1069 (while (and methods (or nnmail-crosspost (not group-art)))
|
|
|
1070 (goto-char (point-max))
|
|
|
1071 (setq method (pop methods))
|
|
|
1072 (if (or methods
|
|
|
1073 (not (equal "" (nth 1 method))))
|
|
|
1074 (when (and
|
|
98
|
1075 (ignore-errors
|
|
|
1076 (if (stringp (nth 1 method))
|
|
|
1077 (re-search-backward (cadr method) nil t)
|
|
|
1078 ;; Function to say whether this is a match.
|
|
|
1079 (funcall (nth 1 method) (car method))))
|
|
108
|
1080 ;; Don't enter the article into the same
|
|
0
|
1081 ;; group twice.
|
|
|
1082 (not (assoc (car method) group-art)))
|
|
98
|
1083 (push (cons (car method) (funcall func (car method)))
|
|
0
|
1084 group-art))
|
|
108
|
1085 ;; This is the final group, which is used as a
|
|
0
|
1086 ;; catch-all.
|
|
|
1087 (unless group-art
|
|
108
|
1088 (setq group-art
|
|
98
|
1089 (list (cons (car method)
|
|
0
|
1090 (funcall func (car method)))))))))
|
|
98
|
1091 ;; See whether the split methods returned `junk'.
|
|
|
1092 (if (equal group-art '(junk))
|
|
|
1093 nil
|
|
151
|
1094 ;; The article may be "cross-posted" to `junk'. What
|
|
|
1095 ;; to do? Just remove the `junk' spec. Don't really
|
|
|
1096 ;; see anything else to do...
|
|
153
|
1097 (let (elem)
|
|
155
|
1098 (while (setq elem (car (memq 'junk group-art)))
|
|
153
|
1099 (setq group-art (delq elem group-art)))
|
|
|
1100 (nreverse group-art)))))))
|
|
0
|
1101
|
|
|
1102 (defun nnmail-insert-lines ()
|
|
|
1103 "Insert how many lines there are in the body of the mail.
|
|
|
1104 Return the number of characters in the body."
|
|
|
1105 (let (lines chars)
|
|
|
1106 (save-excursion
|
|
|
1107 (goto-char (point-min))
|
|
98
|
1108 (when (search-forward "\n\n" nil t)
|
|
0
|
1109 (setq chars (- (point-max) (point)))
|
|
|
1110 (setq lines (count-lines (point) (point-max)))
|
|
|
1111 (forward-char -1)
|
|
|
1112 (save-excursion
|
|
|
1113 (when (re-search-backward "^Lines: " nil t)
|
|
|
1114 (delete-region (point) (progn (forward-line 1) (point)))))
|
|
|
1115 (beginning-of-line)
|
|
|
1116 (insert (format "Lines: %d\n" (max lines 0)))
|
|
|
1117 chars))))
|
|
|
1118
|
|
|
1119 (defun nnmail-insert-xref (group-alist)
|
|
|
1120 "Insert an Xref line based on the (group . article) alist."
|
|
|
1121 (save-excursion
|
|
|
1122 (goto-char (point-min))
|
|
98
|
1123 (when (search-forward "\n\n" nil t)
|
|
0
|
1124 (forward-char -1)
|
|
|
1125 (when (re-search-backward "^Xref: " nil t)
|
|
98
|
1126 (delete-region (match-beginning 0)
|
|
0
|
1127 (progn (forward-line 1) (point))))
|
|
|
1128 (insert (format "Xref: %s" (system-name)))
|
|
|
1129 (while group-alist
|
|
|
1130 (insert (format " %s:%d" (caar group-alist) (cdar group-alist)))
|
|
|
1131 (setq group-alist (cdr group-alist)))
|
|
|
1132 (insert "\n"))))
|
|
|
1133
|
|
98
|
1134 ;;; Message washing functions
|
|
|
1135
|
|
|
1136 (defun nnmail-remove-leading-whitespace ()
|
|
|
1137 "Remove excessive whitespace from all headers."
|
|
|
1138 (goto-char (point-min))
|
|
|
1139 (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
|
|
|
1140 (replace-match "\\1" t)))
|
|
|
1141
|
|
|
1142 (defun nnmail-remove-list-identifiers ()
|
|
|
1143 "Remove list identifiers from Subject headers."
|
|
|
1144 (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers
|
|
|
1145 (mapconcat 'identity nnmail-list-identifiers "\\|"))))
|
|
|
1146 (when regexp
|
|
|
1147 (goto-char (point-min))
|
|
|
1148 (when (re-search-forward
|
|
|
1149 (concat "^Subject: +\\(Re: +\\)?\\(" regexp "\\) *")
|
|
|
1150 nil t)
|
|
|
1151 (delete-region (match-beginning 2) (match-end 0))))))
|
|
|
1152
|
|
|
1153 (defun nnmail-remove-tabs ()
|
|
|
1154 "Translate TAB characters into SPACE characters."
|
|
|
1155 (subst-char-in-region (point-min) (point-max) ?\t ? t))
|
|
|
1156
|
|
|
1157 ;;; Utility functions
|
|
|
1158
|
|
0
|
1159 ;; Written by byer@mv.us.adobe.com (Scott Byer).
|
|
|
1160 (defun nnmail-make-complex-temp-name (prefix)
|
|
|
1161 (let ((newname (make-temp-name prefix))
|
|
|
1162 (newprefix prefix))
|
|
|
1163 (while (file-exists-p newname)
|
|
|
1164 (setq newprefix (concat newprefix "x"))
|
|
|
1165 (setq newname (make-temp-name newprefix)))
|
|
|
1166 newname))
|
|
|
1167
|
|
|
1168 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
|
|
|
1169
|
|
|
1170 (defun nnmail-split-fancy ()
|
|
|
1171 "Fancy splitting method.
|
|
|
1172 See the documentation for the variable `nnmail-split-fancy' for documentation."
|
|
|
1173 (let ((syntab (syntax-table)))
|
|
|
1174 (unwind-protect
|
|
|
1175 (progn
|
|
|
1176 (set-syntax-table nnmail-split-fancy-syntax-table)
|
|
|
1177 (nnmail-split-it nnmail-split-fancy))
|
|
|
1178 (set-syntax-table syntab))))
|
|
|
1179
|
|
|
1180 (defvar nnmail-split-cache nil)
|
|
|
1181 ;; Alist of split expressions their equivalent regexps.
|
|
|
1182
|
|
|
1183 (defun nnmail-split-it (split)
|
|
|
1184 ;; Return a list of groups matching SPLIT.
|
|
98
|
1185 (cond
|
|
|
1186 ;; nil split
|
|
|
1187 ((null split)
|
|
|
1188 nil)
|
|
|
1189
|
|
|
1190 ;; A group name. Do the \& and \N subs into the string.
|
|
|
1191 ((stringp split)
|
|
|
1192 (list (nnmail-expand-newtext split)))
|
|
|
1193
|
|
|
1194 ;; Junk the message.
|
|
|
1195 ((eq split 'junk)
|
|
|
1196 (list 'junk))
|
|
|
1197
|
|
|
1198 ;; Builtin & operation.
|
|
|
1199 ((eq (car split) '&)
|
|
|
1200 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
|
|
|
1201
|
|
|
1202 ;; Builtin | operation.
|
|
|
1203 ((eq (car split) '|)
|
|
|
1204 (let (done)
|
|
|
1205 (while (and (not done) (cdr split))
|
|
|
1206 (setq split (cdr split)
|
|
|
1207 done (nnmail-split-it (car split))))
|
|
|
1208 done))
|
|
|
1209
|
|
|
1210 ;; Builtin : operation.
|
|
|
1211 ((eq (car split) ':)
|
|
|
1212 (nnmail-split-it (eval (cdr split))))
|
|
|
1213
|
|
|
1214 ;; Check the cache for the regexp for this split.
|
|
|
1215 ;; FIX FIX FIX could avoid calling assq twice here
|
|
|
1216 ((assq split nnmail-split-cache)
|
|
|
1217 (goto-char (point-max))
|
|
|
1218 ;; FIX FIX FIX problem with re-search-backward is that if you have
|
|
|
1219 ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1")
|
|
|
1220 ;; and someone mails a message with 'To: foo-bar@gnus.org' and
|
|
|
1221 ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group
|
|
|
1222 ;; if the cc line is a later header, even though the other choice
|
|
|
1223 ;; is probably better. Also, this routine won't do a crosspost
|
|
|
1224 ;; when there are two different matches.
|
|
|
1225 ;; I guess you could just make this more determined, and it could
|
|
|
1226 ;; look for still more matches prior to this one, and recurse
|
|
|
1227 ;; on each of the multiple matches hit. Of course, then you'd
|
|
|
1228 ;; want to make sure that nnmail-article-group or nnmail-split-fancy
|
|
|
1229 ;; removed duplicates, since there might be more of those.
|
|
|
1230 ;; I guess we could also remove duplicates in the & split case, since
|
|
|
1231 ;; that's the only thing that can introduce them.
|
|
|
1232 (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
|
|
|
1233 ;; Someone might want to do a \N sub on this match, so get the
|
|
|
1234 ;; correct match positions.
|
|
|
1235 (goto-char (match-end 0))
|
|
|
1236 (let ((value (nth 1 split)))
|
|
|
1237 (re-search-backward (if (symbolp value)
|
|
|
1238 (cdr (assq value nnmail-split-abbrev-alist))
|
|
|
1239 value)
|
|
|
1240 (match-end 1)))
|
|
|
1241 (nnmail-split-it (nth 2 split))))
|
|
|
1242
|
|
|
1243 ;; Not in cache, compute a regexp for the field/value pair.
|
|
|
1244 (t
|
|
|
1245 (let* ((field (nth 0 split))
|
|
|
1246 (value (nth 1 split))
|
|
|
1247 (regexp (concat "^\\(\\("
|
|
|
1248 (if (symbolp field)
|
|
|
1249 (cdr (assq field nnmail-split-abbrev-alist))
|
|
|
1250 field)
|
|
|
1251 "\\):.*\\)\\<\\("
|
|
|
1252 (if (symbolp value)
|
|
|
1253 (cdr (assq value nnmail-split-abbrev-alist))
|
|
|
1254 value)
|
|
|
1255 "\\)\\>")))
|
|
|
1256 (push (cons split regexp) nnmail-split-cache)
|
|
|
1257 ;; Now that it's in the cache, just call nnmail-split-it again
|
|
|
1258 ;; on the same split, which will find it immediately in the cache.
|
|
|
1259 (nnmail-split-it split)))))
|
|
|
1260
|
|
|
1261 (defun nnmail-expand-newtext (newtext)
|
|
|
1262 (let ((len (length newtext))
|
|
|
1263 (pos 0)
|
|
|
1264 c expanded beg N did-expand)
|
|
|
1265 (while (< pos len)
|
|
|
1266 (setq beg pos)
|
|
|
1267 (while (and (< pos len)
|
|
|
1268 (not (= (aref newtext pos) ?\\)))
|
|
|
1269 (setq pos (1+ pos)))
|
|
|
1270 (unless (= beg pos)
|
|
|
1271 (push (substring newtext beg pos) expanded))
|
|
|
1272 (when (< pos len)
|
|
|
1273 ;; we hit a \, expand it.
|
|
|
1274 (setq did-expand t)
|
|
|
1275 (setq pos (1+ pos))
|
|
|
1276 (setq c (aref newtext pos))
|
|
|
1277 (if (not (or (= c ?\&)
|
|
|
1278 (and (>= c ?1)
|
|
|
1279 (<= c ?9))))
|
|
|
1280 ;; \ followed by some character we don't expand
|
|
|
1281 (push (char-to-string c) expanded)
|
|
|
1282 ;; \& or \N
|
|
|
1283 (if (= c ?\&)
|
|
|
1284 (setq N 0)
|
|
|
1285 (setq N (- c ?0)))
|
|
|
1286 (when (match-beginning N)
|
|
|
1287 (push (buffer-substring (match-beginning N) (match-end N))
|
|
|
1288 expanded))))
|
|
|
1289 (setq pos (1+ pos)))
|
|
|
1290 (if did-expand
|
|
|
1291 (apply 'concat (nreverse expanded))
|
|
|
1292 newtext)))
|
|
0
|
1293
|
|
|
1294 ;; Get a list of spool files to read.
|
|
|
1295 (defun nnmail-get-spool-files (&optional group)
|
|
|
1296 (if (null nnmail-spool-file)
|
|
|
1297 ;; No spool file whatsoever.
|
|
|
1298 nil
|
|
108
|
1299 (let* ((procmails
|
|
0
|
1300 ;; If procmail is used to get incoming mail, the files
|
|
|
1301 ;; are stored in this directory.
|
|
|
1302 (and (file-exists-p nnmail-procmail-directory)
|
|
|
1303 (or (eq nnmail-spool-file 'procmail)
|
|
|
1304 nnmail-use-procmail)
|
|
108
|
1305 (directory-files
|
|
|
1306 nnmail-procmail-directory
|
|
0
|
1307 t (concat (if group (concat "^" group) "")
|
|
98
|
1308 nnmail-procmail-suffix "$"))))
|
|
0
|
1309 (p procmails)
|
|
|
1310 (crash (when (and (file-exists-p nnmail-crash-box)
|
|
2
|
1311 (> (nnheader-file-size
|
|
98
|
1312 (file-truename nnmail-crash-box))
|
|
|
1313 0))
|
|
0
|
1314 (list nnmail-crash-box))))
|
|
98
|
1315 ;; Remove any directories that inadvertently match the procmail
|
|
108
|
1316 ;; suffix, which might happen if the suffix is "".
|
|
0
|
1317 (while p
|
|
|
1318 (when (file-directory-p (car p))
|
|
|
1319 (setq procmails (delete (car p) procmails)))
|
|
|
1320 (setq p (cdr p)))
|
|
|
1321 ;; Return the list of spools.
|
|
108
|
1322 (append
|
|
0
|
1323 crash
|
|
|
1324 (cond ((and group
|
|
|
1325 (or (eq nnmail-spool-file 'procmail)
|
|
2
|
1326 nnmail-use-procmail)
|
|
|
1327 procmails)
|
|
0
|
1328 procmails)
|
|
2
|
1329 ((and group
|
|
|
1330 (eq nnmail-spool-file 'procmail))
|
|
|
1331 nil)
|
|
0
|
1332 ((listp nnmail-spool-file)
|
|
98
|
1333 (nconc
|
|
108
|
1334 (apply
|
|
98
|
1335 'nconc
|
|
108
|
1336 (mapcar
|
|
98
|
1337 (lambda (file)
|
|
|
1338 (if (and (not (string-match "^po:" file))
|
|
|
1339 (file-directory-p file))
|
|
|
1340 (nnheader-directory-regular-files file)
|
|
|
1341 (list file)))
|
|
|
1342 nnmail-spool-file))
|
|
|
1343 procmails))
|
|
22
|
1344 ((stringp nnmail-spool-file)
|
|
98
|
1345 (if (and (not (string-match "^po:" nnmail-spool-file))
|
|
|
1346 (file-directory-p nnmail-spool-file))
|
|
108
|
1347 (nconc
|
|
98
|
1348 (nnheader-directory-regular-files nnmail-spool-file)
|
|
|
1349 procmails)
|
|
|
1350 (cons nnmail-spool-file procmails)))
|
|
0
|
1351 ((eq nnmail-spool-file 'pop)
|
|
|
1352 (cons (format "po:%s" (user-login-name)) procmails))
|
|
|
1353 (t
|
|
|
1354 procmails))))))
|
|
|
1355
|
|
108
|
1356 ;; Activate a backend only if it isn't already activated.
|
|
|
1357 ;; If FORCE, re-read the active file even if the backend is
|
|
0
|
1358 ;; already activated.
|
|
|
1359 (defun nnmail-activate (backend &optional force)
|
|
|
1360 (let (file timestamp file-time)
|
|
|
1361 (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
|
|
|
1362 force
|
|
98
|
1363 (and (setq file (ignore-errors
|
|
108
|
1364 (symbol-value (intern (format "%s-active-file"
|
|
98
|
1365 backend)))))
|
|
0
|
1366 (setq file-time (nth 5 (file-attributes file)))
|
|
|
1367 (or (not
|
|
|
1368 (setq timestamp
|
|
|
1369 (condition-case ()
|
|
|
1370 (symbol-value (intern
|
|
108
|
1371 (format "%s-active-timestamp"
|
|
0
|
1372 backend)))
|
|
|
1373 (error 'none))))
|
|
|
1374 (not (consp timestamp))
|
|
|
1375 (equal timestamp '(0 0))
|
|
|
1376 (> (nth 0 file-time) (nth 0 timestamp))
|
|
|
1377 (and (= (nth 0 file-time) (nth 0 timestamp))
|
|
|
1378 (> (nth 1 file-time) (nth 1 timestamp))))))
|
|
|
1379 (save-excursion
|
|
|
1380 (or (eq timestamp 'none)
|
|
108
|
1381 (set (intern (format "%s-active-timestamp" backend))
|
|
|
1382 file-time))
|
|
|
1383 (funcall (intern (format "%s-request-list" backend)))))
|
|
0
|
1384 t))
|
|
|
1385
|
|
|
1386 (defun nnmail-message-id ()
|
|
|
1387 (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
|
|
|
1388
|
|
|
1389 ;;;
|
|
|
1390 ;;; nnmail duplicate handling
|
|
|
1391 ;;;
|
|
|
1392
|
|
|
1393 (defvar nnmail-cache-buffer nil)
|
|
|
1394
|
|
|
1395 (defun nnmail-cache-open ()
|
|
|
1396 (if (or (not nnmail-treat-duplicates)
|
|
|
1397 (and nnmail-cache-buffer
|
|
|
1398 (buffer-name nnmail-cache-buffer)))
|
|
|
1399 () ; The buffer is open.
|
|
|
1400 (save-excursion
|
|
108
|
1401 (set-buffer
|
|
|
1402 (setq nnmail-cache-buffer
|
|
0
|
1403 (get-buffer-create " *nnmail message-id cache*")))
|
|
|
1404 (buffer-disable-undo (current-buffer))
|
|
98
|
1405 (when (file-exists-p nnmail-message-id-cache-file)
|
|
|
1406 (nnheader-insert-file-contents nnmail-message-id-cache-file))
|
|
0
|
1407 (set-buffer-modified-p nil)
|
|
|
1408 (current-buffer))))
|
|
|
1409
|
|
|
1410 (defun nnmail-cache-close ()
|
|
|
1411 (when (and nnmail-cache-buffer
|
|
|
1412 nnmail-treat-duplicates
|
|
|
1413 (buffer-name nnmail-cache-buffer)
|
|
|
1414 (buffer-modified-p nnmail-cache-buffer))
|
|
|
1415 (save-excursion
|
|
|
1416 (set-buffer nnmail-cache-buffer)
|
|
|
1417 ;; Weed out the excess number of Message-IDs.
|
|
|
1418 (goto-char (point-max))
|
|
98
|
1419 (when (search-backward "\n" nil t nnmail-message-id-cache-length)
|
|
|
1420 (progn
|
|
|
1421 (beginning-of-line)
|
|
|
1422 (delete-region (point-min) (point))))
|
|
0
|
1423 ;; Save the buffer.
|
|
|
1424 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
|
|
|
1425 (make-directory (file-name-directory nnmail-message-id-cache-file)
|
|
|
1426 t))
|
|
98
|
1427 (nnmail-write-region (point-min) (point-max)
|
|
|
1428 nnmail-message-id-cache-file nil 'silent)
|
|
0
|
1429 (set-buffer-modified-p nil)
|
|
|
1430 (setq nnmail-cache-buffer nil)
|
|
108
|
1431 (kill-buffer (current-buffer)))))
|
|
0
|
1432
|
|
|
1433 (defun nnmail-cache-insert (id)
|
|
|
1434 (when nnmail-treat-duplicates
|
|
108
|
1435 (unless (gnus-buffer-live-p nnmail-cache-buffer)
|
|
|
1436 (nnmail-cache-open))
|
|
0
|
1437 (save-excursion
|
|
|
1438 (set-buffer nnmail-cache-buffer)
|
|
|
1439 (goto-char (point-max))
|
|
|
1440 (insert id "\n"))))
|
|
|
1441
|
|
|
1442 (defun nnmail-cache-id-exists-p (id)
|
|
|
1443 (when nnmail-treat-duplicates
|
|
|
1444 (save-excursion
|
|
|
1445 (set-buffer nnmail-cache-buffer)
|
|
|
1446 (goto-char (point-max))
|
|
|
1447 (search-backward id nil t))))
|
|
|
1448
|
|
108
|
1449 (defun nnmail-fetch-field (header)
|
|
|
1450 (save-excursion
|
|
|
1451 (save-restriction
|
|
|
1452 (message-narrow-to-head)
|
|
|
1453 (message-fetch-field header))))
|
|
|
1454
|
|
98
|
1455 (defun nnmail-check-duplication (message-id func artnum-func)
|
|
|
1456 (run-hooks 'nnmail-prepare-incoming-message-hook)
|
|
0
|
1457 ;; If this is a duplicate message, then we do not save it.
|
|
|
1458 (let* ((duplication (nnmail-cache-id-exists-p message-id))
|
|
98
|
1459 (case-fold-search t)
|
|
0
|
1460 (action (when duplication
|
|
|
1461 (cond
|
|
|
1462 ((memq nnmail-treat-duplicates '(warn delete))
|
|
|
1463 nnmail-treat-duplicates)
|
|
|
1464 ((nnheader-functionp nnmail-treat-duplicates)
|
|
|
1465 (funcall nnmail-treat-duplicates message-id))
|
|
|
1466 (t
|
|
98
|
1467 nnmail-treat-duplicates))))
|
|
|
1468 group-art)
|
|
|
1469 ;; Let the backend save the article (or not).
|
|
0
|
1470 (cond
|
|
|
1471 ((not duplication)
|
|
|
1472 (nnmail-cache-insert message-id)
|
|
98
|
1473 (funcall func (setq group-art
|
|
|
1474 (nreverse (nnmail-article-group artnum-func)))))
|
|
0
|
1475 ((eq action 'delete)
|
|
98
|
1476 (setq group-art nil))
|
|
0
|
1477 ((eq action 'warn)
|
|
|
1478 ;; We insert a warning.
|
|
108
|
1479 (let ((case-fold-search t))
|
|
0
|
1480 (goto-char (point-min))
|
|
108
|
1481 (re-search-forward "^message-id[ \t]*:" nil t)
|
|
0
|
1482 (beginning-of-line)
|
|
108
|
1483 (insert
|
|
0
|
1484 "Gnus-Warning: This is a duplicate of message " message-id "\n")
|
|
98
|
1485 (funcall func (setq group-art
|
|
|
1486 (nreverse (nnmail-article-group artnum-func))))))
|
|
0
|
1487 (t
|
|
98
|
1488 (funcall func (setq group-art
|
|
|
1489 (nreverse (nnmail-article-group artnum-func))))))
|
|
|
1490 ;; Add the group-art list to the history list.
|
|
|
1491 (if group-art
|
|
|
1492 (push group-art nnmail-split-history)
|
|
|
1493 (delete-region (point-min) (point-max)))))
|
|
0
|
1494
|
|
|
1495 ;;; Get new mail.
|
|
|
1496
|
|
|
1497 (defun nnmail-get-value (&rest args)
|
|
|
1498 (let ((sym (intern (apply 'format args))))
|
|
|
1499 (when (boundp sym)
|
|
|
1500 (symbol-value sym))))
|
|
|
1501
|
|
|
1502 (defun nnmail-get-new-mail (method exit-func temp
|
|
|
1503 &optional group spool-func)
|
|
|
1504 "Read new incoming mail."
|
|
98
|
1505 ;; Nix out the previous split history.
|
|
|
1506 (unless group
|
|
|
1507 (setq nnmail-split-history nil))
|
|
0
|
1508 (let* ((spools (nnmail-get-spool-files group))
|
|
|
1509 (group-in group)
|
|
|
1510 incoming incomings spool)
|
|
|
1511 (when (and (nnmail-get-value "%s-get-new-mail" method)
|
|
|
1512 nnmail-spool-file)
|
|
|
1513 ;; We first activate all the groups.
|
|
|
1514 (nnmail-activate method)
|
|
|
1515 ;; Allow the user to hook.
|
|
|
1516 (run-hooks 'nnmail-pre-get-new-mail-hook)
|
|
|
1517 ;; Open the message-id cache.
|
|
|
1518 (nnmail-cache-open)
|
|
|
1519 ;; The we go through all the existing spool files and split the
|
|
|
1520 ;; mail from each.
|
|
|
1521 (while spools
|
|
|
1522 (setq spool (pop spools))
|
|
|
1523 ;; We read each spool file if either the spool is a POP-mail
|
|
|
1524 ;; spool, or the file exists. We can't check for the
|
|
98
|
1525 ;; existence of POPped mail.
|
|
0
|
1526 (when (or (string-match "^po:" spool)
|
|
98
|
1527 (and (file-exists-p (file-truename spool))
|
|
2
|
1528 (> (nnheader-file-size (file-truename spool)) 0)))
|
|
0
|
1529 (nnheader-message 3 "%s: Reading incoming mail..." method)
|
|
|
1530 (when (and (nnmail-move-inbox spool)
|
|
|
1531 (file-exists-p nnmail-crash-box))
|
|
|
1532 ;; There is new mail. We first find out if all this mail
|
|
|
1533 ;; is supposed to go to some specific group.
|
|
|
1534 (setq group (nnmail-get-split-group spool group-in))
|
|
|
1535 ;; We split the mail
|
|
108
|
1536 (nnmail-split-incoming
|
|
98
|
1537 nnmail-crash-box (intern (format "%s-save-mail" method))
|
|
|
1538 spool-func group (intern (format "%s-active-number" method)))
|
|
108
|
1539 ;; Check whether the inbox is to be moved to the special tmp dir.
|
|
0
|
1540 (setq incoming
|
|
108
|
1541 (nnmail-make-complex-temp-name
|
|
|
1542 (expand-file-name
|
|
0
|
1543 (if nnmail-tmp-directory
|
|
108
|
1544 (concat
|
|
0
|
1545 (file-name-as-directory nnmail-tmp-directory)
|
|
100
|
1546 (file-name-nondirectory
|
|
|
1547 (concat (file-name-as-directory temp) "Incoming")))
|
|
|
1548 (concat (file-name-as-directory temp) "Incoming")))))
|
|
0
|
1549 (rename-file nnmail-crash-box incoming t)
|
|
|
1550 (push incoming incomings))))
|
|
108
|
1551 ;; If we did indeed read any incoming spools, we save all info.
|
|
0
|
1552 (when incomings
|
|
108
|
1553 (nnmail-save-active
|
|
0
|
1554 (nnmail-get-value "%s-group-alist" method)
|
|
|
1555 (nnmail-get-value "%s-active-file" method))
|
|
|
1556 (when exit-func
|
|
|
1557 (funcall exit-func))
|
|
|
1558 (run-hooks 'nnmail-read-incoming-hook)
|
|
|
1559 (nnheader-message 3 "%s: Reading incoming mail...done" method))
|
|
|
1560 ;; Close the message-id cache.
|
|
|
1561 (nnmail-cache-close)
|
|
|
1562 ;; Allow the user to hook.
|
|
|
1563 (run-hooks 'nnmail-post-get-new-mail-hook)
|
|
|
1564 ;; Delete all the temporary files.
|
|
|
1565 (while incomings
|
|
|
1566 (setq incoming (pop incomings))
|
|
|
1567 (and nnmail-delete-incoming
|
|
|
1568 (file-exists-p incoming)
|
|
|
1569 (file-writable-p incoming)
|
|
|
1570 (delete-file incoming))))))
|
|
|
1571
|
|
|
1572 (defun nnmail-expired-article-p (group time force &optional inhibit)
|
|
|
1573 "Say whether an article that is TIME old in GROUP should be expired."
|
|
|
1574 (if force
|
|
|
1575 t
|
|
|
1576 (let ((days (or (and nnmail-expiry-wait-function
|
|
|
1577 (funcall nnmail-expiry-wait-function group))
|
|
|
1578 nnmail-expiry-wait)))
|
|
|
1579 (cond ((or (eq days 'never)
|
|
|
1580 (and (not force)
|
|
|
1581 inhibit))
|
|
|
1582 ;; This isn't an expirable group.
|
|
|
1583 nil)
|
|
|
1584 ((eq days 'immediate)
|
|
|
1585 ;; We expire all articles on sight.
|
|
|
1586 t)
|
|
|
1587 ((equal time '(0 0))
|
|
|
1588 ;; This is an ange-ftp group, and we don't have any dates.
|
|
|
1589 nil)
|
|
|
1590 ((numberp days)
|
|
|
1591 (setq days (nnmail-days-to-time days))
|
|
|
1592 ;; Compare the time with the current time.
|
|
|
1593 (nnmail-time-less days (nnmail-time-since time)))))))
|
|
|
1594
|
|
|
1595 (defvar nnmail-read-passwd nil)
|
|
98
|
1596 (defun nnmail-read-passwd (prompt &rest args)
|
|
|
1597 "Read a password using PROMPT.
|
|
|
1598 If ARGS, PROMPT is used as an argument to `format'."
|
|
|
1599 (let ((prompt
|
|
|
1600 (if args
|
|
|
1601 (apply 'format prompt args)
|
|
|
1602 prompt)))
|
|
|
1603 (unless nnmail-read-passwd
|
|
|
1604 (if (load "passwd" t)
|
|
|
1605 (setq nnmail-read-passwd 'read-passwd)
|
|
104
|
1606 (unless (fboundp 'ange-ftp-read-passwd)
|
|
|
1607 (autoload 'ange-ftp-read-passwd "ange-ftp"))
|
|
98
|
1608 (setq nnmail-read-passwd 'ange-ftp-read-passwd)))
|
|
|
1609 (funcall nnmail-read-passwd prompt)))
|
|
0
|
1610
|
|
|
1611 (defun nnmail-check-syntax ()
|
|
|
1612 "Check (and modify) the syntax of the message in the current buffer."
|
|
|
1613 (save-restriction
|
|
|
1614 (message-narrow-to-head)
|
|
|
1615 (let ((case-fold-search t))
|
|
104
|
1616 (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
|
|
0
|
1617 (insert "Message-ID: " (nnmail-message-id) "\n")))))
|
|
|
1618
|
|
98
|
1619 (defun nnmail-write-region (start end filename &optional append visit lockname)
|
|
|
1620 "Do a `write-region', and then set the file modes."
|
|
|
1621 (write-region start end filename append visit lockname)
|
|
|
1622 (set-file-modes filename nnmail-default-file-modes))
|
|
|
1623
|
|
|
1624 ;;;
|
|
|
1625 ;;; Status functions
|
|
|
1626 ;;;
|
|
|
1627
|
|
|
1628 (defun nnmail-replace-status (name value)
|
|
|
1629 "Make status NAME and VALUE part of the current status line."
|
|
|
1630 (save-restriction
|
|
|
1631 (message-narrow-to-head)
|
|
|
1632 (let ((status (nnmail-decode-status)))
|
|
|
1633 (setq status (delq (member name status) status))
|
|
|
1634 (when value
|
|
|
1635 (push (cons name value) status))
|
|
|
1636 (message-remove-header "status")
|
|
|
1637 (goto-char (point-max))
|
|
|
1638 (insert "Status: " (nnmail-encode-status status) "\n"))))
|
|
|
1639
|
|
|
1640 (defun nnmail-decode-status ()
|
|
|
1641 "Return a status-value alist from STATUS."
|
|
|
1642 (goto-char (point-min))
|
|
|
1643 (when (re-search-forward "^Status: " nil t)
|
|
|
1644 (let (name value status)
|
|
|
1645 (save-restriction
|
|
|
1646 ;; Narrow to the status.
|
|
|
1647 (narrow-to-region
|
|
|
1648 (point)
|
|
|
1649 (if (re-search-forward "^[^ \t]" nil t)
|
|
|
1650 (1- (point))
|
|
|
1651 (point-max)))
|
|
|
1652 ;; Go through all elements and add them to the list.
|
|
|
1653 (goto-char (point-min))
|
|
|
1654 (while (re-search-forward "[^ \t=]+" nil t)
|
|
|
1655 (setq name (match-string 0))
|
|
|
1656 (if (not (= (following-char) ?=))
|
|
|
1657 ;; Implied "yes".
|
|
|
1658 (setq value "yes")
|
|
|
1659 (forward-char 1)
|
|
|
1660 (if (not (= (following-char) ?\"))
|
|
|
1661 (if (not (looking-at "[^ \t]"))
|
|
|
1662 ;; Implied "no".
|
|
|
1663 (setq value "no")
|
|
|
1664 ;; Unquoted value.
|
|
|
1665 (setq value (match-string 0))
|
|
|
1666 (goto-char (match-end 0)))
|
|
|
1667 ;; Quoted value.
|
|
|
1668 (setq value (read (current-buffer)))))
|
|
|
1669 (push (cons name value) status)))
|
|
|
1670 status)))
|
|
|
1671
|
|
|
1672 (defun nnmail-encode-status (status)
|
|
|
1673 "Return a status string from STATUS."
|
|
|
1674 (mapconcat
|
|
|
1675 (lambda (elem)
|
|
|
1676 (concat
|
|
|
1677 (car elem) "="
|
|
|
1678 (if (string-match "[ \t]" (cdr elem))
|
|
|
1679 (prin1-to-string (cdr elem))
|
|
|
1680 (cdr elem))))
|
|
|
1681 status " "))
|
|
|
1682
|
|
|
1683 (defun nnmail-split-history ()
|
|
|
1684 "Generate an overview of where the last mail split put articles."
|
|
|
1685 (interactive)
|
|
|
1686 (unless nnmail-split-history
|
|
|
1687 (error "No current split history"))
|
|
|
1688 (with-output-to-temp-buffer "*nnmail split history*"
|
|
|
1689 (let ((history nnmail-split-history)
|
|
|
1690 elem)
|
|
|
1691 (while (setq elem (pop history))
|
|
|
1692 (princ (mapconcat (lambda (ga)
|
|
|
1693 (concat (car ga) ":" (int-to-string (cdr ga))))
|
|
|
1694 elem
|
|
|
1695 ", "))
|
|
|
1696 (princ "\n")))))
|
|
|
1697
|
|
|
1698 (defun nnmail-new-mail-p (group)
|
|
|
1699 "Say whether GROUP has new mail."
|
|
|
1700 (let ((his nnmail-split-history)
|
|
|
1701 found)
|
|
|
1702 (while his
|
|
|
1703 (when (assoc group (pop his))
|
|
|
1704 (setq found t
|
|
|
1705 his nil)))
|
|
|
1706 found))
|
|
100
|
1707
|
|
108
|
1708 (eval-and-compile
|
|
|
1709 (autoload 'pop3-movemail "pop3"))
|
|
|
1710
|
|
100
|
1711 (defun nnmail-pop3-movemail (inbox crashbox)
|
|
|
1712 "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
|
|
|
1713 (let ((pop3-maildrop
|
|
|
1714 (substring inbox (match-end (string-match "^po:" inbox)))))
|
|
|
1715 (pop3-movemail crashbox)))
|
|
|
1716
|
|
0
|
1717 (run-hooks 'nnmail-load-hook)
|
|
108
|
1718
|
|
0
|
1719 (provide 'nnmail)
|
|
|
1720
|
|
|
1721 ;;; nnmail.el ends here
|
