Commit | Line | Data |
---|---|---|
41487370 LMI |
1 | ;;; nnmail.el --- mail support functions for the Gnus mail backends |
2 | ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
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 | |
21 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;;; Code: | |
26 | ||
27 | (require 'nnheader) | |
28 | (require 'rmail) | |
29 | (require 'timezone) | |
30 | (require 'sendmail) | |
31 | ||
32 | (defvar nnmail-split-methods | |
33 | '(("mail.misc" "")) | |
34 | "*Incoming mail will be split according to this variable. | |
35 | ||
36 | If you'd like, for instance, one mail group for mail from the | |
37 | \"4ad-l\" mailing list, one group for junk mail and one for everything | |
38 | else, you could do something like this: | |
39 | ||
40 | (setq nnmail-split-methods | |
41 | '((\"mail.4ad\" \"From:.*4ad\") | |
42 | (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") | |
43 | (\"mail.misc\" \"\"))) | |
44 | ||
45 | As you can see, this variable is a list of lists, where the first | |
46 | element in each \"rule\" is the name of the group (which, by the way, | |
47 | does not have to be called anything beginning with \"mail\", | |
48 | \"yonka.zow\" is a fine, fine name), and the second is a regexp that | |
49 | nnmail will try to match on the header to find a fit. | |
50 | ||
51 | The second element can also be a function. In that case, it will be | |
52 | called narrowed to the headers with the first element of the rule as | |
53 | the argument. It should return a non-nil value if it thinks that the | |
54 | mail belongs in that group. | |
55 | ||
56 | The last element should always have \"\" as the regexp. | |
57 | ||
58 | This variable can also have a function as its value.") | |
59 | ||
60 | ;; Suggested by Erik Selberg <speed@cs.washington.edu>. | |
61 | (defvar nnmail-crosspost t | |
62 | "*If non-nil, do crossposting if several split methods match the mail. | |
63 | If nil, the first match found will be used.") | |
64 | ||
65 | ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). | |
66 | (defvar nnmail-keep-last-article nil | |
67 | "*If non-nil, nnmail will never delete the last expired article in a | |
68 | directory. You may need to set this variable if other programs are putting | |
69 | new mail into folder numbers that Gnus has marked as expired.") | |
70 | ||
71 | (defvar nnmail-expiry-wait 7 | |
72 | "*Articles that are older than `nnmail-expiry-wait' days will be expired.") | |
73 | ||
74 | (defvar nnmail-expiry-wait-function nil | |
75 | "*Variable that holds function to specify how old articles should be before they are expired. | |
76 | The function will be called with the name of the group that the | |
77 | expiry is to be performed in, and it should return an integer that | |
78 | says how many days an article can be stored before it is considered | |
79 | 'old'. | |
80 | ||
81 | Eg.: | |
82 | ||
83 | (setq nnmail-expiry-wait-function | |
84 | (lambda (newsgroup) | |
85 | (cond ((string-match \"private\" newsgroup) 31) | |
86 | ((string-match \"junk\" newsgroup) 1) | |
87 | (t 7))))") | |
88 | ||
89 | (defvar nnmail-spool-file | |
90 | (or (getenv "MAIL") | |
91 | (concat "/usr/spool/mail/" (user-login-name))) | |
92 | "Where the mail backends will look for incoming mail. | |
93 | This variable is \"/usr/spool/mail/$user\" by default. | |
94 | If this variable is nil, no mail backends will read incoming mail. | |
95 | If this variable is a list, all files mentioned in this list will be | |
96 | used as incoming mailboxes.") | |
97 | ||
98 | (defvar nnmail-use-procmail nil | |
99 | "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. | |
100 | The file(s) in `nnmail-spool-file' will also be read.") | |
101 | ||
102 | (defvar nnmail-procmail-directory "~/incoming/" | |
103 | "*When using procmail (and the like), incoming mail is put in this directory. | |
104 | The Gnus mail backends will read the mail from this directory.") | |
105 | ||
106 | (defvar nnmail-procmail-suffix ".spool" | |
107 | "*Suffix of files created by procmail (and the like). | |
108 | This variable might be a suffix-regexp to match the suffixes of | |
109 | several files - eg. \".spool[0-9]*\".") | |
110 | ||
111 | (defvar nnmail-resplit-incoming nil | |
112 | "*If non-nil, re-split incoming procmail sorted mail.") | |
113 | ||
114 | (defvar nnmail-movemail-program "movemail" | |
115 | "*A command to be executed to move mail from the inbox. | |
116 | The default is \"movemail\".") | |
117 | ||
118 | (defvar nnmail-read-incoming-hook nil | |
119 | "*Hook that will be run after the incoming mail has been transferred. | |
120 | The incoming mail is moved from `nnmail-spool-file' (which normally is | |
121 | something like \"/usr/spool/mail/$user\") to the user's home | |
122 | directory. This hook is called after the incoming mail box has been | |
123 | emptied, and can be used to call any mail box programs you have | |
124 | running (\"xwatch\", etc.) | |
125 | ||
126 | Eg. | |
127 | ||
128 | (add-hook 'nnmail-read-incoming-hook | |
129 | (lambda () | |
130 | (start-process \"mailsend\" nil | |
131 | \"/local/bin/mailsend\" \"read\" \"mbox\")))") | |
132 | ||
133 | ;; Suggested by Erik Selberg <speed@cs.washington.edu>. | |
134 | (defvar nnmail-prepare-incoming-hook nil | |
135 | "*Hook called before treating incoming mail. | |
136 | The hook is run in a buffer with all the new, incoming mail.") | |
137 | ||
138 | ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>. | |
139 | (defvar nnmail-tmp-directory nil | |
140 | "*If non-nil, use this directory for temporary storage when reading incoming mail.") | |
141 | ||
142 | (defvar nnmail-large-newsgroup 50 | |
143 | "*The number of the articles which indicates a large newsgroup. | |
144 | If the number of the articles is greater than the value, verbose | |
145 | messages will be shown to indicate the current status.") | |
146 | ||
147 | (defvar nnmail-split-fancy "mail.misc" | |
148 | "*Incoming mail can be split according to this fancy variable. | |
149 | To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. | |
150 | ||
151 | The format is this variable is SPLIT, where SPLIT can be one of | |
152 | the following: | |
153 | ||
154 | GROUP: Mail will be stored in GROUP (a string). | |
155 | ||
156 | \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains | |
157 | VALUE (a regexp), store the messages as specified by SPLIT. | |
158 | ||
159 | \(| SPLIT...): Process each SPLIT expression until one of them matches. | |
160 | A SPLIT expression is said to match if it will cause the mail | |
161 | message to be stored in one or more groups. | |
162 | ||
163 | \(& SPLIT...): Process each SPLIT expression. | |
164 | ||
165 | FIELD must match a complete field name. VALUE must match a complete | |
166 | word according to the fundamental mode syntax table. You can use .* | |
167 | in the regexps to match partial field names or words. | |
168 | ||
169 | FIELD and VALUE can also be lisp symbols, in that case they are expanded | |
170 | as specified in `nnmail-split-abbrev-alist'. | |
171 | ||
172 | Example: | |
173 | ||
174 | \(setq nnmail-split-methods 'nnmail-split-fancy | |
175 | nnmail-split-fancy | |
176 | ;; Messages from the mailer deamon are not crossposted to any of | |
177 | ;; the ordinary groups. Warnings are put in a separate group | |
178 | ;; from real errors. | |
179 | '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\") | |
180 | \"mail.misc\")) | |
181 | ;; Non-error messages are crossposted to all relevant | |
182 | ;; groups, but we don't crosspost between the group for the | |
183 | ;; (ding) list and the group for other (ding) related mail. | |
184 | (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\") | |
185 | (\"subject\" \"ding\" \"ding.misc\")) | |
186 | ;; Other mailing lists... | |
187 | (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") | |
188 | (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") | |
189 | ;; People... | |
190 | (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) | |
191 | ;; Unmatched mail goes to the catch all group. | |
192 | \"misc.misc\"))") | |
193 | ||
194 | (defvar nnmail-split-abbrev-alist | |
195 | '((any . "from\\|to\\|cc\\|sender\\|apparently-to") | |
196 | (mail . "mailer-daemon\\|postmaster")) | |
197 | "*Alist of abbreviations allowed in `nnmail-split-fancy'.") | |
198 | ||
199 | (defvar nnmail-delete-incoming t | |
200 | "*If non-nil, the mail backends will delete incoming files after splitting.") | |
201 | ||
202 | (defvar nnmail-message-id-cache-length 1000 | |
203 | "*The approximate number of Message-IDs nnmail will keep in its cache. | |
204 | If this variable is nil, no checking on duplicate messages will be | |
205 | perfomed.") | |
206 | ||
207 | (defvar nnmail-message-id-cache-file "~/.nnmail-cache" | |
208 | "*The file name of the nnmail Message-ID cache.") | |
209 | ||
210 | (defvar nnmail-delete-duplicates nil | |
211 | "*If non-nil, nnmail will delete any duplicate mails it sees.") | |
212 | ||
213 | \f | |
214 | ||
215 | (defconst nnmail-version "nnmail 1.0" | |
216 | "nnmail version.") | |
217 | ||
218 | \f | |
219 | ||
220 | (defun nnmail-request-post (&optional server) | |
221 | (mail-send-and-exit nil)) | |
222 | ||
223 | (defun nnmail-request-post-buffer (post group subject header article-buffer | |
224 | info follow-to respect-poster) | |
225 | (let ((method-address (cdr (assq 'to-address (nth 5 info)))) | |
226 | from date to reply-to message-of | |
227 | references message-id cc new-cc sendto elt) | |
228 | (setq method-address | |
229 | (if (and (stringp method-address) | |
230 | (string= method-address "")) | |
231 | nil method-address)) | |
232 | (save-excursion | |
233 | (set-buffer (get-buffer-create "*mail*")) | |
234 | (mail-mode) | |
235 | (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) | |
236 | (if (and (buffer-modified-p) | |
237 | (> (buffer-size) 0) | |
238 | (not (y-or-n-p "Unsent mail being composed; erase it? "))) | |
239 | () | |
240 | (erase-buffer) | |
241 | (if post | |
242 | (progn | |
243 | (mail-setup method-address subject nil nil nil nil) | |
244 | (auto-save-mode auto-save-default)) | |
245 | (save-excursion | |
246 | (set-buffer article-buffer) | |
247 | (goto-char (point-min)) | |
248 | (narrow-to-region (point-min) | |
249 | (progn (search-forward "\n\n") (point))) | |
250 | (let ((buffer-read-only nil)) | |
251 | (set-text-properties (point-min) (point-max) nil)) | |
252 | (setq from (mail-header-from header)) | |
253 | (setq date (mail-header-date header)) | |
254 | (and from | |
255 | (let ((stop-pos | |
256 | (string-match " *at \\| *@ \\| *(\\| *<" from))) | |
257 | (setq message-of | |
258 | (concat (if stop-pos (substring from 0 stop-pos) from) | |
259 | "'s message of " date)))) | |
260 | (setq cc (mail-strip-quoted-names (or (mail-fetch-field "cc") ""))) | |
261 | (setq to (mail-strip-quoted-names (or (mail-fetch-field "to") ""))) | |
262 | (setq new-cc (rmail-dont-reply-to | |
263 | (concat (or to "") | |
264 | (if cc (concat (if to ", " "") cc) "")))) | |
265 | (let ((rmail-dont-reply-to-names | |
266 | (regexp-quote (mail-strip-quoted-names | |
267 | (or method-address reply-to from ""))))) | |
268 | (setq new-cc (rmail-dont-reply-to new-cc))) | |
269 | (setq subject (mail-header-subject header)) | |
270 | (or (string-match "^[Rr][Ee]:" subject) | |
271 | (setq subject (concat "Re: " subject))) | |
272 | (setq reply-to (mail-fetch-field "reply-to")) | |
273 | (setq references (mail-header-references header)) | |
274 | (setq message-id (mail-header-id header)) | |
275 | (widen)) | |
276 | (setq news-reply-yank-from from) | |
277 | (setq news-reply-yank-message-id message-id) | |
278 | ||
279 | ;; Gather the "to" addresses out of the follow-to list and remove | |
280 | ;; them as we go. | |
281 | (if (and follow-to (listp follow-to)) | |
282 | (while (setq elt (assoc "To" follow-to)) | |
283 | (setq sendto (concat sendto (and sendto ", ") (cdr elt))) | |
284 | (setq follow-to (delq elt follow-to)))) | |
285 | (mail-setup (if (and follow-to (listp follow-to)) | |
286 | sendto | |
287 | (or method-address reply-to from "")) | |
288 | subject message-of | |
289 | (if (zerop (length new-cc)) nil new-cc) | |
290 | article-buffer nil) | |
291 | (auto-save-mode auto-save-default) | |
292 | ;; Note that "To" elements should already be in the message. | |
293 | (if (and follow-to (listp follow-to)) | |
294 | (progn | |
295 | (goto-char (point-min)) | |
296 | (re-search-forward "^To:" nil t) | |
297 | (beginning-of-line) | |
298 | (forward-line 1) | |
299 | (while follow-to | |
300 | (insert | |
301 | (car (car follow-to)) ": " (cdr (car follow-to)) "\n") | |
302 | (setq follow-to (cdr follow-to))))) | |
303 | (nnheader-insert-references references message-id))) | |
304 | (current-buffer)))) | |
305 | ||
306 | (defun nnmail-find-file (file) | |
307 | "Insert FILE in server buffer safely." | |
308 | (set-buffer nntp-server-buffer) | |
309 | (erase-buffer) | |
310 | (condition-case () | |
311 | (progn (insert-file-contents file) t) | |
312 | (file-error nil))) | |
313 | ||
314 | (defun nnmail-article-pathname (group mail-dir) | |
315 | "Make pathname for GROUP." | |
316 | (concat (file-name-as-directory (expand-file-name mail-dir)) | |
317 | (nnmail-replace-chars-in-string group ?. ?/) "/")) | |
318 | ||
319 | (defun nnmail-replace-chars-in-string (string from to) | |
320 | "Replace characters in STRING from FROM to TO." | |
321 | (let ((string (substring string 0)) ;Copy string. | |
322 | (len (length string)) | |
323 | (idx 0)) | |
324 | ;; Replace all occurrences of FROM with TO. | |
325 | (while (< idx len) | |
326 | (if (= (aref string idx) from) | |
327 | (aset string idx to)) | |
328 | (setq idx (1+ idx))) | |
329 | string)) | |
330 | ||
331 | (defun nnmail-days-between (date1 date2) | |
332 | ;; Return the number of days between date1 and date2. | |
333 | (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) ) | |
334 | (timezone-parse-date date1))) | |
335 | (d2 (mapcar (lambda (s) (and s (string-to-int s)) ) | |
336 | (timezone-parse-date date2)))) | |
337 | (- (timezone-absolute-from-gregorian | |
338 | (nth 1 d1) (nth 2 d1) (car d1)) | |
339 | (timezone-absolute-from-gregorian | |
340 | (nth 1 d2) (nth 2 d2) (car d2))))) | |
341 | ||
342 | ;; Function taken from rmail.el. | |
343 | (defun nnmail-move-inbox (inbox tofile) | |
344 | (let ((inbox (file-truename | |
345 | (expand-file-name (substitute-in-file-name inbox)))) | |
346 | movemail popmail errors) | |
347 | ;; Check whether the inbox is to be moved to the special tmp dir. | |
348 | (if nnmail-tmp-directory | |
349 | (setq tofile (concat (file-name-as-directory nnmail-tmp-directory) | |
350 | (file-name-nondirectory tofile)))) | |
351 | ;; Make the filename unique. | |
352 | (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile))) | |
353 | ;; We create the directory the tofile is to reside in if it | |
354 | ;; doesn't exist. | |
355 | (or (file-exists-p (file-name-directory tofile)) | |
356 | (make-directory tofile 'parents)) | |
357 | ;; If getting from mail spool directory, | |
358 | ;; use movemail to move rather than just renaming, | |
359 | ;; so as to interlock with the mailer. | |
360 | (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox))) | |
361 | (setq movemail t)) | |
362 | (if popmail (setq inbox (file-name-nondirectory inbox))) | |
363 | (if movemail | |
364 | ;; On some systems, /usr/spool/mail/foo is a directory | |
365 | ;; and the actual inbox is /usr/spool/mail/foo/foo. | |
366 | (if (file-directory-p inbox) | |
367 | (setq inbox (expand-file-name (user-login-name) inbox)))) | |
368 | (if popmail | |
369 | (message "Getting mail from post office ...") | |
370 | (if (or (and (file-exists-p tofile) | |
371 | (/= 0 (nth 7 (file-attributes tofile)))) | |
372 | (and (file-exists-p inbox) | |
373 | (/= 0 (nth 7 (file-attributes inbox))))) | |
374 | (message "Getting mail from %s..." inbox))) | |
375 | ;; Set TOFILE if have not already done so, and | |
376 | ;; rename or copy the file INBOX to TOFILE if and as appropriate. | |
377 | (cond ((or (file-exists-p tofile) (and (not popmail) | |
378 | (not (file-exists-p inbox)))) | |
379 | nil) | |
380 | ((and (not movemail) (not popmail)) | |
381 | ;; Try copying. If that fails (perhaps no space), | |
382 | ;; rename instead. | |
383 | (condition-case nil | |
384 | (copy-file inbox tofile nil) | |
385 | (error | |
386 | ;; Third arg is t so we can replace existing file TOFILE. | |
387 | (rename-file inbox tofile t))) | |
388 | ;; Make the real inbox file empty. | |
389 | ;; Leaving it deleted could cause lossage | |
390 | ;; because mailers often won't create the file. | |
391 | (condition-case () | |
392 | (write-region (point) (point) inbox) | |
393 | (file-error nil))) | |
394 | (t | |
395 | (unwind-protect | |
396 | (save-excursion | |
397 | (setq errors (generate-new-buffer " *nnmail loss*")) | |
398 | (buffer-disable-undo errors) | |
399 | (call-process | |
400 | (expand-file-name nnmail-movemail-program exec-directory) | |
401 | nil errors nil inbox tofile) | |
402 | (if (not (buffer-modified-p errors)) | |
403 | ;; No output => movemail won | |
404 | nil | |
405 | (set-buffer errors) | |
406 | (subst-char-in-region (point-min) (point-max) ?\n ?\ ) | |
407 | (goto-char (point-max)) | |
408 | (skip-chars-backward " \t") | |
409 | (delete-region (point) (point-max)) | |
410 | (goto-char (point-min)) | |
411 | (if (looking-at "movemail: ") | |
412 | (delete-region (point-min) (match-end 0))) | |
413 | (beep t) | |
414 | (message (concat "movemail: " | |
415 | (buffer-substring (point-min) | |
416 | (point-max)))) | |
417 | (sit-for 3) | |
418 | nil))))) | |
419 | (and errors | |
420 | (buffer-name errors) | |
421 | (kill-buffer errors)) | |
422 | tofile)) | |
423 | ||
424 | ||
425 | (defun nnmail-get-active () | |
426 | "Returns an assoc of group names and active ranges. | |
427 | nn*-request-list should have been called before calling this function." | |
428 | (let (group-assoc) | |
429 | ;; Go through all groups from the active list. | |
430 | (save-excursion | |
431 | (set-buffer nntp-server-buffer) | |
432 | (goto-char (point-min)) | |
433 | (while (re-search-forward | |
434 | "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) | |
435 | (setq group-assoc | |
436 | (cons (list (buffer-substring (match-beginning 1) | |
437 | (match-end 1)) | |
438 | (cons (string-to-int | |
439 | (buffer-substring (match-beginning 3) | |
440 | (match-end 3))) | |
441 | (string-to-int | |
442 | (buffer-substring (match-beginning 2) | |
443 | (match-end 2))))) | |
444 | group-assoc)))) | |
445 | ||
446 | ;; ;; In addition, add all groups mentioned in `nnmail-split-methods'. | |
447 | ;; (let ((methods (and (not (symbolp nnmail-split-methods)) | |
448 | ;; nnmail-split-methods))) | |
449 | ;; (while methods | |
450 | ;; (if (not (assoc (car (car methods)) group-assoc)) | |
451 | ;; (setq group-assoc | |
452 | ;; (cons (list (car (car methods)) (cons 1 0)) | |
453 | ;; group-assoc))) | |
454 | ;; (setq methods (cdr methods))) | |
455 | ||
456 | group-assoc)) | |
457 | ||
458 | (defun nnmail-save-active (group-assoc file-name) | |
459 | (let (group) | |
460 | (save-excursion | |
461 | (set-buffer (get-buffer-create " *nnmail active*")) | |
462 | (buffer-disable-undo (current-buffer)) | |
463 | (erase-buffer) | |
464 | (while group-assoc | |
465 | (setq group (car group-assoc)) | |
466 | (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) | |
467 | (car (car (cdr group))))) | |
468 | (setq group-assoc (cdr group-assoc))) | |
469 | (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) | |
470 | (kill-buffer (current-buffer))))) | |
471 | ||
472 | (defun nnmail-get-split-group (file group) | |
473 | (if (or (eq nnmail-spool-file 'procmail) | |
474 | nnmail-use-procmail) | |
475 | (cond (group group) | |
476 | ((string-match (concat "^" (expand-file-name | |
477 | (file-name-as-directory | |
478 | nnmail-procmail-directory)) | |
479 | "\\(.*\\)" nnmail-procmail-suffix "$") | |
480 | (expand-file-name file)) | |
481 | (substring (expand-file-name file) | |
482 | (match-beginning 1) (match-end 1))) | |
483 | (t | |
484 | group)) | |
485 | group)) | |
486 | ||
487 | (defun nnmail-split-incoming (incoming func &optional dont-kill group) | |
488 | "Go through the entire INCOMING file and pick out each individual mail. | |
489 | FUNC will be called with the buffer narrowed to each mail." | |
490 | (let ((delim (concat "^" rmail-unix-mail-delimiter)) | |
491 | ;; If this is a group-specific split, we bind the split | |
492 | ;; methods to just this group. | |
493 | (nnmail-split-methods (if (and group | |
494 | (or (eq nnmail-spool-file 'procmail) | |
495 | nnmail-use-procmail) | |
496 | (not nnmail-resplit-incoming)) | |
497 | (list (list group "")) | |
498 | nnmail-split-methods)) | |
499 | start end content-length do-search message-id) | |
500 | (save-excursion | |
501 | ;; Open the message-id cache. | |
502 | (nnmail-cache-open) | |
503 | ;; Insert the incoming file. | |
504 | (set-buffer (get-buffer-create " *nnmail incoming*")) | |
505 | (buffer-disable-undo (current-buffer)) | |
506 | (erase-buffer) | |
507 | (insert-file-contents incoming) | |
508 | (goto-char (point-min)) | |
509 | (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) | |
510 | ;; Go to the beginning of the first mail... | |
511 | (if (and (re-search-forward delim nil t) | |
512 | (goto-char (match-beginning 0))) | |
513 | ;; and then carry on until the bitter end. | |
514 | (while (not (eobp)) | |
515 | (setq start (point)) | |
516 | ;; Skip all the headers in case there are more "From "s... | |
517 | (if (not (search-forward "\n\n" nil t)) | |
518 | (forward-line 1)) | |
519 | ;; Find the Message-ID header. | |
520 | (save-excursion | |
521 | (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) | |
522 | (setq message-id (buffer-substring (match-beginning 1) | |
523 | (match-end 1))) | |
524 | ;; There is no Message-ID here, so we create one. | |
525 | (forward-line -1) | |
526 | (insert "Message-ID: " (setq message-id (nnmail-message-id)) | |
527 | "\n"))) | |
528 | ;; Look for a Content-Length header. | |
529 | (if (not (save-excursion | |
530 | (and (re-search-backward | |
531 | "^Content-Length: \\([0-9]+\\)" start t) | |
532 | (setq content-length (string-to-int | |
533 | (buffer-substring | |
534 | (match-beginning 1) | |
535 | (match-end 1)))) | |
536 | ;; We destroy the header, since none of | |
537 | ;; the backends ever use it, and we do not | |
538 | ;; want to confuse other mailers by having | |
539 | ;; a (possibly) faulty header. | |
540 | (progn (insert "X-") t)))) | |
541 | (setq do-search t) | |
542 | (if (or (= (+ (point) content-length) (point-max)) | |
543 | (save-excursion | |
544 | (goto-char (+ (point) content-length)) | |
545 | (looking-at delim))) | |
546 | (progn | |
547 | (goto-char (+ (point) content-length)) | |
548 | (setq do-search nil)) | |
549 | (setq do-search t))) | |
550 | ;; Go to the beginning of the next article - or to the end | |
551 | ;; of the buffer. | |
552 | (if do-search | |
553 | (if (re-search-forward delim nil t) | |
554 | (goto-char (match-beginning 0)) | |
555 | (goto-char (point-max)))) | |
556 | (save-excursion | |
557 | (save-restriction | |
558 | (narrow-to-region start (point)) | |
559 | (goto-char (point-min)) | |
560 | ;; If this is a duplicate message, then we do not save it. | |
561 | (if (nnmail-cache-id-exists-p message-id) | |
562 | (delete-region (point-min) (point-max)) | |
563 | (nnmail-cache-insert message-id) | |
564 | (funcall func)) | |
565 | (setq end (point-max)))) | |
566 | (goto-char end))) | |
567 | ;; Close the message-id cache. | |
568 | (nnmail-cache-close) | |
569 | (if dont-kill | |
570 | (current-buffer) | |
571 | (kill-buffer (current-buffer)))))) | |
572 | ||
573 | ;; Mail crossposts syggested by Brian Edmonds <edmonds@cs.ubc.ca>. | |
574 | (defun nnmail-article-group (func) | |
575 | "Look at the headers and return an alist of groups that match. | |
576 | FUNC will be called with the group name to determine the article number." | |
577 | (let ((methods nnmail-split-methods) | |
578 | (obuf (current-buffer)) | |
579 | (beg (point-min)) | |
580 | end group-art) | |
581 | (if (and (sequencep methods) (= (length methods) 1)) | |
582 | ;; If there is only just one group to put everything in, we | |
583 | ;; just return a list with just this one method in. | |
584 | (setq group-art | |
585 | (list (cons (car (car methods)) | |
586 | (funcall func (car (car methods)))))) | |
587 | ;; We do actual comparison. | |
588 | (save-excursion | |
589 | ;; Find headers. | |
590 | (goto-char beg) | |
591 | (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) | |
592 | (set-buffer (get-buffer-create " *nnmail work*")) | |
593 | (buffer-disable-undo (current-buffer)) | |
594 | (erase-buffer) | |
595 | ;; Copy the headers into the work buffer. | |
596 | (insert-buffer-substring obuf beg end) | |
597 | ;; Fold continuation lines. | |
598 | (goto-char (point-min)) | |
599 | (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
600 | (replace-match " " t t)) | |
601 | (if (and (symbolp nnmail-split-methods) | |
602 | (fboundp nnmail-split-methods)) | |
603 | (setq group-art | |
604 | (mapcar | |
605 | (lambda (group) (cons group (funcall func group))) | |
606 | (condition-case nil | |
607 | (funcall nnmail-split-methods) | |
608 | (error | |
609 | (message "\ | |
610 | Problems with `nnmail-split-methods', using `bogus' mail group") | |
611 | (sit-for 1) | |
612 | '("bogus"))))) | |
613 | ;; Go throught the split methods to find a match. | |
614 | (while (and methods (or nnmail-crosspost (not group-art))) | |
615 | (goto-char (point-max)) | |
616 | (if (or (cdr methods) | |
617 | (not (equal "" (nth 1 (car methods))))) | |
618 | (if (and (condition-case () | |
619 | (if (stringp (nth 1 (car methods))) | |
620 | (re-search-backward | |
621 | (car (cdr (car methods))) nil t) | |
622 | ;; Suggested by Brian Edmonds | |
623 | ;; <edmonds@cs.ubc.ca>. | |
624 | (funcall (nth 1 (car methods)) | |
625 | (car (car methods)))) | |
626 | (error nil)) | |
627 | ;; Don't enter the article into the same group twice. | |
628 | (not (assoc (car (car methods)) group-art))) | |
629 | (setq group-art | |
630 | (cons (cons (car (car methods)) | |
631 | (funcall func (car (car methods)))) | |
632 | group-art))) | |
633 | (or group-art | |
634 | (setq group-art | |
635 | (list (cons (car (car methods)) | |
636 | (funcall func (car (car methods)))))))) | |
637 | (setq methods (cdr methods)))) | |
638 | (kill-buffer (current-buffer)) | |
639 | group-art)))) | |
640 | ||
641 | (defun nnmail-insert-lines () | |
642 | "Insert how many lines and chars there are in the body of the mail." | |
643 | (let (lines chars) | |
644 | (save-excursion | |
645 | (goto-char (point-min)) | |
646 | (if (search-forward "\n\n" nil t) | |
647 | (progn | |
648 | (setq chars (- (point-max) (point))) | |
649 | (setq lines (- (count-lines (point) (point-max)) 1)) | |
650 | (forward-char -1) | |
651 | (save-excursion | |
652 | (if (re-search-backward "^Lines: " nil t) | |
653 | (delete-region (point) (progn (forward-line 1) (point))))) | |
654 | (insert (format "Lines: %d\n" lines)) | |
655 | chars))))) | |
656 | ||
657 | (defun nnmail-insert-xref (group-alist) | |
658 | "Insert an Xref line based on the (group . article) alist." | |
659 | (save-excursion | |
660 | (goto-char (point-min)) | |
661 | (if (search-forward "\n\n" nil t) | |
662 | (progn | |
663 | (forward-char -1) | |
664 | (if (re-search-backward "^Xref: " nil t) | |
665 | (delete-region (match-beginning 0) | |
666 | (progn (forward-line 1) (point)))) | |
667 | (insert (format "Xref: %s" (system-name))) | |
668 | (while group-alist | |
669 | (insert (format " %s:%d" (car (car group-alist)) | |
670 | (cdr (car group-alist)))) | |
671 | (setq group-alist (cdr group-alist))) | |
672 | (insert "\n"))))) | |
673 | ||
674 | ;; Written by byer@mv.us.adobe.com (Scott Byer). | |
675 | (defun nnmail-make-complex-temp-name (prefix) | |
676 | (let ((newname (make-temp-name prefix)) | |
677 | (newprefix prefix)) | |
678 | (while (file-exists-p newname) | |
679 | (setq newprefix (concat newprefix "x")) | |
680 | (setq newname (make-temp-name newprefix))) | |
681 | newname)) | |
682 | ||
683 | ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>. | |
684 | ||
685 | (defun nnmail-split-fancy () | |
686 | "Fancy splitting method. | |
687 | See the documentation for the variable `nnmail-split-fancy' for documentation." | |
688 | (nnmail-split-it nnmail-split-fancy)) | |
689 | ||
690 | (defvar nnmail-split-cache nil) | |
691 | ;; Alist of split expresions their equivalent regexps. | |
692 | ||
693 | (defun nnmail-split-it (split) | |
694 | ;; Return a list of groups matching SPLIT. | |
695 | (cond ((stringp split) | |
696 | ;; A group. | |
697 | (list split)) | |
698 | ((eq (car split) '&) | |
699 | (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) | |
700 | ((eq (car split) '|) | |
701 | (let (done) | |
702 | (while (and (not done) (cdr split)) | |
703 | (setq split (cdr split) | |
704 | done (nnmail-split-it (car split)))) | |
705 | done)) ((assq split nnmail-split-cache) | |
706 | ;; A compiled match expression. | |
707 | (goto-char (point-max)) | |
708 | (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) | |
709 | (nnmail-split-it (nth 2 split)))) | |
710 | (t | |
711 | ;; An uncompiled match. | |
712 | (let* ((field (nth 0 split)) | |
713 | (value (nth 1 split)) | |
714 | (regexp (concat "^\\(" | |
715 | (if (symbolp field) | |
716 | (cdr (assq field | |
717 | nnmail-split-abbrev-alist)) | |
718 | field) | |
719 | "\\):.*\\<\\(" | |
720 | (if (symbolp value) | |
721 | (cdr (assq value | |
722 | nnmail-split-abbrev-alist)) | |
723 | value) | |
724 | "\\>\\)"))) | |
725 | (setq nnmail-split-cache | |
726 | (cons (cons split regexp) nnmail-split-cache)) | |
727 | (goto-char (point-max)) | |
728 | (if (re-search-backward regexp nil t) | |
729 | (nnmail-split-it (nth 2 split))))))) | |
730 | ||
731 | ;; Get a list of spool files to read. | |
732 | (defun nnmail-get-spool-files (&optional group) | |
733 | (if (null nnmail-spool-file) | |
734 | ;; No spool file whatsoever. | |
735 | nil) | |
736 | (let* ((procmails | |
737 | ;; If procmail is used to get incoming mail, the files | |
738 | ;; are stored in this directory. | |
739 | (and (file-exists-p nnmail-procmail-directory) | |
740 | (directory-files | |
741 | nnmail-procmail-directory | |
742 | t (concat (if group group "") | |
743 | nnmail-procmail-suffix "$") t))) | |
744 | (p procmails)) | |
745 | ;; Remove any directories that inadvertantly match the procmail | |
746 | ;; suffix, which might happen if the suffix is "". | |
747 | (while p | |
748 | (and (or (file-directory-p (car p)) | |
749 | (file-symlink-p (car p))) | |
750 | (setq procmails (delete (car p) procmails))) | |
751 | (setq p (cdr p))) | |
752 | (cond ((listp nnmail-spool-file) | |
753 | (append nnmail-spool-file procmails)) | |
754 | ((stringp nnmail-spool-file) | |
755 | (cons nnmail-spool-file procmails)) | |
756 | (t | |
757 | procmails)))) | |
758 | ||
759 | ;; Activate a backend only if it isn't already activated. | |
760 | ;; If FORCE, re-read the active file even if the backend is | |
761 | ;; already activated. | |
762 | (defun nnmail-activate (backend &optional force) | |
763 | (let (file timestamp file-time) | |
764 | (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) | |
765 | force | |
766 | (and (setq file (condition-case () | |
767 | (symbol-value (intern (format "%s-active-file" | |
768 | backend))) | |
769 | (error nil))) | |
770 | (setq file-time (nth 5 (file-attributes file))) | |
771 | (or (not | |
772 | (setq timestamp | |
773 | (condition-case () | |
774 | (symbol-value (intern | |
775 | (format "%s-active-timestamp" | |
776 | backend))) | |
777 | (error 'none)))) | |
778 | (not (consp timestamp)) | |
779 | (equal timestamp '(0 0)) | |
780 | (> (nth 0 file-time) (nth 0 timestamp)) | |
781 | (and (= (nth 0 file-time) (nth 0 timestamp)) | |
782 | (> (nth 1 file-time) (nth 1 timestamp)))))) | |
783 | (save-excursion | |
784 | (or (eq timestamp 'none) | |
785 | (set (intern (format "%s-active-timestamp" backend)) | |
786 | (current-time))) | |
787 | (funcall (intern (format "%s-request-list" backend))) | |
788 | (set (intern (format "%s-group-alist" backend)) | |
789 | (nnmail-get-active)))) | |
790 | t)) | |
791 | ||
792 | (defun nnmail-message-id () | |
793 | (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>")) | |
794 | ||
795 | (defvar nnmail-unique-id-char nil) | |
796 | ||
797 | (defun nnmail-number-base36 (num len) | |
798 | (if (if (< len 0) (<= num 0) (= len 0)) | |
799 | "" | |
800 | (concat (nnmail-number-base36 (/ num 36) (1- len)) | |
801 | (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" | |
802 | (% num 36)))))) | |
803 | ||
804 | (defun nnmail-unique-id () | |
805 | (setq nnmail-unique-id-char | |
806 | (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20))))) | |
807 | ;; (current-time) returns 16-bit ints, | |
808 | ;; and 2^16*25 just fits into 4 digits i base 36. | |
809 | (* 25 25))) | |
810 | (let ((tm (if (fboundp 'current-time) | |
811 | (current-time) '(12191 46742 287898)))) | |
812 | (concat | |
813 | (nnmail-number-base36 (+ (car tm) | |
814 | (lsh (% nnmail-unique-id-char 25) 16)) 4) | |
815 | (nnmail-number-base36 (+ (nth 1 tm) | |
816 | (lsh (/ nnmail-unique-id-char 25) 16)) 4)))) | |
817 | ||
818 | ;;; | |
819 | ;;; nnmail duplicate handling | |
820 | ;;; | |
821 | ||
822 | (defvar nnmail-cache-buffer nil) | |
823 | ||
824 | (defun nnmail-cache-open () | |
825 | (if (or (not nnmail-delete-duplicates) | |
826 | (and nnmail-cache-buffer | |
827 | (buffer-name nnmail-cache-buffer))) | |
828 | () ; The buffer is open. | |
829 | (save-excursion | |
830 | (set-buffer | |
831 | (setq nnmail-cache-buffer | |
832 | (get-buffer-create " *nnmail message-id cache*"))) | |
833 | (buffer-disable-undo (current-buffer)) | |
834 | (and (file-exists-p nnmail-message-id-cache-file) | |
835 | (insert-file-contents nnmail-message-id-cache-file)) | |
836 | (current-buffer)))) | |
837 | ||
838 | (defun nnmail-cache-close () | |
839 | (if (or (not nnmail-cache-buffer) | |
840 | (not nnmail-delete-duplicates) | |
841 | (not (buffer-name nnmail-cache-buffer)) | |
842 | (not (buffer-modified-p nnmail-cache-buffer))) | |
843 | () ; The buffer is closed. | |
844 | (save-excursion | |
845 | (set-buffer nnmail-cache-buffer) | |
846 | ;; Weed out the excess number of Message-IDs. | |
847 | (goto-char (point-max)) | |
848 | (and (search-backward "\n" nil t nnmail-message-id-cache-length) | |
849 | (progn | |
850 | (beginning-of-line) | |
851 | (delete-region (point-min) (point)))) | |
852 | ;; Save the buffer. | |
853 | (or (file-exists-p (file-name-directory nnmail-message-id-cache-file)) | |
854 | (make-directory (file-name-directory nnmail-message-id-cache-file) | |
855 | t)) | |
856 | (write-region (point-min) (point-max) | |
857 | nnmail-message-id-cache-file nil 'silent) | |
858 | (set-buffer-modified-p nil)))) | |
859 | ||
860 | (defun nnmail-cache-insert (id) | |
861 | (and nnmail-delete-duplicates | |
862 | (save-excursion | |
863 | (set-buffer nnmail-cache-buffer) | |
864 | (goto-char (point-max)) | |
865 | (insert id "\n")))) | |
866 | ||
867 | (defun nnmail-cache-id-exists-p (id) | |
868 | (and nnmail-delete-duplicates | |
869 | (save-excursion | |
870 | (set-buffer nnmail-cache-buffer) | |
871 | (goto-char (point-max)) | |
872 | (search-backward id nil t)))) | |
873 | ||
874 | ||
875 | (provide 'nnmail) | |
876 | ||
877 | ;;; nnmail.el ends here |