|
0
|
1 ;;; nnmail.el --- mail support functions for the Gnus mail backends
|
|
|
2 ;; Copyright (C) 1995,96 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 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)
|
|
|
31 (eval-when-compile (require 'cl))
|
|
|
32
|
|
|
33 (defvar nnmail-split-methods
|
|
|
34 '(("mail.misc" ""))
|
|
|
35 "*Incoming mail will be split according to this variable.
|
|
|
36
|
|
|
37 If you'd like, for instance, one mail group for mail from the
|
|
|
38 \"4ad-l\" mailing list, one group for junk mail and one for everything
|
|
|
39 else, you could do something like this:
|
|
|
40
|
|
|
41 (setq nnmail-split-methods
|
|
|
42 '((\"mail.4ad\" \"From:.*4ad\")
|
|
|
43 (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
|
|
|
44 (\"mail.misc\" \"\")))
|
|
|
45
|
|
|
46 As you can see, this variable is a list of lists, where the first
|
|
|
47 element in each \"rule\" is the name of the group (which, by the way,
|
|
|
48 does not have to be called anything beginning with \"mail\",
|
|
|
49 \"yonka.zow\" is a fine, fine name), and the second is a regexp that
|
|
|
50 nnmail will try to match on the header to find a fit.
|
|
|
51
|
|
|
52 The second element can also be a function. In that case, it will be
|
|
|
53 called narrowed to the headers with the first element of the rule as
|
|
|
54 the argument. It should return a non-nil value if it thinks that the
|
|
|
55 mail belongs in that group.
|
|
|
56
|
|
|
57 The last element should always have \"\" as the regexp.
|
|
|
58
|
|
|
59 This variable can also have a function as its value.")
|
|
|
60
|
|
|
61 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
|
62 (defvar nnmail-crosspost t
|
|
|
63 "*If non-nil, do crossposting if several split methods match the mail.
|
|
|
64 If nil, the first match found will be used.")
|
|
|
65
|
|
|
66 ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
|
|
|
67 (defvar nnmail-keep-last-article nil
|
|
|
68 "*If non-nil, nnmail will never delete the last expired article in a directory.
|
|
|
69 You may need to set this variable if other programs are putting
|
|
|
70 new mail into folder numbers that Gnus has marked as expired.")
|
|
|
71
|
|
|
72 (defvar nnmail-use-long-file-names nil
|
|
|
73 "*If non-nil the mail backends will use long file and directory names.
|
|
|
74 If nil, groups like \"mail.misc\" will end up in directories like
|
|
|
75 \"mail/misc/\".")
|
|
|
76
|
|
|
77 (defvar nnmail-expiry-wait 7
|
|
|
78 "*Expirable articles that are older than this will be expired.
|
|
|
79 This variable can either be a number (which will be interpreted as a
|
|
|
80 number of days) -- this doesn't have to be an integer. This variable
|
|
|
81 can also be `immediate' and `never'.")
|
|
|
82
|
|
|
83 (defvar nnmail-expiry-wait-function nil
|
|
|
84 "*Variable that holds function to specify how old articles should be before they are expired.
|
|
|
85 The function will be called with the name of the group that the
|
|
|
86 expiry is to be performed in, and it should return an integer that
|
|
|
87 says how many days an article can be stored before it is considered
|
|
|
88 \"old\". It can also return the values `never' and `immediate'.
|
|
|
89
|
|
|
90 Eg.:
|
|
|
91
|
|
|
92 (setq nnmail-expiry-wait-function
|
|
|
93 (lambda (newsgroup)
|
|
|
94 (cond ((string-match \"private\" newsgroup) 31)
|
|
|
95 ((string-match \"junk\" newsgroup) 1)
|
|
|
96 ((string-match \"important\" newsgroup) 'never)
|
|
|
97 (t 7))))")
|
|
|
98
|
|
|
99 (defvar nnmail-spool-file
|
|
|
100 (or (getenv "MAIL")
|
|
|
101 (concat "/usr/spool/mail/" (user-login-name)))
|
|
|
102 "Where the mail backends will look for incoming mail.
|
|
|
103 This variable is \"/usr/spool/mail/$user\" by default.
|
|
|
104 If this variable is nil, no mail backends will read incoming mail.
|
|
|
105 If this variable is a list, all files mentioned in this list will be
|
|
|
106 used as incoming mailboxes.")
|
|
|
107
|
|
|
108 (defvar nnmail-crash-box "~/.gnus-crash-box"
|
|
|
109 "*File where Gnus will store mail while processing it.")
|
|
|
110
|
|
|
111 (defvar nnmail-use-procmail nil
|
|
|
112 "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
|
|
|
113 The file(s) in `nnmail-spool-file' will also be read.")
|
|
|
114
|
|
|
115 (defvar nnmail-procmail-directory "~/incoming/"
|
|
|
116 "*When using procmail (and the like), incoming mail is put in this directory.
|
|
|
117 The Gnus mail backends will read the mail from this directory.")
|
|
|
118
|
|
|
119 (defvar nnmail-procmail-suffix "\\.spool"
|
|
|
120 "*Suffix of files created by procmail (and the like).
|
|
|
121 This variable might be a suffix-regexp to match the suffixes of
|
|
|
122 several files - eg. \".spool[0-9]*\".")
|
|
|
123
|
|
|
124 (defvar nnmail-resplit-incoming nil
|
|
|
125 "*If non-nil, re-split incoming procmail sorted mail.")
|
|
|
126
|
|
|
127 (defvar nnmail-delete-file-function 'delete-file
|
|
|
128 "Function called to delete files in some mail backends.")
|
|
|
129
|
|
|
130 (defvar nnmail-crosspost-link-function 'add-name-to-file
|
|
|
131 "Function called to create a copy of a file.
|
|
|
132 This is `add-name-to-file' by default, which means that crossposts
|
|
|
133 will use hard links. If your file system doesn't allow hard
|
|
|
134 links, you could set this variable to `copy-file' instead.")
|
|
|
135
|
|
|
136 (defvar nnmail-movemail-program "movemail"
|
|
|
137 "*A command to be executed to move mail from the inbox.
|
|
|
138 The default is \"movemail\".")
|
|
|
139
|
|
|
140 (defvar nnmail-pop-password-required nil
|
|
|
141 "*Non-nil if a password is required when reading mail using POP.")
|
|
|
142
|
|
|
143 (defvar nnmail-read-incoming-hook nil
|
|
|
144 "*Hook that will be run after the incoming mail has been transferred.
|
|
|
145 The incoming mail is moved from `nnmail-spool-file' (which normally is
|
|
|
146 something like \"/usr/spool/mail/$user\") to the user's home
|
|
|
147 directory. This hook is called after the incoming mail box has been
|
|
|
148 emptied, and can be used to call any mail box programs you have
|
|
|
149 running (\"xwatch\", etc.)
|
|
|
150
|
|
|
151 Eg.
|
|
|
152
|
|
|
153 \(add-hook 'nnmail-read-incoming-hook
|
|
|
154 (lambda ()
|
|
|
155 (start-process \"mailsend\" nil
|
|
|
156 \"/local/bin/mailsend\" \"read\" \"mbox\")))
|
|
|
157
|
|
|
158 If you have xwatch running, this will alert it that mail has been
|
|
|
159 read.
|
|
|
160
|
|
|
161 If you use `display-time', you could use something like this:
|
|
|
162
|
|
|
163 \(add-hook 'nnmail-read-incoming-hook
|
|
|
164 (lambda ()
|
|
|
165 ;; Update the displayed time, since that will clear out
|
|
|
166 ;; the flag that says you have mail.
|
|
|
167 (if (eq (process-status \"display-time\") 'run)
|
|
|
168 (display-time-filter display-time-process \"\"))))")
|
|
|
169
|
|
|
170 (when (eq system-type 'windows-nt)
|
|
|
171 (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr))
|
|
|
172
|
|
|
173 ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
|
|
|
174 (defvar nnmail-prepare-incoming-hook nil
|
|
|
175 "*Hook called before treating incoming mail.
|
|
|
176 The hook is run in a buffer with all the new, incoming mail.")
|
|
|
177
|
|
|
178 (defvar nnmail-pre-get-new-mail-hook nil
|
|
|
179 "Hook called just before starting to handle new incoming mail.")
|
|
|
180
|
|
|
181 (defvar nnmail-post-get-new-mail-hook nil
|
|
|
182 "Hook called just after finishing handling new incoming mail.")
|
|
|
183
|
|
|
184 ;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
|
|
|
185 (defvar nnmail-tmp-directory nil
|
|
|
186 "*If non-nil, use this directory for temporary storage when reading incoming mail.")
|
|
|
187
|
|
|
188 (defvar nnmail-large-newsgroup 50
|
|
|
189 "*The number of the articles which indicates a large newsgroup.
|
|
|
190 If the number of the articles is greater than the value, verbose
|
|
|
191 messages will be shown to indicate the current status.")
|
|
|
192
|
|
|
193 (defvar nnmail-split-fancy "mail.misc"
|
|
|
194 "*Incoming mail can be split according to this fancy variable.
|
|
|
195 To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
|
|
|
196
|
|
|
197 The format is this variable is SPLIT, where SPLIT can be one of
|
|
|
198 the following:
|
|
|
199
|
|
|
200 GROUP: Mail will be stored in GROUP (a string).
|
|
|
201
|
|
|
202 \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
|
|
|
203 VALUE (a regexp), store the messages as specified by SPLIT.
|
|
|
204
|
|
|
205 \(| SPLIT...): Process each SPLIT expression until one of them matches.
|
|
|
206 A SPLIT expression is said to match if it will cause the mail
|
|
|
207 message to be stored in one or more groups.
|
|
|
208
|
|
|
209 \(& SPLIT...): Process each SPLIT expression.
|
|
|
210
|
|
|
211 FIELD must match a complete field name. VALUE must match a complete
|
|
|
212 word according to the `nnmail-split-fancy-syntax-table' syntax table.
|
|
|
213 You can use .* in the regexps to match partial field names or words.
|
|
|
214
|
|
|
215 FIELD and VALUE can also be lisp symbols, in that case they are expanded
|
|
|
216 as specified in `nnmail-split-abbrev-alist'.
|
|
|
217
|
|
|
218 Example:
|
|
|
219
|
|
|
220 \(setq nnmail-split-methods 'nnmail-split-fancy
|
|
|
221 nnmail-split-fancy
|
|
|
222 ;; Messages from the mailer deamon are not crossposted to any of
|
|
|
223 ;; the ordinary groups. Warnings are put in a separate group
|
|
|
224 ;; from real errors.
|
|
|
225 '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
|
|
|
226 \"mail.misc\"))
|
|
|
227 ;; Non-error messages are crossposted to all relevant
|
|
|
228 ;; groups, but we don't crosspost between the group for the
|
|
|
229 ;; (ding) list and the group for other (ding) related mail.
|
|
|
230 (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
|
|
|
231 (\"subject\" \"ding\" \"ding.misc\"))
|
|
|
232 ;; Other mailing lists...
|
|
|
233 (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
|
|
|
234 (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
|
|
|
235 ;; People...
|
|
|
236 (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
|
|
|
237 ;; Unmatched mail goes to the catch all group.
|
|
|
238 \"misc.misc\"))")
|
|
|
239
|
|
|
240 (defvar nnmail-split-abbrev-alist
|
|
|
241 '((any . "from\\|to\\|cc\\|sender\\|apparently-to")
|
|
|
242 (mail . "mailer-daemon\\|postmaster"))
|
|
|
243 "*Alist of abbreviations allowed in `nnmail-split-fancy'.")
|
|
|
244
|
|
|
245 (defvar nnmail-delete-incoming t
|
|
|
246 "*If non-nil, the mail backends will delete incoming files after splitting.")
|
|
|
247
|
|
|
248 (defvar nnmail-message-id-cache-length 1000
|
|
|
249 "*The approximate number of Message-IDs nnmail will keep in its cache.
|
|
|
250 If this variable is nil, no checking on duplicate messages will be
|
|
|
251 performed.")
|
|
|
252
|
|
|
253 (defvar nnmail-message-id-cache-file "~/.nnmail-cache"
|
|
|
254 "*The file name of the nnmail Message-ID cache.")
|
|
|
255
|
|
|
256 (defvar nnmail-treat-duplicates 'warn
|
|
|
257 "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
|
|
|
258 Three values are legal: nil, which means that nnmail is not to keep a
|
|
|
259 Message-ID cache; `warn', which means that nnmail should insert extra
|
|
|
260 headers to warn the user about the duplication (this is the default);
|
|
|
261 and `delete', which means that nnmail will delete duplicated mails.
|
|
|
262
|
|
|
263 This variable can also be a function. It will be called from a buffer
|
|
|
264 narrowed to the article in question with the Message-ID as a
|
|
|
265 parameter. It should return nil, `warn' or `delete'.")
|
|
|
266
|
|
|
267 ;;; Internal variables.
|
|
|
268
|
|
|
269 (defvar nnmail-pop-password nil
|
|
|
270 "*Password to use when reading mail from a POP server, if required.")
|
|
|
271
|
|
|
272 (defvar nnmail-split-fancy-syntax-table
|
|
|
273 (copy-syntax-table (standard-syntax-table))
|
|
|
274 "Syntax table used by `nnmail-split-fancy'.")
|
|
|
275
|
|
|
276 (defvar nnmail-prepare-save-mail-hook nil
|
|
|
277 "Hook called before saving mail.")
|
|
|
278
|
|
|
279 (defvar nnmail-moved-inboxes nil
|
|
|
280 "List of inboxes that have been moved.")
|
|
|
281
|
|
|
282 (defvar nnmail-internal-password nil)
|
|
|
283
|
|
|
284
|
|
|
285
|
|
|
286 (defconst nnmail-version "nnmail 1.0"
|
|
|
287 "nnmail version.")
|
|
|
288
|
|
|
289
|
|
|
290
|
|
|
291 (defun nnmail-request-post (&optional server)
|
|
|
292 (mail-send-and-exit nil))
|
|
|
293
|
|
|
294 (defun nnmail-find-file (file)
|
|
|
295 "Insert FILE in server buffer safely."
|
|
|
296 (set-buffer nntp-server-buffer)
|
|
|
297 (erase-buffer)
|
|
|
298 (let ((format-alist nil)
|
|
|
299 (after-insert-file-functions nil))
|
|
|
300 (condition-case ()
|
|
|
301 (progn (insert-file-contents file) t)
|
|
|
302 (file-error nil))))
|
|
|
303
|
|
|
304 (defun nnmail-group-pathname (group dir &optional file)
|
|
|
305 "Make pathname for GROUP."
|
|
|
306 (concat
|
|
|
307 (let ((dir (file-name-as-directory (expand-file-name dir))))
|
|
|
308 ;; If this directory exists, we use it directly.
|
|
|
309 (if (or nnmail-use-long-file-names
|
|
|
310 (file-directory-p (concat dir group)))
|
|
|
311 (concat dir group "/")
|
|
|
312 ;; If not, we translate dots into slashes.
|
|
|
313 (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/")))
|
|
|
314 (or file "")))
|
|
|
315
|
|
|
316 (defun nnmail-date-to-time (date)
|
|
|
317 "Convert DATE into time."
|
|
|
318 (let* ((d1 (timezone-parse-date date))
|
|
|
319 (t1 (timezone-parse-time (aref d1 3))))
|
|
|
320 (apply 'encode-time
|
|
|
321 (mapcar (lambda (el)
|
|
|
322 (and el (string-to-number el)))
|
|
|
323 (list
|
|
|
324 (aref t1 2) (aref t1 1) (aref t1 0)
|
|
|
325 (aref d1 2) (aref d1 1) (aref d1 0)
|
|
|
326 (aref d1 4))))))
|
|
|
327
|
|
|
328 (defun nnmail-time-less (t1 t2)
|
|
|
329 "Say whether time T1 is less than time T2."
|
|
|
330 (or (< (car t1) (car t2))
|
|
|
331 (and (= (car t1) (car t2))
|
|
|
332 (< (nth 1 t1) (nth 1 t2)))))
|
|
|
333
|
|
|
334 (defun nnmail-days-to-time (days)
|
|
|
335 "Convert DAYS into time."
|
|
|
336 (let* ((seconds (* 1.0 days 60 60 24))
|
|
|
337 (rest (expt 2 16))
|
|
|
338 (ms (condition-case nil (round (/ seconds rest))
|
|
|
339 (range-error (expt 2 16)))))
|
|
|
340 (list ms (condition-case nil (round (- seconds (* ms rest)))
|
|
|
341 (range-error (expt 2 16))))))
|
|
|
342
|
|
|
343 (defun nnmail-time-since (time)
|
|
|
344 "Return the time since TIME, which is either an internal time or a date."
|
|
|
345 (when (stringp time)
|
|
|
346 ;; Convert date strings to internal time.
|
|
|
347 (setq time (nnmail-date-to-time time)))
|
|
|
348 (let* ((current (current-time))
|
|
|
349 (rest (if (< (nth 1 current) (nth 1 time)) (expt 2 16))))
|
|
|
350 (list (- (+ (car current) (if rest -1 0)) (car time))
|
|
|
351 (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
|
|
|
352
|
|
|
353 ;; Function rewritten from rmail.el.
|
|
|
354 (defun nnmail-move-inbox (inbox)
|
|
|
355 "Move INBOX to `nnmail-crash-box'."
|
|
|
356 (let ((inbox (file-truename
|
|
|
357 (expand-file-name (substitute-in-file-name inbox))))
|
|
|
358 (tofile (file-truename (expand-file-name
|
|
|
359 (substitute-in-file-name nnmail-crash-box))))
|
|
|
360 movemail popmail errors password)
|
|
|
361 ;; If getting from mail spool directory,
|
|
|
362 ;; use movemail to move rather than just renaming,
|
|
|
363 ;; so as to interlock with the mailer.
|
|
|
364 (unless (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
|
|
|
365 (setq movemail t))
|
|
|
366 (when popmail
|
|
|
367 (setq inbox (file-name-nondirectory inbox)))
|
|
|
368 (when (and movemail
|
|
|
369 ;; On some systems, /usr/spool/mail/foo is a directory
|
|
|
370 ;; and the actual inbox is /usr/spool/mail/foo/foo.
|
|
|
371 (file-directory-p inbox))
|
|
|
372 (setq inbox (expand-file-name (user-login-name) inbox)))
|
|
|
373 (if (member inbox nnmail-moved-inboxes)
|
|
|
374 nil
|
|
|
375 (if popmail
|
|
|
376 (progn
|
|
|
377 (setq nnmail-internal-password nnmail-pop-password)
|
|
|
378 (when (and nnmail-pop-password-required (not nnmail-pop-password))
|
|
|
379 (setq nnmail-internal-password
|
|
|
380 (nnmail-read-passwd
|
|
|
381 (format "Password for %s: "
|
|
|
382 (substring inbox (+ popmail 3))))))
|
|
|
383 (message "Getting mail from post office ..."))
|
|
|
384 (when (or (and (file-exists-p tofile)
|
|
|
385 (/= 0 (nth 7 (file-attributes tofile))))
|
|
|
386 (and (file-exists-p inbox)
|
|
|
387 (/= 0 (nth 7 (file-attributes inbox)))))
|
|
|
388 (message "Getting mail from %s..." inbox)))
|
|
|
389 ;; Set TOFILE if have not already done so, and
|
|
|
390 ;; rename or copy the file INBOX to TOFILE if and as appropriate.
|
|
|
391 (cond
|
|
|
392 ((file-exists-p tofile)
|
|
|
393 ;; The crash box exists already.
|
|
|
394 t)
|
|
|
395 ((and (not popmail)
|
|
|
396 (not (file-exists-p inbox)))
|
|
|
397 ;; There is no inbox.
|
|
|
398 (setq tofile nil))
|
|
|
399 ((and (not movemail) (not popmail))
|
|
|
400 ;; Try copying. If that fails (perhaps no space),
|
|
|
401 ;; rename instead.
|
|
|
402 (condition-case nil
|
|
|
403 (copy-file inbox tofile nil)
|
|
|
404 (error
|
|
|
405 ;; Third arg is t so we can replace existing file TOFILE.
|
|
|
406 (rename-file inbox tofile t)))
|
|
|
407 (push inbox nnmail-moved-inboxes)
|
|
|
408 ;; Make the real inbox file empty.
|
|
|
409 ;; Leaving it deleted could cause lossage
|
|
|
410 ;; because mailers often won't create the file.
|
|
|
411 (condition-case ()
|
|
|
412 (write-region (point) (point) inbox)
|
|
|
413 (file-error nil)))
|
|
|
414 (t
|
|
|
415 ;; Use movemail.
|
|
|
416 (unwind-protect
|
|
|
417 (save-excursion
|
|
|
418 (setq errors (generate-new-buffer " *nnmail loss*"))
|
|
|
419 (buffer-disable-undo errors)
|
|
|
420 (let ((default-directory "/"))
|
|
|
421 (apply
|
|
|
422 'call-process
|
|
|
423 (append
|
|
|
424 (list
|
|
|
425 (expand-file-name nnmail-movemail-program exec-directory)
|
|
|
426 nil errors nil inbox tofile)
|
|
|
427 (when nnmail-internal-password
|
|
|
428 (list nnmail-internal-password)))))
|
|
|
429 (if (not (buffer-modified-p errors))
|
|
|
430 ;; No output => movemail won
|
|
|
431 (push inbox nnmail-moved-inboxes)
|
|
|
432 (set-buffer errors)
|
|
|
433 (subst-char-in-region (point-min) (point-max) ?\n ?\ )
|
|
|
434 (goto-char (point-max))
|
|
|
435 (skip-chars-backward " \t")
|
|
|
436 (delete-region (point) (point-max))
|
|
|
437 (goto-char (point-min))
|
|
|
438 (if (looking-at "movemail: ")
|
|
|
439 (delete-region (point-min) (match-end 0)))
|
|
|
440 (beep t)
|
|
|
441 (message (concat "movemail: "
|
|
|
442 (buffer-substring (point-min)
|
|
|
443 (point-max))))
|
|
|
444 (sit-for 3)
|
|
|
445 (setq tofile nil))))))
|
|
|
446 (and errors
|
|
|
447 (buffer-name errors)
|
|
|
448 (kill-buffer errors))
|
|
|
449 tofile)))
|
|
|
450
|
|
|
451 (defun nnmail-get-active ()
|
|
|
452 "Returns an assoc of group names and active ranges.
|
|
|
453 nn*-request-list should have been called before calling this function."
|
|
|
454 (let (group-assoc)
|
|
|
455 ;; Go through all groups from the active list.
|
|
|
456 (save-excursion
|
|
|
457 (set-buffer nntp-server-buffer)
|
|
|
458 (goto-char (point-min))
|
|
|
459 (while (re-search-forward
|
|
|
460 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
|
|
|
461 ;; We create an alist with `(GROUP (LOW . HIGH))' elements.
|
|
|
462 (push (list (match-string 1)
|
|
|
463 (cons (string-to-int (match-string 3))
|
|
|
464 (string-to-int (match-string 2))))
|
|
|
465 group-assoc)))
|
|
|
466 group-assoc))
|
|
|
467
|
|
|
468 (defun nnmail-save-active (group-assoc file-name)
|
|
|
469 "Save GROUP-ASSOC in ACTIVE-FILE."
|
|
|
470 (when file-name
|
|
|
471 (let (group)
|
|
|
472 (save-excursion
|
|
|
473 (set-buffer (get-buffer-create " *nnmail active*"))
|
|
|
474 (buffer-disable-undo (current-buffer))
|
|
|
475 (erase-buffer)
|
|
|
476 (while group-assoc
|
|
|
477 (setq group (pop group-assoc))
|
|
|
478 (insert (format "%s %d %d y\n" (car group) (cdadr group)
|
|
|
479 (caadr group))))
|
|
|
480 (unless (file-exists-p (file-name-directory file-name))
|
|
|
481 (make-directory (file-name-directory file-name) t))
|
|
|
482 (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
|
|
|
483 (kill-buffer (current-buffer))))))
|
|
|
484
|
|
|
485 (defun nnmail-get-split-group (file group)
|
|
|
486 (if (or (eq nnmail-spool-file 'procmail)
|
|
|
487 nnmail-use-procmail)
|
|
|
488 (cond (group group)
|
|
|
489 ((string-match (concat "^" (expand-file-name
|
|
|
490 (file-name-as-directory
|
|
|
491 nnmail-procmail-directory))
|
|
|
492 "\\([^/]*\\)" nnmail-procmail-suffix "$")
|
|
|
493 (expand-file-name file))
|
|
|
494 (substring (expand-file-name file)
|
|
|
495 (match-beginning 1) (match-end 1)))
|
|
|
496 (t
|
|
|
497 group))
|
|
|
498 group))
|
|
|
499
|
|
|
500 (defun nnmail-process-babyl-mail-format (func)
|
|
|
501 (let ((case-fold-search t)
|
|
|
502 start message-id content-length do-search end)
|
|
|
503 (while (not (eobp))
|
|
|
504 (goto-char (point-min))
|
|
|
505 (re-search-forward
|
|
|
506 " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
|
|
|
507 (goto-char (match-end 0))
|
|
|
508 (delete-region (match-beginning 0) (match-end 0))
|
|
|
509 (setq start (point))
|
|
|
510 ;; Skip all the headers in case there are more "From "s...
|
|
|
511 (or (search-forward "\n\n" nil t)
|
|
|
512 (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
|
|
|
513 (search-forward " "))
|
|
|
514 ;; Find the Message-ID header.
|
|
|
515 (save-excursion
|
|
|
516 (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
|
|
|
517 (setq message-id (buffer-substring (match-beginning 1)
|
|
|
518 (match-end 1)))
|
|
|
519 ;; There is no Message-ID here, so we create one.
|
|
|
520 (save-excursion
|
|
|
521 (when (re-search-backward "^Message-ID:" nil t)
|
|
|
522 (beginning-of-line)
|
|
|
523 (insert "Original-")))
|
|
|
524 (forward-line -1)
|
|
|
525 (insert "Message-ID: " (setq message-id (nnmail-message-id))
|
|
|
526 "\n")))
|
|
|
527 ;; Look for a Content-Length header.
|
|
|
528 (if (not (save-excursion
|
|
|
529 (and (re-search-backward
|
|
|
530 "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
|
|
|
531 (setq content-length (string-to-int
|
|
|
532 (buffer-substring
|
|
|
533 (match-beginning 1)
|
|
|
534 (match-end 1))))
|
|
|
535 ;; We destroy the header, since none of
|
|
|
536 ;; the backends ever use it, and we do not
|
|
|
537 ;; want to confuse other mailers by having
|
|
|
538 ;; a (possibly) faulty header.
|
|
|
539 (progn (insert "X-") t))))
|
|
|
540 (setq do-search t)
|
|
|
541 (if (or (= (+ (point) content-length) (point-max))
|
|
|
542 (save-excursion
|
|
|
543 (goto-char (+ (point) content-length))
|
|
|
544 (looking-at " ")))
|
|
|
545 (progn
|
|
|
546 (goto-char (+ (point) content-length))
|
|
|
547 (setq do-search nil))
|
|
|
548 (setq do-search t)))
|
|
|
549 ;; Go to the beginning of the next article - or to the end
|
|
|
550 ;; of the buffer.
|
|
|
551 (if do-search
|
|
|
552 (if (re-search-forward "^ " nil t)
|
|
|
553 (goto-char (match-beginning 0))
|
|
|
554 (goto-char (1- (point-max)))))
|
|
|
555 (delete-char 1) ; delete ^_
|
|
|
556 (save-excursion
|
|
|
557 (save-restriction
|
|
|
558 (narrow-to-region start (point))
|
|
|
559 (goto-char (point-min))
|
|
|
560 (nnmail-check-duplication message-id func)
|
|
|
561 (setq end (point-max))))
|
|
|
562 (goto-char end))))
|
|
|
563
|
|
|
564 (defun nnmail-search-unix-mail-delim ()
|
|
|
565 "Put point at the beginning of the next message."
|
|
|
566 (let ((case-fold-search t)
|
|
|
567 (delim (concat "^" message-unix-mail-delimiter))
|
|
|
568 found)
|
|
|
569 (while (not found)
|
|
|
570 (if (re-search-forward delim nil t)
|
|
|
571 (when (or (looking-at "[^\n :]+ *:")
|
|
|
572 (looking-at delim)
|
|
|
573 (looking-at (concat ">" message-unix-mail-delimiter)))
|
|
|
574 (forward-line -1)
|
|
|
575 (setq found 'yes))
|
|
|
576 (setq found 'no)))
|
|
|
577 (eq found 'yes)))
|
|
|
578
|
|
|
579 (defun nnmail-process-unix-mail-format (func)
|
|
|
580 (let ((case-fold-search t)
|
|
|
581 (delim (concat "^" message-unix-mail-delimiter))
|
|
|
582 start message-id content-length end skip head-end)
|
|
|
583 (goto-char (point-min))
|
|
|
584 (if (not (and (re-search-forward delim nil t)
|
|
|
585 (goto-char (match-beginning 0))))
|
|
|
586 ;; Possibly wrong format?
|
|
|
587 (error "Error, unknown mail format! (Possibly corrupted.)")
|
|
|
588 ;; Carry on until the bitter end.
|
|
|
589 (while (not (eobp))
|
|
|
590 (setq start (point)
|
|
|
591 end nil)
|
|
|
592 ;; Find the end of the head.
|
|
|
593 (narrow-to-region
|
|
|
594 start
|
|
|
595 (if (search-forward "\n\n" nil t)
|
|
|
596 (1- (point))
|
|
|
597 ;; This will never happen, but just to be on the safe side --
|
|
|
598 ;; if there is no head-body delimiter, we search a bit manually.
|
|
|
599 (while (and (looking-at "From \\|[^ \t]+:")
|
|
|
600 (not (eobp)))
|
|
|
601 (forward-line 1)
|
|
|
602 (point))))
|
|
|
603 ;; Find the Message-ID header.
|
|
|
604 (goto-char (point-min))
|
|
|
605 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
|
|
|
606 (setq message-id (match-string 1))
|
|
|
607 (save-excursion
|
|
|
608 (when (re-search-forward "^Message-ID:" nil t)
|
|
|
609 (beginning-of-line)
|
|
|
610 (insert "Original-")))
|
|
|
611 ;; There is no Message-ID here, so we create one.
|
|
|
612 (forward-line 1)
|
|
|
613 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
614 ;; Look for a Content-Length header.
|
|
|
615 (goto-char (point-min))
|
|
|
616 (if (not (re-search-forward
|
|
|
617 "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
|
|
|
618 (setq content-length nil)
|
|
|
619 (setq content-length (string-to-int (match-string 1)))
|
|
|
620 ;; We destroy the header, since none of the backends ever
|
|
|
621 ;; use it, and we do not want to confuse other mailers by
|
|
|
622 ;; having a (possibly) faulty header.
|
|
|
623 (beginning-of-line)
|
|
|
624 (insert "X-"))
|
|
|
625 ;; Find the end of this article.
|
|
|
626 (goto-char (point-max))
|
|
|
627 (widen)
|
|
|
628 (setq head-end (point))
|
|
|
629 ;; We try the Content-Length value. The idea: skip over the header
|
|
|
630 ;; separator, then check what happens content-length bytes into the
|
|
|
631 ;; message body. This should be either the end ot the buffer, the
|
|
|
632 ;; message separator or a blank line followed by the separator.
|
|
|
633 ;; The blank line should probably be deleted. If neither of the
|
|
|
634 ;; three is met, the content-length header is probably invalid.
|
|
|
635 (when content-length
|
|
|
636 (forward-line 1)
|
|
|
637 (setq skip (+ (point) content-length))
|
|
|
638 (goto-char skip)
|
|
|
639 (cond ((or (= skip (point-max))
|
|
|
640 (= (1+ skip) (point-max)))
|
|
|
641 (setq end (point-max)))
|
|
|
642 ((looking-at delim)
|
|
|
643 (setq end skip))
|
|
|
644 ((looking-at
|
|
|
645 (concat "[ \t]*\n\\(" delim "\\)"))
|
|
|
646 (setq end (match-beginning 1)))
|
|
|
647 (t (setq end nil))))
|
|
|
648 (if end
|
|
|
649 (goto-char end)
|
|
|
650 ;; No Content-Length, so we find the beginning of the next
|
|
|
651 ;; article or the end of the buffer.
|
|
|
652 (goto-char head-end)
|
|
|
653 (or (nnmail-search-unix-mail-delim)
|
|
|
654 (goto-char (point-max))))
|
|
|
655 ;; Allow the backend to save the article.
|
|
|
656 (save-excursion
|
|
|
657 (save-restriction
|
|
|
658 (narrow-to-region start (point))
|
|
|
659 (goto-char (point-min))
|
|
|
660 (nnmail-check-duplication message-id func)
|
|
|
661 (setq end (point-max))))
|
|
|
662 (goto-char end)))))
|
|
|
663
|
|
|
664 (defun nnmail-process-mmdf-mail-format (func)
|
|
|
665 (let ((delim "^\^A\^A\^A\^A$")
|
|
|
666 (case-fold-search t)
|
|
|
667 start message-id end)
|
|
|
668 (goto-char (point-min))
|
|
|
669 (if (not (and (re-search-forward delim nil t)
|
|
|
670 (forward-line 1)))
|
|
|
671 ;; Possibly wrong format?
|
|
|
672 (error "Error, unknown mail format! (Possibly corrupted.)")
|
|
|
673 ;; Carry on until the bitter end.
|
|
|
674 (while (not (eobp))
|
|
|
675 (setq start (point))
|
|
|
676 ;; Find the end of the head.
|
|
|
677 (narrow-to-region
|
|
|
678 start
|
|
|
679 (if (search-forward "\n\n" nil t)
|
|
|
680 (1- (point))
|
|
|
681 ;; This will never happen, but just to be on the safe side --
|
|
|
682 ;; if there is no head-body delimiter, we search a bit manually.
|
|
|
683 (while (and (looking-at "From \\|[^ \t]+:")
|
|
|
684 (not (eobp)))
|
|
|
685 (forward-line 1)
|
|
|
686 (point))))
|
|
|
687 ;; Find the Message-ID header.
|
|
|
688 (goto-char (point-min))
|
|
|
689 (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
|
|
|
690 (setq message-id (match-string 1))
|
|
|
691 ;; There is no Message-ID here, so we create one.
|
|
|
692 (save-excursion
|
|
|
693 (when (re-search-backward "^Message-ID:" nil t)
|
|
|
694 (beginning-of-line)
|
|
|
695 (insert "Original-")))
|
|
|
696 (forward-line 1)
|
|
|
697 (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
|
|
|
698 ;; Find the end of this article.
|
|
|
699 (goto-char (point-max))
|
|
|
700 (widen)
|
|
|
701 (if (re-search-forward delim nil t)
|
|
|
702 (beginning-of-line)
|
|
|
703 (goto-char (point-max)))
|
|
|
704 ;; Allow the backend to save the article.
|
|
|
705 (save-excursion
|
|
|
706 (save-restriction
|
|
|
707 (narrow-to-region start (point))
|
|
|
708 (goto-char (point-min))
|
|
|
709 (nnmail-check-duplication message-id func)
|
|
|
710 (setq end (point-max))))
|
|
|
711 (goto-char end)
|
|
|
712 (forward-line 2)))))
|
|
|
713
|
|
|
714 (defun nnmail-split-incoming (incoming func &optional exit-func group)
|
|
|
715 "Go through the entire INCOMING file and pick out each individual mail.
|
|
|
716 FUNC will be called with the buffer narrowed to each mail."
|
|
|
717 (let (;; If this is a group-specific split, we bind the split
|
|
|
718 ;; methods to just this group.
|
|
|
719 (nnmail-split-methods (if (and group
|
|
|
720 (or (eq nnmail-spool-file 'procmail)
|
|
|
721 nnmail-use-procmail)
|
|
|
722 (not nnmail-resplit-incoming))
|
|
|
723 (list (list group ""))
|
|
|
724 nnmail-split-methods)))
|
|
|
725 (save-excursion
|
|
|
726 ;; Insert the incoming file.
|
|
|
727 (set-buffer (get-buffer-create " *nnmail incoming*"))
|
|
|
728 (buffer-disable-undo (current-buffer))
|
|
|
729 (erase-buffer)
|
|
|
730 (nnheader-insert-file-contents-literally incoming)
|
|
|
731 (unless (zerop (buffer-size))
|
|
|
732 (goto-char (point-min))
|
|
|
733 (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
|
|
|
734 ;; Handle both babyl, MMDF and unix mail formats, since movemail will
|
|
|
735 ;; use the former when fetching from a mailbox, the latter when
|
|
|
736 ;; fetches from a file.
|
|
|
737 (cond ((or (looking-at "\^L")
|
|
|
738 (looking-at "BABYL OPTIONS:"))
|
|
|
739 (nnmail-process-babyl-mail-format func))
|
|
|
740 ((looking-at "\^A\^A\^A\^A")
|
|
|
741 (nnmail-process-mmdf-mail-format func))
|
|
|
742 (t
|
|
|
743 (nnmail-process-unix-mail-format func))))
|
|
|
744 (if exit-func (funcall exit-func))
|
|
|
745 (kill-buffer (current-buffer)))))
|
|
|
746
|
|
|
747 ;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
|
|
|
748 (defun nnmail-article-group (func)
|
|
|
749 "Look at the headers and return an alist of groups that match.
|
|
|
750 FUNC will be called with the group name to determine the article number."
|
|
|
751 (let ((methods nnmail-split-methods)
|
|
|
752 (obuf (current-buffer))
|
|
|
753 (beg (point-min))
|
|
|
754 end group-art method)
|
|
|
755 (if (and (sequencep methods) (= (length methods) 1))
|
|
|
756 ;; If there is only just one group to put everything in, we
|
|
|
757 ;; just return a list with just this one method in.
|
|
|
758 (setq group-art
|
|
|
759 (list (cons (caar methods) (funcall func (caar methods)))))
|
|
|
760 ;; We do actual comparison.
|
|
|
761 (save-excursion
|
|
|
762 ;; Find headers.
|
|
|
763 (goto-char beg)
|
|
|
764 (setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
|
|
|
765 (set-buffer nntp-server-buffer)
|
|
|
766 (erase-buffer)
|
|
|
767 ;; Copy the headers into the work buffer.
|
|
|
768 (insert-buffer-substring obuf beg end)
|
|
|
769 ;; Fold continuation lines.
|
|
|
770 (goto-char (point-min))
|
|
|
771 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
|
|
|
772 (replace-match " " t t))
|
|
|
773 (if (and (symbolp nnmail-split-methods)
|
|
|
774 (fboundp nnmail-split-methods))
|
|
|
775 ;; `nnmail-split-methods' is a function, so we just call
|
|
|
776 ;; this function here and use the result.
|
|
|
777 (setq group-art
|
|
|
778 (mapcar
|
|
|
779 (lambda (group) (cons group (funcall func group)))
|
|
|
780 (condition-case nil
|
|
|
781 (or (funcall nnmail-split-methods)
|
|
|
782 '("bogus"))
|
|
|
783 (error
|
|
|
784 (message
|
|
|
785 "Error in `nnmail-split-methods'; using `bogus' mail group")
|
|
|
786 (sit-for 1)
|
|
|
787 '("bogus")))))
|
|
|
788 ;; Go through the split methods to find a match.
|
|
|
789 (while (and methods (or nnmail-crosspost (not group-art)))
|
|
|
790 (goto-char (point-max))
|
|
|
791 (setq method (pop methods))
|
|
|
792 (if (or methods
|
|
|
793 (not (equal "" (nth 1 method))))
|
|
|
794 (when (and
|
|
|
795 (condition-case ()
|
|
|
796 (if (stringp (nth 1 method))
|
|
|
797 (re-search-backward (cadr method) nil t)
|
|
|
798 ;; Function to say whether this is a match.
|
|
|
799 (funcall (nth 1 method) (car method)))
|
|
|
800 (error nil))
|
|
|
801 ;; Don't enter the article into the same
|
|
|
802 ;; group twice.
|
|
|
803 (not (assoc (car method) group-art)))
|
|
|
804 (push (cons (car method) (funcall func (car method)))
|
|
|
805 group-art))
|
|
|
806 ;; This is the final group, which is used as a
|
|
|
807 ;; catch-all.
|
|
|
808 (unless group-art
|
|
|
809 (setq group-art
|
|
|
810 (list (cons (car method)
|
|
|
811 (funcall func (car method)))))))))
|
|
|
812 group-art))))
|
|
|
813
|
|
|
814 (defun nnmail-insert-lines ()
|
|
|
815 "Insert how many lines there are in the body of the mail.
|
|
|
816 Return the number of characters in the body."
|
|
|
817 (let (lines chars)
|
|
|
818 (save-excursion
|
|
|
819 (goto-char (point-min))
|
|
|
820 (when (search-forward "\n\n" nil t)
|
|
|
821 (setq chars (- (point-max) (point)))
|
|
|
822 (setq lines (count-lines (point) (point-max)))
|
|
|
823 (forward-char -1)
|
|
|
824 (save-excursion
|
|
|
825 (when (re-search-backward "^Lines: " nil t)
|
|
|
826 (delete-region (point) (progn (forward-line 1) (point)))))
|
|
|
827 (beginning-of-line)
|
|
|
828 (insert (format "Lines: %d\n" (max lines 0)))
|
|
|
829 chars))))
|
|
|
830
|
|
|
831 (defun nnmail-insert-xref (group-alist)
|
|
|
832 "Insert an Xref line based on the (group . article) alist."
|
|
|
833 (save-excursion
|
|
|
834 (goto-char (point-min))
|
|
|
835 (when (search-forward "\n\n" nil t)
|
|
|
836 (forward-char -1)
|
|
|
837 (when (re-search-backward "^Xref: " nil t)
|
|
|
838 (delete-region (match-beginning 0)
|
|
|
839 (progn (forward-line 1) (point))))
|
|
|
840 (insert (format "Xref: %s" (system-name)))
|
|
|
841 (while group-alist
|
|
|
842 (insert (format " %s:%d" (caar group-alist) (cdar group-alist)))
|
|
|
843 (setq group-alist (cdr group-alist)))
|
|
|
844 (insert "\n"))))
|
|
|
845
|
|
|
846 ;; Written by byer@mv.us.adobe.com (Scott Byer).
|
|
|
847 (defun nnmail-make-complex-temp-name (prefix)
|
|
|
848 (let ((newname (make-temp-name prefix))
|
|
|
849 (newprefix prefix))
|
|
|
850 (while (file-exists-p newname)
|
|
|
851 (setq newprefix (concat newprefix "x"))
|
|
|
852 (setq newname (make-temp-name newprefix)))
|
|
|
853 newname))
|
|
|
854
|
|
|
855 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
|
|
|
856
|
|
|
857 (defun nnmail-split-fancy ()
|
|
|
858 "Fancy splitting method.
|
|
|
859 See the documentation for the variable `nnmail-split-fancy' for documentation."
|
|
|
860 (let ((syntab (syntax-table)))
|
|
|
861 (unwind-protect
|
|
|
862 (progn
|
|
|
863 (set-syntax-table nnmail-split-fancy-syntax-table)
|
|
|
864 (nnmail-split-it nnmail-split-fancy))
|
|
|
865 (set-syntax-table syntab))))
|
|
|
866
|
|
|
867 (defvar nnmail-split-cache nil)
|
|
|
868 ;; Alist of split expressions their equivalent regexps.
|
|
|
869
|
|
|
870 (defun nnmail-split-it (split)
|
|
|
871 ;; Return a list of groups matching SPLIT.
|
|
|
872 (cond ((stringp split)
|
|
|
873 ;; A group.
|
|
|
874 (list split))
|
|
|
875 ((eq (car split) '&)
|
|
|
876 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
|
|
|
877 ((eq (car split) '|)
|
|
|
878 (let (done)
|
|
|
879 (while (and (not done) (cdr split))
|
|
|
880 (setq split (cdr split)
|
|
|
881 done (nnmail-split-it (car split))))
|
|
|
882 done))
|
|
|
883 ((assq split nnmail-split-cache)
|
|
|
884 ;; A compiled match expression.
|
|
|
885 (goto-char (point-max))
|
|
|
886 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
|
|
|
887 (nnmail-split-it (nth 2 split))))
|
|
|
888 (t
|
|
|
889 ;; An uncompiled match.
|
|
|
890 (let* ((field (nth 0 split))
|
|
|
891 (value (nth 1 split))
|
|
|
892 (regexp (concat "^\\("
|
|
|
893 (if (symbolp field)
|
|
|
894 (cdr (assq field
|
|
|
895 nnmail-split-abbrev-alist))
|
|
|
896 field)
|
|
|
897 "\\):.*\\<\\("
|
|
|
898 (if (symbolp value)
|
|
|
899 (cdr (assq value
|
|
|
900 nnmail-split-abbrev-alist))
|
|
|
901 value)
|
|
|
902 "\\)\\>")))
|
|
|
903 (setq nnmail-split-cache
|
|
|
904 (cons (cons split regexp) nnmail-split-cache))
|
|
|
905 (goto-char (point-max))
|
|
|
906 (if (re-search-backward regexp nil t)
|
|
|
907 (nnmail-split-it (nth 2 split)))))))
|
|
|
908
|
|
|
909 ;; Get a list of spool files to read.
|
|
|
910 (defun nnmail-get-spool-files (&optional group)
|
|
|
911 (if (null nnmail-spool-file)
|
|
|
912 ;; No spool file whatsoever.
|
|
|
913 nil
|
|
|
914 (let* ((procmails
|
|
|
915 ;; If procmail is used to get incoming mail, the files
|
|
|
916 ;; are stored in this directory.
|
|
|
917 (and (file-exists-p nnmail-procmail-directory)
|
|
|
918 (or (eq nnmail-spool-file 'procmail)
|
|
|
919 nnmail-use-procmail)
|
|
|
920 (directory-files
|
|
|
921 nnmail-procmail-directory
|
|
|
922 t (concat (if group (concat "^" group) "")
|
|
|
923 nnmail-procmail-suffix "$") t)))
|
|
|
924 (p procmails)
|
|
|
925 (crash (when (and (file-exists-p nnmail-crash-box)
|
|
|
926 (> (nth 7 (file-attributes
|
|
|
927 (file-truename nnmail-crash-box))) 0))
|
|
|
928 (list nnmail-crash-box))))
|
|
|
929 ;; Remove any directories that inadvertantly match the procmail
|
|
|
930 ;; suffix, which might happen if the suffix is "".
|
|
|
931 (while p
|
|
|
932 (when (file-directory-p (car p))
|
|
|
933 (setq procmails (delete (car p) procmails)))
|
|
|
934 (setq p (cdr p)))
|
|
|
935 ;; Return the list of spools.
|
|
|
936 (append
|
|
|
937 crash
|
|
|
938 (cond ((and group
|
|
|
939 (or (eq nnmail-spool-file 'procmail)
|
|
|
940 nnmail-use-procmail))
|
|
|
941 procmails)
|
|
|
942 ((listp nnmail-spool-file)
|
|
|
943 (append nnmail-spool-file procmails))
|
|
|
944 ((stringp nnmail-spool-file)
|
|
|
945 (cons nnmail-spool-file procmails))
|
|
|
946 ((eq nnmail-spool-file 'pop)
|
|
|
947 (cons (format "po:%s" (user-login-name)) procmails))
|
|
|
948 (t
|
|
|
949 procmails))))))
|
|
|
950
|
|
|
951 ;; Activate a backend only if it isn't already activated.
|
|
|
952 ;; If FORCE, re-read the active file even if the backend is
|
|
|
953 ;; already activated.
|
|
|
954 (defun nnmail-activate (backend &optional force)
|
|
|
955 (let (file timestamp file-time)
|
|
|
956 (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
|
|
|
957 force
|
|
|
958 (and (setq file (condition-case ()
|
|
|
959 (symbol-value (intern (format "%s-active-file"
|
|
|
960 backend)))
|
|
|
961 (error nil)))
|
|
|
962 (setq file-time (nth 5 (file-attributes file)))
|
|
|
963 (or (not
|
|
|
964 (setq timestamp
|
|
|
965 (condition-case ()
|
|
|
966 (symbol-value (intern
|
|
|
967 (format "%s-active-timestamp"
|
|
|
968 backend)))
|
|
|
969 (error 'none))))
|
|
|
970 (not (consp timestamp))
|
|
|
971 (equal timestamp '(0 0))
|
|
|
972 (> (nth 0 file-time) (nth 0 timestamp))
|
|
|
973 (and (= (nth 0 file-time) (nth 0 timestamp))
|
|
|
974 (> (nth 1 file-time) (nth 1 timestamp))))))
|
|
|
975 (save-excursion
|
|
|
976 (or (eq timestamp 'none)
|
|
|
977 (set (intern (format "%s-active-timestamp" backend))
|
|
|
978 (current-time)))
|
|
|
979 (funcall (intern (format "%s-request-list" backend)))
|
|
|
980 (set (intern (format "%s-group-alist" backend))
|
|
|
981 (nnmail-get-active))))
|
|
|
982 t))
|
|
|
983
|
|
|
984 (defun nnmail-message-id ()
|
|
|
985 (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
|
|
|
986
|
|
|
987 ;;;
|
|
|
988 ;;; nnmail duplicate handling
|
|
|
989 ;;;
|
|
|
990
|
|
|
991 (defvar nnmail-cache-buffer nil)
|
|
|
992
|
|
|
993 (defun nnmail-cache-open ()
|
|
|
994 (if (or (not nnmail-treat-duplicates)
|
|
|
995 (and nnmail-cache-buffer
|
|
|
996 (buffer-name nnmail-cache-buffer)))
|
|
|
997 () ; The buffer is open.
|
|
|
998 (save-excursion
|
|
|
999 (set-buffer
|
|
|
1000 (setq nnmail-cache-buffer
|
|
|
1001 (get-buffer-create " *nnmail message-id cache*")))
|
|
|
1002 (buffer-disable-undo (current-buffer))
|
|
|
1003 (and (file-exists-p nnmail-message-id-cache-file)
|
|
|
1004 (insert-file-contents nnmail-message-id-cache-file))
|
|
|
1005 (set-buffer-modified-p nil)
|
|
|
1006 (current-buffer))))
|
|
|
1007
|
|
|
1008 (defun nnmail-cache-close ()
|
|
|
1009 (when (and nnmail-cache-buffer
|
|
|
1010 nnmail-treat-duplicates
|
|
|
1011 (buffer-name nnmail-cache-buffer)
|
|
|
1012 (buffer-modified-p nnmail-cache-buffer))
|
|
|
1013 (save-excursion
|
|
|
1014 (set-buffer nnmail-cache-buffer)
|
|
|
1015 ;; Weed out the excess number of Message-IDs.
|
|
|
1016 (goto-char (point-max))
|
|
|
1017 (and (search-backward "\n" nil t nnmail-message-id-cache-length)
|
|
|
1018 (progn
|
|
|
1019 (beginning-of-line)
|
|
|
1020 (delete-region (point-min) (point))))
|
|
|
1021 ;; Save the buffer.
|
|
|
1022 (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
|
|
|
1023 (make-directory (file-name-directory nnmail-message-id-cache-file)
|
|
|
1024 t))
|
|
|
1025 (write-region (point-min) (point-max)
|
|
|
1026 nnmail-message-id-cache-file nil 'silent)
|
|
|
1027 (set-buffer-modified-p nil)
|
|
|
1028 (setq nnmail-cache-buffer nil)
|
|
|
1029 ;;(kill-buffer (current-buffer))
|
|
|
1030 )))
|
|
|
1031
|
|
|
1032 (defun nnmail-cache-insert (id)
|
|
|
1033 (when nnmail-treat-duplicates
|
|
|
1034 (save-excursion
|
|
|
1035 (set-buffer nnmail-cache-buffer)
|
|
|
1036 (goto-char (point-max))
|
|
|
1037 (insert id "\n"))))
|
|
|
1038
|
|
|
1039 (defun nnmail-cache-id-exists-p (id)
|
|
|
1040 (when nnmail-treat-duplicates
|
|
|
1041 (save-excursion
|
|
|
1042 (set-buffer nnmail-cache-buffer)
|
|
|
1043 (goto-char (point-max))
|
|
|
1044 (search-backward id nil t))))
|
|
|
1045
|
|
|
1046 (defun nnmail-check-duplication (message-id func)
|
|
|
1047 ;; If this is a duplicate message, then we do not save it.
|
|
|
1048 (let* ((duplication (nnmail-cache-id-exists-p message-id))
|
|
|
1049 (action (when duplication
|
|
|
1050 (cond
|
|
|
1051 ((memq nnmail-treat-duplicates '(warn delete))
|
|
|
1052 nnmail-treat-duplicates)
|
|
|
1053 ((nnheader-functionp nnmail-treat-duplicates)
|
|
|
1054 (funcall nnmail-treat-duplicates message-id))
|
|
|
1055 (t
|
|
|
1056 nnmail-treat-duplicates)))))
|
|
|
1057 (cond
|
|
|
1058 ((not duplication)
|
|
|
1059 (nnmail-cache-insert message-id)
|
|
|
1060 (funcall func))
|
|
|
1061 ((eq action 'delete)
|
|
|
1062 (delete-region (point-min) (point-max)))
|
|
|
1063 ((eq action 'warn)
|
|
|
1064 ;; We insert a warning.
|
|
|
1065 (let ((case-fold-search t)
|
|
|
1066 (newid (nnmail-message-id)))
|
|
|
1067 (goto-char (point-min))
|
|
|
1068 (when (re-search-forward "^message-id:" nil t)
|
|
|
1069 (beginning-of-line)
|
|
|
1070 (insert "Original-"))
|
|
|
1071 (beginning-of-line)
|
|
|
1072 (insert
|
|
|
1073 "Message-ID: " newid "\n"
|
|
|
1074 "Gnus-Warning: This is a duplicate of message " message-id "\n")
|
|
|
1075 (nnmail-cache-insert newid)
|
|
|
1076 (funcall func)))
|
|
|
1077 (t
|
|
|
1078 (funcall func)))))
|
|
|
1079
|
|
|
1080 ;;; Get new mail.
|
|
|
1081
|
|
|
1082 (defun nnmail-get-value (&rest args)
|
|
|
1083 (let ((sym (intern (apply 'format args))))
|
|
|
1084 (when (boundp sym)
|
|
|
1085 (symbol-value sym))))
|
|
|
1086
|
|
|
1087 (defun nnmail-get-new-mail (method exit-func temp
|
|
|
1088 &optional group spool-func)
|
|
|
1089 "Read new incoming mail."
|
|
|
1090 (let* ((spools (nnmail-get-spool-files group))
|
|
|
1091 (group-in group)
|
|
|
1092 incoming incomings spool)
|
|
|
1093 (when (and (nnmail-get-value "%s-get-new-mail" method)
|
|
|
1094 nnmail-spool-file)
|
|
|
1095 ;; We first activate all the groups.
|
|
|
1096 (nnmail-activate method)
|
|
|
1097 ;; Allow the user to hook.
|
|
|
1098 (run-hooks 'nnmail-pre-get-new-mail-hook)
|
|
|
1099 ;; Open the message-id cache.
|
|
|
1100 (nnmail-cache-open)
|
|
|
1101 ;; The we go through all the existing spool files and split the
|
|
|
1102 ;; mail from each.
|
|
|
1103 (while spools
|
|
|
1104 (setq spool (pop spools))
|
|
|
1105 ;; We read each spool file if either the spool is a POP-mail
|
|
|
1106 ;; spool, or the file exists. We can't check for the
|
|
|
1107 ;; existance of POPped mail.
|
|
|
1108 (when (or (string-match "^po:" spool)
|
|
|
1109 (and (file-exists-p spool)
|
|
|
1110 (> (nth 7 (file-attributes (file-truename spool))) 0)))
|
|
|
1111 (nnheader-message 3 "%s: Reading incoming mail..." method)
|
|
|
1112 (when (and (nnmail-move-inbox spool)
|
|
|
1113 (file-exists-p nnmail-crash-box))
|
|
|
1114 ;; There is new mail. We first find out if all this mail
|
|
|
1115 ;; is supposed to go to some specific group.
|
|
|
1116 (setq group (nnmail-get-split-group spool group-in))
|
|
|
1117 ;; We split the mail
|
|
|
1118 (nnmail-split-incoming
|
|
|
1119 nnmail-crash-box (intern (format "%s-save-mail" method))
|
|
|
1120 spool-func group)
|
|
|
1121 ;; Check whether the inbox is to be moved to the special tmp dir.
|
|
|
1122 (setq incoming
|
|
|
1123 (nnmail-make-complex-temp-name
|
|
|
1124 (expand-file-name
|
|
|
1125 (if nnmail-tmp-directory
|
|
|
1126 (concat
|
|
|
1127 (file-name-as-directory nnmail-tmp-directory)
|
|
|
1128 (file-name-nondirectory (concat temp "Incoming")))
|
|
|
1129 (concat temp "Incoming")))))
|
|
|
1130 (rename-file nnmail-crash-box incoming t)
|
|
|
1131 (push incoming incomings))))
|
|
|
1132 ;; If we did indeed read any incoming spools, we save all info.
|
|
|
1133 (when incomings
|
|
|
1134 (nnmail-save-active
|
|
|
1135 (nnmail-get-value "%s-group-alist" method)
|
|
|
1136 (nnmail-get-value "%s-active-file" method))
|
|
|
1137 (when exit-func
|
|
|
1138 (funcall exit-func))
|
|
|
1139 (run-hooks 'nnmail-read-incoming-hook)
|
|
|
1140 (nnheader-message 3 "%s: Reading incoming mail...done" method))
|
|
|
1141 ;; Close the message-id cache.
|
|
|
1142 (nnmail-cache-close)
|
|
|
1143 ;; Allow the user to hook.
|
|
|
1144 (run-hooks 'nnmail-post-get-new-mail-hook)
|
|
|
1145 ;; Delete all the temporary files.
|
|
|
1146 (while incomings
|
|
|
1147 (setq incoming (pop incomings))
|
|
|
1148 (and nnmail-delete-incoming
|
|
|
1149 (file-exists-p incoming)
|
|
|
1150 (file-writable-p incoming)
|
|
|
1151 (delete-file incoming))))))
|
|
|
1152
|
|
|
1153 (defun nnmail-expired-article-p (group time force &optional inhibit)
|
|
|
1154 "Say whether an article that is TIME old in GROUP should be expired."
|
|
|
1155 (if force
|
|
|
1156 t
|
|
|
1157 (let ((days (or (and nnmail-expiry-wait-function
|
|
|
1158 (funcall nnmail-expiry-wait-function group))
|
|
|
1159 nnmail-expiry-wait)))
|
|
|
1160 (cond ((or (eq days 'never)
|
|
|
1161 (and (not force)
|
|
|
1162 inhibit))
|
|
|
1163 ;; This isn't an expirable group.
|
|
|
1164 nil)
|
|
|
1165 ((eq days 'immediate)
|
|
|
1166 ;; We expire all articles on sight.
|
|
|
1167 t)
|
|
|
1168 ((equal time '(0 0))
|
|
|
1169 ;; This is an ange-ftp group, and we don't have any dates.
|
|
|
1170 nil)
|
|
|
1171 ((numberp days)
|
|
|
1172 (setq days (nnmail-days-to-time days))
|
|
|
1173 ;; Compare the time with the current time.
|
|
|
1174 (nnmail-time-less days (nnmail-time-since time)))))))
|
|
|
1175
|
|
|
1176 (defvar nnmail-read-passwd nil)
|
|
|
1177 (defun nnmail-read-passwd (prompt)
|
|
|
1178 (unless nnmail-read-passwd
|
|
|
1179 (if (load "passwd" t)
|
|
|
1180 (setq nnmail-read-passwd 'read-passwd)
|
|
|
1181 (autoload 'ange-ftp-read-passwd "ange-ftp")
|
|
|
1182 (setq nnmail-read-passwd 'ange-ftp-read-passwd)))
|
|
|
1183 (funcall nnmail-read-passwd prompt))
|
|
|
1184
|
|
|
1185 (defun nnmail-check-syntax ()
|
|
|
1186 "Check (and modify) the syntax of the message in the current buffer."
|
|
|
1187 (save-restriction
|
|
|
1188 (message-narrow-to-head)
|
|
|
1189 (let ((case-fold-search t))
|
|
|
1190 (unless (re-search-forward "^Message-Id:" nil t)
|
|
|
1191 (insert "Message-ID: " (nnmail-message-id) "\n")))))
|
|
|
1192
|
|
|
1193 (run-hooks 'nnmail-load-hook)
|
|
|
1194
|
|
|
1195 (provide 'nnmail)
|
|
|
1196
|
|
|
1197 ;;; nnmail.el ends here
|
