2003-01-02 Matthieu Moy <Matthieu.Moy@imag.fr>
[gnus] / lisp / spam.el
1 ;;; spam.el --- Identifying spam
2 ;; Copyright (C) 2002 Free Software Foundation, Inc.
3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; Keywords: network
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 ;;; This module addresses a few aspects of spam control under Gnus.  Page
27 ;;; breaks are used for grouping declarations and documentation relating to
28 ;;; each particular aspect.
29
30 ;;; The integration with Gnus is not yet complete.  See various `FIXME'
31 ;;; comments, below, for supplementary explanations or discussions.
32
33 ;;; Several TODO items are marked as such
34
35 ;;; Code:
36
37 (require 'gnus-sum)
38
39 (require 'gnus-uu)                      ; because of key prefix issues
40 (require 'gnus) ; for the definitions of group content classification and spam processors
41
42 ;; FIXME!  We should not require `message' until we actually need
43 ;; them.  Best would be to declare needed functions as auto-loadable.
44 (require 'message)
45
46 ;; Attempt to load BBDB macros
47 (eval-when-compile
48   (condition-case nil
49       (require 'bbdb-com)
50     (file-error (defalias 'bbdb-search 'ignore))))
51
52 ;; autoload executable-find
53 (eval-and-compile
54   ;; executable-find is not autoloaded in Emacs 20
55   (autoload 'executable-find "executable"))
56
57 ;; autoload ifile-spam-filter
58 (eval-and-compile
59   (autoload 'ifile-spam-filter "ifile-gnus"))
60
61 ;; autoload query-dig
62 (eval-and-compile
63   (autoload 'query-dig "dig"))
64
65 ;; autoload query-dns
66 (eval-and-compile
67   (autoload 'query-dns "dns"))
68
69 ;;; Main parameters.
70
71 (defgroup spam nil
72   "Spam configuration.")
73
74 (defcustom spam-directory "~/News/spam/"
75   "Directory for spam whitelists and blacklists."
76   :type 'directory
77   :group 'spam)
78
79 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
80   "The location of the whitelist.
81 The file format is one regular expression per line.
82 The regular expression is matched against the address."
83   :type 'file
84   :group 'spam)
85
86 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
87   "The location of the blacklist.
88 The file format is one regular expression per line.
89 The regular expression is matched against the address."
90   :type 'file
91   :group 'spam)
92
93 (defcustom spam-use-dig t
94   "Whether query-dig should be used instead of query-dns."
95   :type 'boolean
96   :group 'spam)
97
98 (defcustom spam-use-blacklist t
99   "Whether the blacklist should be used by spam-split."
100   :type 'boolean
101   :group 'spam)
102
103 (defcustom spam-use-whitelist nil
104   "Whether the whitelist should be used by spam-split."
105   :type 'boolean
106   :group 'spam)
107
108 (defcustom spam-use-blackholes nil
109   "Whether blackholes should be used by spam-split."
110   :type 'boolean
111   :group 'spam)
112
113 (defcustom spam-use-bogofilter nil
114   "Whether bogofilter should be used by spam-split."
115   :type 'boolean
116   :group 'spam)
117
118 (defcustom spam-use-bbdb nil
119   "Whether BBDB should be used by spam-split."
120   :type 'boolean
121   :group 'spam)
122
123 (defcustom spam-use-ifile nil
124   "Whether ifile should be used by spam-split."
125   :type 'boolean
126   :group 'spam)
127
128 (defcustom spam-split-group "spam"
129   "Group name where incoming spam should be put by spam-split."
130   :type 'string
131   :group 'spam)
132
133 ;; FIXME!  The mailgroup list evidently depends on other choices made by the
134 ;; user, so the built-in default below is not likely to be appropriate.
135 (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
136   "Mailgroups with spam contents.
137 All unmarked article in such group receive the spam mark on group entry."
138   :type '(repeat (string :tag "Group"))
139   :group 'spam)
140
141 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk" "relays.visi.com")
142   "List of blackhole servers."
143   :type '(repeat (string :tag "Server"))
144   :group 'spam)
145
146 (defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark 'gnus-killed-mark 'gnus-kill-file-mark 'gnus-low-score-mark)
147   "Marks considered as being ham (positively not spam).
148 Such articles will be processed as ham (non-spam) on group exit."
149   :type '(set
150           (variable-item gnus-del-mark)
151           (variable-item gnus-read-mark)
152           (variable-item gnus-killed-mark)
153           (variable-item gnus-kill-file-mark)
154           (variable-item gnus-low-score-mark))
155   :group 'spam)
156
157 (defcustom spam-spam-marks (list 'gnus-spam-mark)
158   "Marks considered as being spam (positively spam).
159 Such articles will be transmitted to `bogofilter -s' on group exit."
160   :type '(set 
161           (variable-item gnus-spam-mark)
162           (variable-item gnus-killed-mark)
163           (variable-item gnus-kill-file-mark)
164           (variable-item gnus-low-score-mark))
165   :group 'spam)
166
167 (defcustom spam-face 'gnus-splash-face
168   "Face for spam-marked articles"
169   :type 'face
170   :group 'spam)
171
172 (defgroup spam-bogofilter nil
173   "Spam bogofilter configuration."
174   :group 'spam)
175
176 (defcustom spam-bogofilter-output-buffer-name "*Bogofilter Output*"
177   "Name of buffer when displaying `bogofilter -v' output."  
178   :type 'string
179   :group 'spam-bogofilter)
180
181 (defcustom spam-bogofilter-initial-timeout 40
182   "Timeout in seconds for the initial reply from the `bogofilter' program."
183   :type 'integer
184   :group 'spam-bogofilter)
185
186 (defcustom spam-bogofilter-subsequent-timeout 15
187   "Timeout in seconds for any subsequent reply from the `bogofilter' program."
188   :type 'integer
189   :group 'spam-bogofilter)
190
191 (defcustom spam-bogofilter-path (executable-find "bogofilter")
192   "File path of the Bogofilter executable program."
193   :type '(choice (file :tag "Location of bogofilter")
194                  (const :tag "Bogofilter is not installed"))
195   :group 'spam-bogofilter)
196
197 ;; FIXME!  In the following regexp, we should explain which tool produces
198 ;; which kind of header.  I do not even remember them all by now.  X-Junk
199 ;; (and previously X-NoSpam) are produced by the `NoSpam' tool, which has
200 ;; never been published, so it might not be reasonable leaving it in the
201 ;; list.
202 (defcustom spam-bogofilter-spaminfo-header-regexp "^X-\\(jf\\|Junk\\|NoSpam\\|Spam\\|SB\\)[^:]*:"
203   "Regexp for spam markups in headers.
204 Markup from spam recognisers, as well as `Xref', are to be removed from
205 articles before they get registered by Bogofilter."
206   :type 'regexp
207   :group 'spam-bogofilter)
208
209 ;;; Key bindings for spam control.
210
211 (gnus-define-keys gnus-summary-mode-map
212   "St" spam-bogofilter-score
213   "Sx" gnus-summary-mark-as-spam
214   "Mst" spam-bogofilter-score
215   "Msx" gnus-summary-mark-as-spam
216   "\M-d" gnus-summary-mark-as-spam)
217
218 ;;; How to highlight a spam summary line.
219
220 ;; TODO: How do we redo this every time spam-face is customized?
221
222 (push '((eq mark gnus-spam-mark) . spam-face)
223       gnus-summary-highlight)
224
225 ;; convenience functions
226 (defun spam-group-spam-contents-p (group)
227   (if (stringp group)
228       (or (member group spam-junk-mailgroups)
229           (memq 'gnus-group-spam-classification-spam (gnus-parameter-spam-contents group)))
230     nil))
231   
232 (defun spam-group-ham-contents-p (group)
233   (if (stringp group)
234       (memq 'gnus-group-spam-classification-ham (gnus-parameter-spam-contents group))
235     nil))
236   
237
238 ;;; Hooks dispatching.  A bit raw for now.
239
240 (defun spam-summary-prepare ()
241   (spam-mark-junk-as-spam-routine))
242
243 (defun spam-summary-prepare-exit ()
244   (spam-bogofilter-register-routine)
245   (when (spam-group-spam-contents-p gnus-newsgroup-name)
246     (                                 
247      ;; TODO: the spam processors here
248      ;; TODO: the spam-processed articles will be moved here
249      ))
250   (when (spam-group-ham-contents-p gnus-newsgroup-name)
251     (
252      ;; TODO: the ham processors here
253      )))
254
255 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
256 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
257
258 (defun spam-mark-junk-as-spam-routine ()
259   ;; check the global list of group names spam-junk-mailgroups and the group parameters
260   (when (spam-group-spam-contents-p gnus-newsgroup-name)
261     (let ((articles gnus-newsgroup-articles)
262           article)
263       (while articles
264         (setq article (pop articles))
265         (when (eq (gnus-summary-article-mark article) gnus-unread-mark)
266           (gnus-summary-mark-article article gnus-spam-mark))))))
267 \f
268 ;;;; Spam determination.
269
270
271 (defvar spam-list-of-checks
272   '((spam-use-blacklist  . spam-check-blacklist)
273     (spam-use-whitelist  . spam-check-whitelist)
274     (spam-use-bbdb       . spam-check-bbdb)
275     (spam-use-ifile      . spam-check-ifile)
276     (spam-use-blackholes . spam-check-blackholes)
277     (spam-use-bogofilter . spam-check-bogofilter))
278 "The spam-list-of-checks list contains pairs associating a parameter
279 variable with a spam checking function.  If the parameter variable is
280 true, then the checking function is called, and its value decides what
281 happens.  Each individual check may return `nil', `t', or a mailgroup
282 name.  The value `nil' means that the check does not yield a decision,
283 and so, that further checks are needed.  The value `t' means that the
284 message is definitely not spam, and that further spam checks should be
285 inhibited.  Otherwise, a mailgroup name is returned where the mail
286 should go, and further checks are also inhibited.  The usual mailgroup
287 name is the value of `spam-split-group', meaning that the message is
288 definitely a spam.")
289
290 (defun spam-split ()
291   "Split this message into the `spam' group if it is spam.
292 This function can be used as an entry in `nnmail-split-fancy', for
293 example like this: (: spam-split)
294
295 See the Info node `(gnus)Fancy Mail Splitting' for more details."
296   (interactive)
297
298   (let ((list-of-checks spam-list-of-checks)
299         decision)
300     (while (and list-of-checks (not decision))
301       (let ((pair (pop list-of-checks)))
302         (when (symbol-value (car pair))
303           (setq decision (funcall (cdr pair))))))
304     (if (eq decision t)
305         nil
306       decision)))
307 \f
308 ;;;; Blackholes.
309
310 (defun spam-check-blackholes ()
311   "Check the Received headers for blackholed relays."
312   (let ((headers (message-fetch-field "received"))
313         ips matches)
314     (when headers
315       (with-temp-buffer
316         (insert headers)
317         (goto-char (point-min))
318         (while (re-search-forward
319                 "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
320           (message "Blackhole search found host IP %s." (match-string 1))
321           (push (mapconcat 'identity
322                            (nreverse (split-string (match-string 1) "\\."))
323                            ".")
324                 ips)))
325       (dolist (server spam-blackhole-servers)
326         (dolist (ip ips)
327           (let ((query-string (concat ip "." server)))
328             (if spam-use-dig
329                 (let ((query-result (query-dig query-string)))
330                   (when query-result
331                     (message "spam detected with blackhole check of relay %s (dig query result '%s')" query-string query-result)
332                     (push (list ip server query-result)
333                           matches)))
334               ;; else, if not using dig.el
335               (when (query-dns query-string)
336                 (push (list ip server (query-dns query-string 'TXT))
337                       matches)))))))
338     (when matches
339       spam-split-group)))
340 \f
341 ;;;; Blacklists and whitelists.
342
343 (defvar spam-whitelist-cache nil)
344 (defvar spam-blacklist-cache nil)
345
346 (defun spam-enter-whitelist (address)
347   "Enter ADDRESS into the whitelist."
348   (interactive "sAddress: ")
349   (spam-enter-list address spam-whitelist)
350   (setq spam-whitelist-cache nil))
351
352 (defun spam-enter-blacklist (address)
353   "Enter ADDRESS into the blacklist."
354   (interactive "sAddress: ")
355   (spam-enter-list address spam-blacklist)
356   (setq spam-blacklist-cache nil))
357
358 (defun spam-enter-list (address file)
359   "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
360   (unless (file-exists-p (file-name-directory file))
361     (make-directory (file-name-directory file) t))
362   (save-excursion
363     (set-buffer
364      (find-file-noselect file))
365     (goto-char (point-max))
366     (unless (bobp)
367       (insert "\n"))
368     (insert address "\n")
369     (save-buffer)))
370
371 ;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
372 (defun spam-check-whitelist ()
373   ;; FIXME!  Should it detect when file timestamps change?
374   (unless spam-whitelist-cache
375     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
376   (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
377
378 ;;; original idea from Alexander Kotelnikov <sacha@giotto.sj.ru>
379 (condition-case nil
380     (progn
381       (require 'bbdb-com)
382       (defun spam-check-bbdb ()
383         "We want messages from people who are in the BBDB not to be split to spam"
384         (let ((who (message-fetch-field "from")))
385           (when who
386             (setq who (regexp-quote (cadr (gnus-extract-address-components who))))
387             (if (bbdb-search (bbdb-records) nil nil who) nil spam-split-group)))))
388   (file-error (setq spam-list-of-checks
389                     (delete (assoc 'spam-use-bbdb spam-list-of-checks)
390                             spam-list-of-checks))))
391
392 ;;; check the ifile backend; return nil if the mail was NOT classified as spam
393 ;;; TODO: we can't (require) ifile, because it will insinuate itself automatically
394 (defun spam-check-ifile ()
395   (let ((ifile-primary-spam-group spam-split-group))
396     (ifile-spam-filter nil)))
397
398 (defun spam-check-blacklist ()
399   ;; FIXME!  Should it detect when file timestamps change?
400   (unless spam-blacklist-cache
401     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
402   (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
403
404 (eval-and-compile
405   (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
406                                    'point-at-eol
407                                  'line-end-position)))
408
409 (defun spam-parse-list (file)
410   (when (file-readable-p file)
411     (let (contents address)
412       (with-temp-buffer
413         (insert-file-contents file)
414         (while (not (eobp))
415           (setq address (buffer-substring (point) (spam-point-at-eol)))
416           (forward-line 1)
417           (unless (zerop (length address))
418             (setq address (regexp-quote address))
419             (while (string-match "\\\\\\*" address)
420               (setq address (replace-match ".*" t t address)))
421             (push address contents))))
422       (nreverse contents))))
423
424 (defun spam-from-listed-p (cache)
425   (let ((from (message-fetch-field "from"))
426         found)
427     (while cache
428       (when (string-match (pop cache) from)
429         (setq found t
430               cache nil)))
431     found))
432
433 \f
434 ;;;; Training via Bogofilter.   Last updated 2002-09-02.
435
436 ;;; See Paul Graham article, at `http://www.paulgraham.com/spam.html'.
437
438 ;;; This page is for those wanting to control spam with the help of Eric
439 ;;; Raymond's speedy Bogofilter, see http://www.tuxedo.org/~esr/bogofilter.
440 ;;; This has been tested with a locally patched copy of version 0.4.
441
442 ;;; Make sure Bogofilter is installed.  Bogofilter internally uses Judy fast
443 ;;; associative arrays, so you need to install Judy first, and Bogofilter
444 ;;; next.  Fetch both distributions by visiting the following links and
445 ;;; downloading the latest version of each:
446 ;;;
447 ;;;     http://sourceforge.net/projects/judy/
448 ;;;     http://www.tuxedo.org/~esr/bogofilter/
449 ;;;
450 ;;; Unpack the Judy distribution and enter its main directory.  Then do:
451 ;;;
452 ;;;     ./configure
453 ;;;     make
454 ;;;     make install
455 ;;;
456 ;;; You will likely need to become super-user for the last step.  Then, unpack
457 ;;; the Bogofilter distribution and enter its main directory:
458 ;;;
459 ;;;     make
460 ;;;     make install
461 ;;;
462 ;;; Here as well, you need to become super-user for the last step.  Now,
463 ;;; initialize your word lists by doing, under your own identity:
464 ;;;
465 ;;;     mkdir ~/.bogofilter
466 ;;;     touch ~/.bogofilter/badlist
467 ;;;     touch ~/.bogofilter/goodlist
468 ;;;
469 ;;; These two files are text files you may edit, but you normally don't!
470
471 ;;; The `M-d' command gets added to Gnus summary mode, marking current article
472 ;;; as spam, showing it with the `H' mark.  Whenever you see a spam article,
473 ;;; make sure to mark its summary line with `M-d' before leaving the group.
474 ;;; Some groups, as per variable `spam-junk-mailgroups' below, receive articles
475 ;;; from Gnus splitting on clues added by spam recognisers, so for these
476 ;;; groups, we tack an `H' mark at group entry for all summary lines which
477 ;;; would otherwise have no other mark.  Make sure to _remove_ `H' marks for
478 ;;; any article which is _not_ genuine spam, before leaving such groups: you
479 ;;; may use `M-u' to "unread" the article, or `d' for declaring it read the
480 ;;; non-spam way.  When you leave a group, all `H' marked articles, saved or
481 ;;; unsaved, are sent to Bogofilter which will study them as spam samples.
482
483 ;;; Messages may also be deleted in various other ways, and unless
484 ;;; `spam-ham-marks-form' gets overridden below, marks `R' and `r' for default
485 ;;; read or explicit delete, marks `X' and 'K' for automatic or explicit
486 ;;; kills, as well as mark `Y' for low scores, are all considered to be
487 ;;; associated with articles which are not spam.  This assumption might be
488 ;;; false, in particular if you use kill files or score files as means for
489 ;;; detecting genuine spam, you should then adjust `spam-ham-marks-form'.  When
490 ;;; you leave a group, all _unsaved_ articles bearing any the above marks are
491 ;;; sent to Bogofilter which will study these as not-spam samples.  If you
492 ;;; explicit kill a lot, you might sometimes end up with articles marked `K'
493 ;;; which you never saw, and which might accidentally contain spam.  Best is
494 ;;; to make sure that real spam is marked with `H', and nothing else.
495
496 ;;; All other marks do not contribute to Bogofilter pre-conditioning.  In
497 ;;; particular, ticked, dormant or souped articles are likely to contribute
498 ;;; later, when they will get deleted for real, so there is no need to use
499 ;;; them prematurely.  Explicitly expired articles do not contribute, command
500 ;;; `E' is a way to get rid of an article without Bogofilter ever seeing it.
501
502 ;;; In a word, with a minimum of care for associating the `H' mark for spam
503 ;;; articles only, Bogofilter training all gets fairly automatic.  You should
504 ;;; do this until you get a few hundreds of articles in each category, spam
505 ;;; or not.  The shell command `head -1 ~/.bogofilter/*' shows both article
506 ;;; counts.  The command `S S' in summary mode, either for debugging or for
507 ;;; curiosity, triggers Bogofilter into displaying in another buffer the
508 ;;; "spamicity" score of the current article (between 0.0 and 1.0), together
509 ;;; with the article words which most significantly contribute to the score.
510
511 ;;; The real way for using Bogofilter, however, is to have some use tool like
512 ;;; `procmail' for invoking it on message reception, then adding some
513 ;;; recognisable header in case of detected spam.  Gnus splitting rules might
514 ;;; later trip on these added headers and react by sorting such articles into
515 ;;; specific junk folders as per `spam-junk-mailgroups'.  Here is a possible
516 ;;; `.procmailrc' contents (still untested -- please tell me how it goes):
517 ;;;
518 ;;; :0HBf:
519 ;;; * ? bogofilter
520 ;;; | formail -bfI "X-Spam-Status: Yes"
521
522 (defun spam-check-bogofilter ()
523   ;; Dynamic spam check.  I do not know how to check the exit status,
524   ;; so instead, read `bogofilter -v' output.
525   (when (and spam-use-bogofilter spam-bogofilter-path)
526     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
527     (when (save-excursion
528             (set-buffer spam-bogofilter-output-buffer-name)
529             (goto-char (point-min))
530             (re-search-forward "Spamicity: \\(0\\.9\\|1\\.0\\)" nil t))
531       spam-split-group)))
532
533 (defun spam-bogofilter-score ()
534   "Use `bogofilter -v' on the current article.
535 This yields the 15 most discriminant words for this article and the
536 spamicity coefficient of each, and the overall article spamicity."
537   (interactive)
538   (when (and spam-use-bogofilter spam-bogofilter-path)
539     (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number)))
540     (with-current-buffer spam-bogofilter-output-buffer-name
541       (unless (zerop (buffer-size))
542         (if (<= (count-lines (point-min) (point-max)) 1)
543             (progn
544               (goto-char (point-max))
545               (when (bolp)
546                 (backward-char 1))
547               (message "%s" (buffer-substring (point-min) (point))))
548           (goto-char (point-min))
549           (display-buffer (current-buffer)))))))
550
551 (defun spam-bogofilter-register-routine ()
552   (when (and spam-use-bogofilter spam-bogofilter-path)
553     (let ((articles gnus-newsgroup-articles)
554           article mark ham-articles spam-articles spam-mark-values ham-mark-values)
555
556       ;; marks are stored as symbolic values, so we have to dereference them for memq to work
557       ;; we wouldn't have to do this if gnus-summary-article-mark returned a symbol.
558       (dolist (mark spam-ham-marks)
559         (push (symbol-value mark) ham-mark-values))
560
561       (dolist (mark spam-spam-marks)
562         (push (symbol-value mark) spam-mark-values))
563
564       (while articles
565         (setq article (pop articles)
566               mark (gnus-summary-article-mark article))
567         (cond ((memq mark spam-mark-values) (push article spam-articles))
568               ((memq article gnus-newsgroup-saved))
569               ((memq mark ham-mark-values) (push article ham-articles))))
570       (when ham-articles
571         (spam-bogofilter-articles "ham" "-n" ham-articles))
572       (when spam-articles
573         (spam-bogofilter-articles "SPAM" "-s" spam-articles)))))
574
575 (defun spam-bogofilter-articles (type option articles)
576   (let ((output-buffer (get-buffer-create spam-bogofilter-output-buffer-name))
577         (article-copy (get-buffer-create " *Bogofilter Article Copy*"))
578         (remove-regexp (concat spam-bogofilter-spaminfo-header-regexp "\\|Xref:"))
579         (counter 0)
580         prefix process article)
581     (when type
582       (setq prefix (format "Studying %d articles as %s..." (length articles)
583                            type))
584       (message "%s" prefix))
585     (save-excursion (set-buffer output-buffer) (erase-buffer))
586     (setq process (start-process "bogofilter" output-buffer
587                                  spam-bogofilter-path "-F" option))
588     (process-kill-without-query process t)
589     (unwind-protect
590         (save-window-excursion
591           (while articles
592             (setq counter (1+ counter))
593             (when prefix
594               (message "%s %d" prefix counter))
595             (setq article (pop articles))
596             (gnus-summary-goto-subject article)
597             (gnus-summary-show-article t)
598             (gnus-eval-in-buffer-window article-copy
599               (insert-buffer-substring gnus-original-article-buffer)
600               ;; Remove spam classification redundant headers: they may induce
601               ;; unwanted biases in later analysis.
602               (message-remove-header remove-regexp t)
603               ;; Bogofilter really wants From envelopes for counting articles.
604               ;; Fake one at the beginning, make sure there will be no other.
605               (goto-char (point-min))
606               (if (looking-at "From ")
607                   (forward-line 1)
608                 (insert "From nobody " (current-time-string) "\n"))
609               (let (case-fold-search)
610                 (while (re-search-forward "^From " nil t)
611                   (beginning-of-line)
612                   (insert ">")))
613               (process-send-region process (point-min) (point-max))
614               (erase-buffer))))
615       ;; Sending the EOF is unwind-protected.  This is to prevent lost copies
616       ;; of `bogofilter', hung on reading their standard input, in case the
617       ;; whole registering process gets interrupted by the user.
618       (process-send-eof process))
619     (kill-buffer article-copy)
620     ;; Receive process output.  It sadly seems that we still have to protect
621     ;; ourselves against hung `bogofilter' processes.
622     (let ((status (process-status process))
623           (timeout (* 1000 spam-bogofilter-initial-timeout))
624           (quanta 200))                 ; also counted in milliseconds
625       (while (and (not (eq status 'exit)) (> timeout 0))
626         ;; `accept-process-output' timeout is counted in microseconds.
627         (setq timeout (if (accept-process-output process 0 (* 1000 quanta))
628                           (* 1000 spam-bogofilter-subsequent-timeout)
629                         (- timeout quanta))
630               status (process-status process)))
631       (if (eq status 'exit)
632           (when prefix
633             (message "%s done!" prefix))
634         ;; Sigh!  The process did time out...  Become brutal!
635         (interrupt-process process)
636         (message "%s %d INTERRUPTED!  (Article %d, status %s)"
637                  (or prefix "Bogofilter process...")
638                  counter article status)
639         ;; Give some time for user to read.  Sitting redisplays but gives up
640         ;; if input is pending.  Sleeping does not give up, but it does not
641         ;; redisplay either.  Mix both: let's redisplay and not give up.
642         (sit-for 1)
643         (sleep-for 3)))))
644
645 (provide 'spam)
646
647 ;;; spam.el ends here.