* lpath.el: Remove bbdb-create-internal, bbdb-records,
[gnus] / lisp / spam.el
1 ;;; spam.el --- Identifying spam
2 ;; Copyright (C) 2002, 2003, 2004 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 ;; TODO: cross-server splitting, remote processing, training through files
36
37 ;;; Code:
38
39 ;;{{{ compilation directives and autoloads/requires
40
41 (eval-when-compile (require 'cl))
42 (eval-when-compile (require 'spam-report))
43
44 (require 'gnus-sum)
45
46 (require 'gnus-uu)                      ; because of key prefix issues
47 ;;; for the definitions of group content classification and spam processors
48 (require 'gnus)
49 (require 'message)              ;for the message-fetch-field functions
50
51 ;; for nnimap-split-download-body-default
52 (eval-when-compile (require 'nnimap))
53
54 ;; autoload query-dig
55 (eval-and-compile
56   (autoload 'query-dig "dig"))
57
58 ;; autoload spam-report
59 (eval-and-compile
60   (autoload 'spam-report-gmane "spam-report")
61   (autoload 'spam-report-resend "spam-report"))
62
63 ;; autoload gnus-registry
64 (eval-and-compile
65   (autoload 'gnus-registry-group-count "gnus-registry")
66   (autoload 'gnus-registry-add-group "gnus-registry")
67   (autoload 'gnus-registry-store-extra-entry "gnus-registry")
68   (autoload 'gnus-registry-fetch-extra "gnus-registry"))
69
70 ;; autoload query-dns
71 (eval-and-compile
72   (autoload 'query-dns "dns"))
73
74 ;;}}}
75
76 ;;{{{ Main parameters.
77 (defvar spam-backends nil
78   "List of spam.el backends with all the pertinent data.
79 Populated by spam-install-backend-super.")
80
81 (defgroup spam nil
82   "Spam configuration."
83   :version "21.4")
84
85 (defcustom spam-summary-exit-behavior 'default
86   "Exit behavior at the time of summary exit.
87 Note that setting the spam-use-move or spam-use-copy backends on
88 a group through group/topic parameters overrides this mechanism."
89   :type '(choice (const 'default :tag 
90                         "Move spam out of all groups.  Move ham out of spam groups.")
91                  (const 'move-all :tag 
92                         "Move spam out of all groups.  Move ham out of all groups.")
93                  (const 'move-none :tag 
94                         "Never move spam or ham out of any groups."))
95   :group 'spam)
96
97 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
98   "Directory for spam whitelists and blacklists."
99   :type 'directory
100   :group 'spam)
101
102 (defcustom spam-mark-new-messages-in-spam-group-as-spam t
103   "Whether new messages in a spam group should get the spam-mark."
104   :type 'boolean
105   :group 'spam)
106
107 (defcustom spam-log-to-registry nil
108   "Whether spam/ham processing should be logged in the registry."
109   :type 'boolean
110   :group 'spam)
111
112 (defcustom spam-split-symbolic-return nil
113   "Whether `spam-split' should work with symbols or group names."
114   :type 'boolean
115   :group 'spam)
116
117 (defcustom spam-split-symbolic-return-positive nil
118   "Whether `spam-split' should ALWAYS work with symbols or group names.
119 Do not set this if you use `spam-split' in a fancy split
120   method."
121   :type 'boolean
122   :group 'spam)
123
124 (defcustom spam-mark-only-unseen-as-spam t
125   "Whether only unseen articles should be marked as spam in spam groups.
126 When nil, all unread articles in a spam group are marked as
127 spam.  Set this if you want to leave an article unread in a spam group
128 without losing it to the automatic spam-marking process."
129   :type 'boolean
130   :group 'spam)
131
132 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
133   "Whether ham should be marked unread before it's moved.
134 The article is moved out of a spam group according to ham-process-destination.
135 This variable is an official entry in the international Longest Variable Name
136 Competition."
137   :type 'boolean
138   :group 'spam)
139
140 (defcustom spam-disable-spam-split-during-ham-respool nil
141   "Whether `spam-split' should be ignored while resplitting ham.
142 This is useful to prevent ham from ending up in the same spam
143 group after the resplit.  Don't set this to t if you have `spam-split' as the
144 last rule in your split configuration."
145   :type 'boolean
146   :group 'spam)
147
148 (defcustom spam-autodetect-recheck-messages nil
149   "Should spam.el recheck all meessages when autodetecting?
150 Normally this is nil, so only unseen messages will be checked."
151   :type 'boolean
152   :group 'spam)
153
154 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
155   "The location of the whitelist.
156 The file format is one regular expression per line.
157 The regular expression is matched against the address."
158   :type 'file
159   :group 'spam)
160
161 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
162   "The location of the blacklist.
163 The file format is one regular expression per line.
164 The regular expression is matched against the address."
165   :type 'file
166   :group 'spam)
167
168 (defcustom spam-use-dig t
169   "Whether `query-dig' should be used instead of `query-dns'."
170   :type 'boolean
171   :group 'spam)
172
173 (defcustom spam-use-gmane-xref nil
174   "Whether the Gmane spam xref should be used by `spam-split'."
175   :type 'boolean
176   :group 'spam)
177
178 (defcustom spam-use-blacklist nil
179   "Whether the blacklist should be used by `spam-split'."
180   :type 'boolean
181   :group 'spam)
182
183 (defcustom spam-blacklist-ignored-regexes nil
184   "Regular expressions that the blacklist should ignore."
185   :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
186   :group 'spam)
187
188 (defcustom spam-use-whitelist nil
189   "Whether the whitelist should be used by `spam-split'."
190   :type 'boolean
191   :group 'spam)
192
193 (defcustom spam-use-whitelist-exclusive nil
194   "Whether whitelist-exclusive should be used by `spam-split'.
195 Exclusive whitelisting means that all messages from senders not in the whitelist
196 are considered spam."
197   :type 'boolean
198   :group 'spam)
199
200 (defcustom spam-use-blackholes nil
201   "Whether blackholes should be used by `spam-split'."
202   :type 'boolean
203   :group 'spam)
204
205 (defcustom spam-use-hashcash nil
206   "Whether hashcash payments should be detected by `spam-split'."
207   :type 'boolean
208   :group 'spam)
209
210 (defcustom spam-use-regex-headers nil
211   "Whether a header regular expression match should be used by `spam-split'.
212 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
213   :type 'boolean
214   :group 'spam)
215
216 (defcustom spam-use-regex-body nil
217   "Whether a body regular expression match should be used by `spam-split'.
218 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
219   :type 'boolean
220   :group 'spam)
221
222 (defcustom spam-use-bogofilter-headers nil
223   "Whether bogofilter headers should be used by `spam-split'.
224 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
225   :type 'boolean
226   :group 'spam)
227
228 (defcustom spam-use-bogofilter nil
229   "Whether bogofilter should be invoked by `spam-split'.
230 Enable this if you want Gnus to invoke Bogofilter on new messages."
231   :type 'boolean
232   :group 'spam)
233
234 (defcustom spam-use-bsfilter-headers nil
235   "Whether bsfilter headers should be used by `spam-split'.
236 Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them."
237   :type 'boolean
238   :group 'spam)
239
240 (defcustom spam-use-bsfilter nil
241   "Whether bsfilter should be invoked by `spam-split'.
242 Enable this if you want Gnus to invoke Bsfilter on new messages."
243   :type 'boolean
244   :group 'spam)
245
246 (defcustom spam-use-BBDB nil
247   "Whether BBDB should be used by `spam-split'."
248   :type 'boolean
249   :group 'spam)
250
251 (defcustom spam-use-BBDB-exclusive nil
252   "Whether BBDB-exclusive should be used by `spam-split'.
253 Exclusive BBDB means that all messages from senders not in the BBDB are
254 considered spam."
255   :type 'boolean
256   :group 'spam)
257
258 (defcustom spam-use-ifile nil
259   "Whether ifile should be used by `spam-split'."
260   :type 'boolean
261   :group 'spam)
262
263 (defcustom spam-use-stat nil
264   "Whether `spam-stat' should be used by `spam-split'."
265   :type 'boolean
266   :group 'spam)
267
268 (defcustom spam-use-spamoracle nil
269   "Whether spamoracle should be used by `spam-split'."
270   :type 'boolean
271   :group 'spam)
272
273 (defcustom spam-use-spamassassin nil
274   "Whether spamassassin should be invoked by `spam-split'.
275 Enable this if you want Gnus to invoke SpamAssassin on new messages."
276   :type 'boolean
277   :group 'spam)
278
279 (defcustom spam-use-spamassassin-headers nil
280   "Whether spamassassin headers should be checked by `spam-split'.
281 Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees
282 them."
283   :type 'boolean
284   :group 'spam)
285
286 (defcustom spam-use-crm114 nil
287   "Whether the CRM114 Mailfilter should be used by `spam-split'."
288   :type 'boolean
289   :group 'spam)
290
291 (defcustom spam-install-hooks (or
292                                spam-use-dig
293                                spam-use-gmane-xref
294                                spam-use-blacklist
295                                spam-use-whitelist
296                                spam-use-whitelist-exclusive
297                                spam-use-blackholes
298                                spam-use-hashcash
299                                spam-use-regex-headers
300                                spam-use-regex-body
301                                spam-use-bogofilter
302                                spam-use-bogofilter-headers
303                                spam-use-spamassassin
304                                spam-use-spamassassin-headers
305                                spam-use-bsfilter
306                                spam-use-bsfilter-headers
307                                spam-use-BBDB
308                                spam-use-BBDB-exclusive
309                                spam-use-ifile
310                                spam-use-stat
311                                spam-use-spamoracle
312                                spam-use-crm114)
313   "Whether the spam hooks should be installed.
314 Default to t if one of the spam-use-* variables is set."
315   :group 'spam
316   :type 'boolean)
317
318 (defcustom spam-split-group "spam"
319   "Group name where incoming spam should be put by `spam-split'."
320   :type 'string
321   :group 'spam)
322
323 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
324 ;;; not regular expressions
325 (defcustom spam-junk-mailgroups (cons
326                                  spam-split-group
327                                  '("mail.junk" "poste.pourriel"))
328   "Mailgroups with spam contents.
329 All unmarked article in such group receive the spam mark on group entry."
330   :type '(repeat (string :tag "Group"))
331   :group 'spam)
332
333
334 (defcustom spam-gmane-xref-spam-group "gmane.spam.detected"
335   "The group where spam xrefs can be found on Gmane.
336 Only meaningful if you enable `spam-use-gmane-xref'."
337   :type 'string
338   :group 'spam)
339
340 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
341                                     "dev.null.dk" "relays.visi.com")
342   "List of blackhole servers.
343 Only meaningful if you enable `spam-use-blackholes'."
344   :type '(repeat (string :tag "Server"))
345   :group 'spam)
346
347 (defcustom spam-blackhole-good-server-regex nil
348   "String matching IP addresses that should not be checked in the blackholes.
349 Only meaningful if you enable `spam-use-blackholes'."
350   :type '(radio (const nil) regexp)
351   :group 'spam)
352
353 (defcustom spam-face 'gnus-splash-face
354   "Face for spam-marked articles."
355   :type 'face
356   :group 'spam)
357
358 (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
359   "Regular expression for positive header spam matches.
360 Only meaningful if you enable `spam-use-regex-headers'."
361   :type '(repeat (regexp :tag "Regular expression to match spam header"))
362   :group 'spam)
363
364 (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
365   "Regular expression for positive header ham matches.
366 Only meaningful if you enable `spam-use-regex-headers'."
367   :type '(repeat (regexp :tag "Regular expression to match ham header"))
368   :group 'spam)
369
370 (defcustom spam-regex-body-spam '()
371   "Regular expression for positive body spam matches.
372 Only meaningful if you enable `spam-use-regex-body'."
373   :type '(repeat (regexp :tag "Regular expression to match spam body"))
374   :group 'spam)
375
376 (defcustom spam-regex-body-ham '()
377   "Regular expression for positive body ham matches.
378 Only meaningful if you enable `spam-use-regex-body'."
379   :type '(repeat (regexp :tag "Regular expression to match ham body"))
380   :group 'spam)
381
382 (defcustom spam-summary-score-preferred-header nil
383   "Preferred header to use for spam-summary-score."
384   :type '(choice :tag "Header name"
385           (symbol :tag "SpamAssassin etc" X-Spam-Status)
386           (symbol :tag "Bogofilter"       X-Bogosity)
387           (const  :tag "No preference, take best guess." nil))
388   :group 'spam)
389
390 (defgroup spam-ifile nil
391   "Spam ifile configuration."
392   :group 'spam)
393
394 (defcustom spam-ifile-path (executable-find "ifile")
395   "File path of the ifile executable program."
396   :type '(choice (file :tag "Location of ifile")
397                  (const :tag "ifile is not installed"))
398   :group 'spam-ifile)
399
400 (defcustom spam-ifile-database-path nil
401   "File path of the ifile database."
402   :type '(choice (file :tag "Location of the ifile database")
403                  (const :tag "Use the default"))
404   :group 'spam-ifile)
405
406 (defcustom spam-ifile-spam-category "spam"
407   "Name of the spam ifile category."
408   :type 'string
409   :group 'spam-ifile)
410
411 (defcustom spam-ifile-ham-category nil
412   "Name of the ham ifile category.
413 If nil, the current group name will be used."
414   :type '(choice (string :tag "Use a fixed category")
415                  (const :tag "Use the current group name"))
416   :group 'spam-ifile)
417
418 (defcustom spam-ifile-all-categories nil
419   "Whether the ifile check will return all categories, or just spam.
420 Set this to t if you want to use the `spam-split' invocation of ifile as
421 your main source of newsgroup names."
422   :type 'boolean
423   :group 'spam-ifile)
424
425 (defgroup spam-bogofilter nil
426   "Spam bogofilter configuration."
427   :group 'spam)
428
429 (defcustom spam-bogofilter-path (executable-find "bogofilter")
430   "File path of the Bogofilter executable program."
431   :type '(choice (file :tag "Location of bogofilter")
432                  (const :tag "Bogofilter is not installed"))
433   :group 'spam-bogofilter)
434
435 (defvar spam-bogofilter-valid 'unknown "Is the bogofilter version valid?")
436
437 (defcustom spam-bogofilter-header "X-Bogosity"
438   "The header that Bogofilter inserts in messages."
439   :type 'string
440   :group 'spam-bogofilter)
441
442 (defcustom spam-bogofilter-spam-switch "-s"
443   "The switch that Bogofilter uses to register spam messages."
444   :type 'string
445   :group 'spam-bogofilter)
446
447 (defcustom spam-bogofilter-ham-switch "-n"
448   "The switch that Bogofilter uses to register ham messages."
449   :type 'string
450   :group 'spam-bogofilter)
451
452 (defcustom spam-bogofilter-spam-strong-switch "-S"
453   "The switch that Bogofilter uses to unregister ham messages."
454   :type 'string
455   :group 'spam-bogofilter)
456
457 (defcustom spam-bogofilter-ham-strong-switch "-N"
458   "The switch that Bogofilter uses to unregister spam messages."
459   :type 'string
460   :group 'spam-bogofilter)
461
462 (defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
463   "The regex on `spam-bogofilter-header' for positive spam identification."
464   :type 'regexp
465   :group 'spam-bogofilter)
466
467 (defcustom spam-bogofilter-database-directory nil
468   "Directory path of the Bogofilter databases."
469   :type '(choice (directory
470                   :tag "Location of the Bogofilter database directory")
471                  (const :tag "Use the default"))
472   :group 'spam-bogofilter)
473
474 (defgroup spam-bsfilter nil
475   "Spam bsfilter configuration."
476   :group 'spam)
477
478 (defcustom spam-bsfilter-path (executable-find "bsfilter")
479   "File path of the Bsfilter executable program."
480   :type '(choice (file :tag "Location of bsfilter")
481                  (const :tag "Bsfilter is not installed"))
482   :group 'spam-bsfilter)
483
484 (defcustom spam-bsfilter-header "X-Spam-Flag"
485   "The header inserted by Bsfilter to flag spam."
486   :type 'string
487   :group 'spam-bsfilter)
488
489 (defcustom spam-bsfilter-probability-header "X-Spam-Probability"
490   "The header that Bsfilter inserts in messages."
491   :type 'string
492   :group 'spam-bsfilter)
493
494 (defcustom spam-bsfilter-spam-switch "--add-spam"
495   "The switch that Bsfilter uses to register spam messages."
496   :type 'string
497   :group 'spam-bsfilter)
498
499 (defcustom spam-bsfilter-ham-switch "--add-ham"
500   "The switch that Bsfilter uses to register ham messages."
501   :type 'string
502   :group 'spam-bsfilter)
503
504 (defcustom spam-bsfilter-spam-strong-switch "--sub-spam"
505   "The switch that Bsfilter uses to unregister ham messages."
506   :type 'string
507   :group 'spam-bsfilter)
508
509 (defcustom spam-bsfilter-ham-strong-switch "--sub-clean"
510   "The switch that Bsfilter uses to unregister spam messages."
511   :type 'string
512   :group 'spam-bsfilter)
513
514 (defcustom spam-bsfilter-database-directory nil
515   "Directory path of the Bsfilter databases."
516   :type '(choice (directory
517                   :tag "Location of the Bsfilter database directory")
518                  (const :tag "Use the default"))
519   :group 'spam-bsfilter)
520
521 (defgroup spam-spamoracle nil
522   "Spam spamoracle configuration."
523   :group 'spam)
524
525 (defcustom spam-spamoracle-database nil
526   "Location of spamoracle database file.
527 When nil, use the default spamoracle database."
528   :type '(choice (directory :tag "Location of spamoracle database file.")
529                  (const :tag "Use the default"))
530   :group 'spam-spamoracle)
531
532 (defcustom spam-spamoracle-binary (executable-find "spamoracle")
533   "Location of the spamoracle binary."
534   :type '(choice (directory :tag "Location of the spamoracle binary")
535                  (const :tag "Use the default"))
536   :group 'spam-spamoracle)
537
538 (defgroup spam-spamassassin nil
539   "Spam SpamAssassin configuration."
540   :group 'spam)
541
542 (defcustom spam-spamassassin-path (executable-find "spamassassin")
543   "File path of the spamassassin executable program.
544 Hint: set this to \"spamc\" if you have spamd running.  See the spamc and
545 spamd man pages for more information on these programs."
546   :type '(choice (file :tag "Location of spamc")
547                  (const :tag "spamassassin is not installed"))
548   :group 'spam-spamassassin)
549
550 (defcustom spam-spamassassin-arguments ()
551   "Arguments to pass to the spamassassin executable.
552 This must be a list.  For example, `(\"-C\" \"configfile\")'."
553   :type '(restricted-sexp :match-alternatives (listp))
554   :group 'spam-spamassassin)
555
556 (defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag"
557   "The header inserted by SpamAssassin to flag spam."
558   :type 'string
559   :group 'spam-spamassassin)
560
561 (defcustom spam-spamassassin-positive-spam-flag-header "YES"
562   "The regex on `spam-spamassassin-spam-flag-header' for positive spam
563 identification"
564   :type 'string
565   :group 'spam-spamassassin)
566
567 (defcustom spam-spamassassin-spam-status-header "X-Spam-Status"
568   "The header inserted by SpamAssassin, giving extended scoring information"
569   :type 'string
570   :group 'spam-spamassassin)
571
572 (defcustom spam-sa-learn-path (executable-find "sa-learn")
573   "File path of the sa-learn executable program."
574   :type '(choice (file :tag "Location of spamassassin")
575                  (const :tag "spamassassin is not installed"))
576   :group 'spam-spamassassin)
577
578 (defcustom spam-sa-learn-rebuild t
579   "Whether sa-learn should rebuild the database every time it is called
580 Enable this if you want sa-learn to rebuild the database automatically.  Doing
581 this will slightly increase the running time of the spam registration process.
582 If you choose not to do this, you will have to run \"sa-learn --rebuild\" in
583 order for SpamAssassin to recognize the new registered spam."
584   :type 'boolean
585   :group 'spam-spamassassin)
586
587 (defcustom spam-sa-learn-spam-switch "--spam"
588   "The switch that sa-learn uses to register spam messages"
589   :type 'string
590   :group 'spam-spamassassin)
591
592 (defcustom spam-sa-learn-ham-switch "--ham"
593   "The switch that sa-learn uses to register ham messages"
594   :type 'string
595   :group 'spam-spamassassin)
596
597 (defcustom spam-sa-learn-unregister-switch "--forget"
598   "The switch that sa-learn uses to unregister messages messages"
599   :type 'string
600   :group 'spam-spamassassin)
601
602 (defgroup spam-crm114 nil
603   "Spam CRM114 Mailfilter configuration."
604   :group 'spam)
605
606 (defcustom spam-crm114-program (executable-find "mailfilter.crm")
607   "File path of the CRM114 Mailfilter executable program."
608   :type '(choice (file :tag "Location of CRM114 Mailfilter")
609          (const :tag "CRM114 Mailfilter is not installed"))
610   :group 'spam-crm114)
611
612 (defcustom spam-crm114-header "X-CRM114-Status"
613   "The header that CRM114 Mailfilter inserts in messages."
614   :type 'string
615   :group 'spam-crm114)
616
617 (defcustom spam-crm114-spam-switch "--learnspam"
618   "The switch that CRM114 Mailfilter uses to register spam messages."
619   :type 'string
620   :group 'spam-crm114)
621
622 (defcustom spam-crm114-ham-switch "--learnnonspam"
623   "The switch that CRM114 Mailfilter uses to register ham messages."
624   :type 'string
625   :group 'spam-crm114)
626
627 (defcustom spam-crm114-spam-strong-switch "--UNKNOWN"
628   "The switch that CRM114 Mailfilter uses to unregister ham messages."
629   :type 'string
630   :group 'spam-crm114)
631
632 (defcustom spam-crm114-ham-strong-switch "--UNKNOWN"
633   "The switch that CRM114 Mailfilter uses to unregister spam messages."
634   :type 'string
635   :group 'spam-crm114)
636
637 (defcustom spam-crm114-positive-spam-header "^SPAM"
638   "The regex on `spam-crm114-header' for positive spam identification."
639   :type 'regexp
640   :group 'spam-crm114)
641
642 (defcustom spam-crm114-database-directory nil
643   "Directory path of the CRM114 Mailfilter databases."
644   :type '(choice (directory
645           :tag "Location of the CRM114 Mailfilter database directory")
646          (const :tag "Use the default"))
647   :group 'spam-crm114)
648
649 ;;; Key bindings for spam control.
650
651 (gnus-define-keys gnus-summary-mode-map
652   "St" spam-generic-score
653   "Sx" gnus-summary-mark-as-spam
654   "Mst" spam-generic-score
655   "Msx" gnus-summary-mark-as-spam
656   "\M-d" gnus-summary-mark-as-spam)
657
658 (defvar spam-cache-lookups t
659   "Whether spam.el will try to cache lookups using `spam-caches'.")
660
661 (defvar spam-caches (make-hash-table
662                      :size 10
663                      :test 'equal)
664   "Cache of spam detection entries.")
665
666 (defvar spam-old-articles nil
667   "List of old ham and spam articles, generated when a group is entered.")
668
669 (defvar spam-split-disabled nil
670   "If non-nil, `spam-split' is disabled, and always returns nil.")
671
672 (defvar spam-split-last-successful-check nil
673   "Internal variable.
674 `spam-split' will set this to nil or a spam-use-XYZ check if it
675 finds ham or spam.")
676
677 ;; internal variables for backends
678 ;; TODO: find a way to create these on the fly in spam-install-backend-super
679 (defvar spam-use-copy nil)
680 (defvar spam-use-move nil)
681 (defvar spam-use-gmane nil)
682 (defvar spam-use-resend nil)
683
684 ;;}}}
685
686 ;;{{{ convenience functions
687
688 (defun spam-clear-cache (symbol)
689   "Clear the spam-caches entry for a check."
690   (remhash symbol spam-caches))
691
692 (defun spam-xor (a b)
693   "Logical A xor B."
694   (and (or a b) (not (and a b))))
695
696 (defun spam-set-difference (list1 list2)
697   "Return a set difference of LIST1 and LIST2.  
698 When either list is nil, the other is returned."
699   (if (and list1 list2)
700       ;; we have two non-nil lists
701       (progn
702         (dolist (item (append list1 list2))
703           (when (and (memq item list1) (memq item list2))
704             (setq list1 (delq item list1))
705             (setq list2 (delq item list2))))
706         (append list1 list2))
707     ;; if either of the lists was nil, return the other one
708     (if list1 list1 list2)))
709
710 (defun spam-group-ham-mark-p (group mark &optional spam)
711   "Checks if MARK is considered a ham mark in GROUP."
712   (when (stringp group)
713     (let* ((marks (spam-group-ham-marks group spam))
714            (marks (if (symbolp mark)
715                       marks
716                     (mapcar 'symbol-value marks))))
717       (memq mark marks))))
718
719 (defun spam-group-spam-mark-p (group mark)
720   "Checks if MARK is considered a spam mark in GROUP."
721   (spam-group-ham-mark-p group mark t))
722
723 (defun spam-group-ham-marks (group &optional spam)
724   "In GROUP, get all the ham marks."
725   (when (stringp group)
726     (let* ((marks (if spam
727                       (gnus-parameter-spam-marks group)
728                     (gnus-parameter-ham-marks group)))
729            (marks (car marks))
730            (marks (if (listp (car marks)) (car marks) marks)))
731       marks)))
732
733 (defun spam-group-spam-marks (group)
734   "In GROUP, get all the spam marks."
735   (spam-group-ham-marks group t))
736
737 (defun spam-group-spam-contents-p (group)
738   "Is GROUP a spam group?"
739   (if (and (stringp group) (< 0 (length group)))
740       (or (member group spam-junk-mailgroups)
741           (memq 'gnus-group-spam-classification-spam
742                 (gnus-parameter-spam-contents group)))
743     nil))
744
745 (defun spam-group-ham-contents-p (group)
746   "Is GROUP a ham group?"
747   (if (stringp group)
748       (memq 'gnus-group-spam-classification-ham
749             (gnus-parameter-spam-contents group))
750     nil))
751
752 (defun spam-classifications ()
753   "Return list of valid classifications"
754   '(spam ham))
755
756 (defun spam-classification-valid-p (classification)
757   "Is CLASSIFICATION a valid spam/ham classification?"
758   (memq classification (spam-classifications)))
759
760 (defun spam-backend-properties ()
761   "Return list of valid classifications."
762   '(statistical mover check hrf srf huf suf))
763
764 (defun spam-backend-property-valid-p (property)
765   "Is PROPERTY a valid backend property?"
766   (memq property (spam-backend-properties)))
767
768 (defun spam-backend-function-type-valid-p (type)
769   (or (eq type 'registration)
770       (eq type 'unregistration)))
771
772 (defun spam-process-type-valid-p (process-type)
773   (or (eq process-type 'incoming)
774       (eq process-type 'process)))
775
776 (defun spam-list-articles (articles classification)
777   (let ((mark-check (if (eq classification 'spam)
778                         'spam-group-spam-mark-p
779                       'spam-group-ham-mark-p))
780         alist mark-cache-yes mark-cache-no)
781     (dolist (article articles)
782       (let ((mark (gnus-summary-article-mark article)))
783         (unless (or (memq mark mark-cache-yes)
784                     (memq mark mark-cache-no))
785           (if (funcall mark-check
786                        gnus-newsgroup-name
787                        mark)
788               (push mark mark-cache-yes)
789             (push mark mark-cache-no)))
790         (when (memq mark mark-cache-yes)
791           (push article alist))))
792     alist))
793
794 ;;}}}
795
796 ;;{{{ backend installation functions and procedures
797
798 (defun spam-install-backend-super (backend &rest properties)
799   "Install BACKEND for spam.el.
800 Accepts incoming CHECK, ham registration function HRF, spam
801 registration function SRF, ham unregistration function HUF, spam
802 unregistration function SUF, and an indication whether the
803 backend is STATISTICAL."
804
805   (setq spam-backends (add-to-list 'spam-backends backend))
806   (while properties
807     (let ((property (pop properties))
808           (value (pop properties)))
809       (if (spam-backend-property-valid-p property)
810           (put backend property value)
811         (gnus-error 
812          5 
813          "spam-install-backend-super got an invalid property %s"
814          property)))))
815
816 (defun spam-backend-list (&optional type)
817   "Return a list of all the backend symbols, constrained by TYPE.
818 When TYPE is 'non-mover, only non-mover backends are returned.
819 When TYPE is 'mover, only mover backends are returned."
820   (let (list)
821     (dolist (backend spam-backends)
822       (when (or
823              (null type)                ;either no type was requested
824              ;; or the type is 'mover and the backend is a mover
825              (and
826               (eq type 'mover)
827               (spam-backend-mover-p backend))
828              ;; or the type is 'non-mover and the backend is not a mover
829              (and
830               (eq type 'non-mover)
831               (not (spam-backend-mover-p backend))))
832         (push backend list)))
833       list))
834
835 (defun spam-backend-check (backend)
836   "Get the check function for BACKEND.
837 Each individual check may return nil, t, or a mailgroup name.
838 The value nil means that the check does not yield a decision, and
839 so, that further checks are needed.  The value t means that the
840 message is definitely not spam, and that further spam checks
841 should be inhibited.  Otherwise, a mailgroup name or the symbol
842 'spam (depending on spam-split-symbolic-return) is returned where
843 the mail should go, and further checks are also inhibited.  The
844 usual mailgroup name is the value of `spam-split-group', meaning
845 that the message is definitely a spam."
846   (get backend 'check))
847
848 (defun spam-backend-valid-p (backend)
849   "Is BACKEND valid?"
850   (member backend (spam-backend-list)))
851
852 (defun spam-backend-info (backend)
853   "Return information about BACKEND."
854   (if (spam-backend-valid-p backend)
855       (let (info)
856         (setq info (format "Backend %s has the following properties:\n"
857                            backend))
858         (dolist (property (spam-backend-properties))
859           (setq info (format "%s%s=%s\n" 
860                              info
861                              property
862                              (get backend property))))
863         info)
864     (gnus-error 5 "spam-backend-info was asked about an invalid backend %s"
865                 backend)))
866
867 (defun spam-backend-function (backend classification type)
868   "Get the BACKEND function for CLASSIFICATION and TYPE.
869 TYPE is 'registration or 'unregistration.
870 CLASSIFICATION is 'ham or 'spam."
871   (if (and
872        (spam-classification-valid-p classification)
873        (spam-backend-function-type-valid-p type))
874       (let ((retrieval 
875              (intern 
876               (format "spam-backend-%s-%s-function"
877                       classification
878                       type))))
879         (funcall retrieval backend))
880     (gnus-error 
881      5
882      "%s was passed invalid backend %s, classification %s, or type %s"
883      "spam-backend-function"
884      backend
885      classification
886      type)))
887
888 (defun spam-backend-article-list-property (classification 
889                                            &optional unregister)
890   "Property name of article list with CLASSIFICATION and UNREGISTER."
891   (let* ((r (if unregister "unregister" "register"))
892          (prop (format "%s-%s" classification r)))
893     prop))
894
895 (defun spam-backend-get-article-todo-list (backend 
896                                            classification 
897                                            &optional unregister)
898   "Get the articles to be processed for BACKEND and CLASSIFICATION.  
899 With UNREGISTER, get articles to be unregistered.
900 This is a temporary storage function - nothing here persists."
901   (get
902    backend 
903    (intern (spam-backend-article-list-property classification unregister))))
904
905 (defun spam-backend-put-article-todo-list (backend classification list &optional unregister)
906   "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION.
907 With UNREGISTER, set articles to be unregistered.
908 This is a temporary storage function - nothing here persists."
909   (put
910    backend
911    (intern (spam-backend-article-list-property classification unregister))
912    list))
913
914 (defun spam-backend-ham-registration-function (backend)
915   "Get the ham registration function for BACKEND."
916   (get backend 'hrf))
917
918 (defun spam-backend-spam-registration-function (backend)
919   "Get the spam registration function for BACKEND."
920   (get backend 'srf))
921
922 (defun spam-backend-ham-unregistration-function (backend)
923   "Get the ham unregistration function for BACKEND."
924   (get backend 'huf))
925
926 (defun spam-backend-spam-unregistration-function (backend)
927   "Get the spam unregistration function for BACKEND."
928   (get backend 'suf))
929
930 (defun spam-backend-statistical-p (backend)
931   "Is BACKEND statistical?"
932   (get backend 'statistical))
933
934 (defun spam-backend-mover-p (backend)
935   "Is BACKEND a mover?"
936   (get backend 'mover))
937
938 (defun spam-install-backend-alias (backend alias)
939   "Add ALIAS to an existing BACKEND.
940 The previous backend settings for ALIAS are erased."
941
942   ;; install alias with no properties at first
943   (spam-install-backend-super alias)
944   
945   (dolist (property (spam-backend-properties))
946     (put alias property (get backend property))))
947
948 (defun spam-install-checkonly-backend (backend check)
949   "Install a BACKEND than can only CHECK for spam."
950   (spam-install-backend-super backend 'check check))
951
952 (defun spam-install-mover-backend (backend hrf srf huf suf)
953   "Install a BACKEND than can move articles at summary exit.
954 Accepts ham registration function HRF, spam registration function
955 SRF, ham unregistration function HUF, spam unregistration
956 function SUF.  The backend has no incoming check and can't be
957 statistical."
958   (spam-install-backend-super 
959    backend 
960    'hrf hrf 'srf srf 'huf huf 'suf suf 'mover t))
961
962 (defun spam-install-nocheck-backend (backend hrf srf huf suf)
963   "Install a BACKEND than has no check.
964 Accepts ham registration function HRF, spam registration function
965 SRF, ham unregistration function HUF, spam unregistration
966 function SUF.  The backend has no incoming check and can't be
967 statistical (it could be, but in practice that doesn't happen)."
968   (spam-install-backend-super 
969    backend
970    'hrf hrf 'srf srf 'huf huf 'suf suf))
971
972 (defun spam-install-backend (backend check hrf srf huf suf)
973   "Install a BACKEND.
974 Accepts incoming CHECK, ham registration function HRF, spam
975 registration function SRF, ham unregistration function HUF, spam
976 unregistration function SUF.  The backend won't be
977 statistical (use spam-install-statistical-backend for that)."
978   (spam-install-backend-super 
979    backend
980    'check check 'hrf hrf 'srf srf 'huf huf 'suf suf))
981
982 (defun spam-install-statistical-backend (backend check hrf srf huf suf)
983   "Install a BACKEND.
984 Accepts incoming CHECK, ham registration function HRF, spam
985 registration function SRF, ham unregistration function HUF, spam
986 unregistration function SUF.  The backend will be
987 statistical (use spam-install-backend for non-statistical
988 backends)."
989   (spam-install-backend-super 
990    backend
991    'check check 'statistical t 'hrf hrf 'srf srf 'huf huf 'suf suf))
992
993 (defun spam-install-statistical-checkonly-backend (backend check)
994   "Install a statistical BACKEND than can only CHECK for spam."
995   (spam-install-backend-super 
996    backend
997    'check check 'statistical t))
998
999 ;;}}}
1000
1001 ;;{{{ backend installations
1002 (spam-install-checkonly-backend 'spam-use-blackholes
1003                                 'spam-check-blackholes)
1004
1005 (spam-install-checkonly-backend 'spam-use-hashcash
1006                                 'spam-check-hashcash)
1007
1008 (spam-install-checkonly-backend 'spam-use-spamassassin-headers
1009                                 'spam-check-spamassassin-headers)
1010
1011 (spam-install-checkonly-backend 'spam-use-bogofilter-headers
1012                                 'spam-check-bogofilter-headers)
1013
1014 (spam-install-checkonly-backend 'spam-use-bsfilter-headers
1015                                 'spam-check-bsfilter-headers)
1016
1017 (spam-install-checkonly-backend 'spam-use-gmane-xref
1018                                 'spam-check-gmane-xref)
1019
1020 (spam-install-checkonly-backend 'spam-use-regex-headers
1021                                 'spam-check-regex-headers)
1022
1023 (spam-install-statistical-checkonly-backend 'spam-use-regex-body
1024                                             'spam-check-regex-body)
1025
1026 ;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) instead
1027 (spam-install-mover-backend 'spam-use-move
1028                             'spam-move-ham-routine
1029                             'spam-move-spam-routine
1030                             nil
1031                             nil)
1032
1033 (spam-install-nocheck-backend 'spam-use-copy
1034                               'spam-copy-ham-routine
1035                               'spam-copy-spam-routine
1036                               nil
1037                               nil)
1038
1039 (spam-install-nocheck-backend 'spam-use-gmane
1040                               nil
1041                               'spam-report-gmane-register-routine
1042                               ;; does Gmane support unregistration?
1043                               nil
1044                               nil)
1045
1046 (spam-install-nocheck-backend 'spam-use-resend
1047                               'spam-report-resend-register-ham-routine
1048                               'spam-report-resend-register-routine
1049                               nil
1050                               nil)
1051
1052 (spam-install-backend 'spam-use-BBDB     
1053                       'spam-check-BBDB
1054                       'spam-BBDB-register-routine
1055                       nil
1056                       'spam-BBDB-unregister-routine
1057                       nil)
1058
1059 (spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive)
1060
1061 (spam-install-backend 'spam-use-blacklist
1062                       'spam-check-blacklist
1063                       nil
1064                       'spam-blacklist-register-routine
1065                       nil
1066                       'spam-blacklist-unregister-routine)
1067
1068 (spam-install-backend 'spam-use-whitelist
1069                       'spam-check-whitelist
1070                       'spam-whitelist-register-routine
1071                       nil
1072                       'spam-whitelist-unregister-routine
1073                       nil)
1074
1075 (spam-install-statistical-backend 'spam-use-ifile
1076                                   'spam-check-ifile
1077                                   'spam-ifile-register-ham-routine
1078                                   'spam-ifile-register-spam-routine
1079                                   'spam-ifile-unregister-ham-routine
1080                                   'spam-ifile-unregister-spam-routine)
1081
1082 (spam-install-statistical-backend 'spam-use-spamoracle
1083                                   'spam-check-spamoracle
1084                                   'spam-spamoracle-learn-ham
1085                                   'spam-spamoracle-learn-spam
1086                                   'spam-spamoracle-unlearn-ham
1087                                   'spam-spamoracle-unlearn-spam)
1088
1089 (spam-install-statistical-backend 'spam-use-stat
1090                                   'spam-check-stat
1091                                   'spam-stat-register-ham-routine
1092                                   'spam-stat-register-spam-routine
1093                                   'spam-stat-unregister-ham-routine
1094                                   'spam-stat-unregister-spam-routine)
1095
1096 (spam-install-statistical-backend 'spam-use-spamassassin 
1097                                   'spam-check-spamassassin
1098                                   'spam-spamassassin-register-ham-routine
1099                                   'spam-spamassassin-register-spam-routine
1100                                   'spam-spamassassin-unregister-ham-routine
1101                                   'spam-spamassassin-unregister-spam-routine)
1102
1103 (spam-install-statistical-backend 'spam-use-bogofilter
1104                                   'spam-check-bogofilter
1105                                   'spam-bogofilter-register-ham-routine
1106                                   'spam-bogofilter-register-spam-routine
1107                                   'spam-bogofilter-unregister-ham-routine
1108                                   'spam-bogofilter-unregister-spam-routine)
1109
1110 (spam-install-statistical-backend 'spam-use-bsfilter
1111                                   'spam-check-bsfilter
1112                                   'spam-bsfilter-register-ham-routine
1113                                   'spam-bsfilter-register-spam-routine
1114                                   'spam-bsfilter-unregister-ham-routine
1115                                   'spam-bsfilter-unregister-spam-routine)
1116
1117 (spam-install-statistical-backend 'spam-use-crm114
1118                                   'spam-check-crm114
1119                                   'spam-crm114-register-ham-routine
1120                                   'spam-crm114-register-spam-routine
1121                                   ;; does CRM114 Mailfilter support unregistration?
1122                                   nil
1123                                   nil)
1124
1125 ;;}}}
1126
1127 ;;{{{ scoring and summary formatting
1128 (defun spam-necessary-extra-headers ()
1129   "Return the extra headers spam.el thinks are necessary."
1130   (let (list)
1131     (when (or spam-use-spamassassin
1132               spam-use-spamassassin-headers
1133               spam-use-regex-headers)
1134       (push 'X-Spam-Status list))
1135     (when spam-use-bogofilter
1136       (push 'X-Bogosity list))
1137     list))
1138
1139 (defun spam-user-format-function-S (headers)
1140   (when headers
1141     (format "%3.2f"
1142             (spam-summary-score headers spam-summary-score-preferred-header))))
1143
1144 (defun spam-article-sort-by-spam-status (h1 h2)
1145   "Sort articles by score."
1146   (let (result)
1147     (dolist (header (spam-necessary-extra-headers))
1148       (let ((s1 (spam-summary-score h1 header))
1149             (s2 (spam-summary-score h2 header)))
1150       (unless (= s1 s2)
1151         (setq result (< s1 s2))
1152         (return))))
1153     result))
1154
1155 (defun spam-extra-header-to-number (header headers)
1156   "Transform an extra HEADER to a number, using list of HEADERS.
1157 Note this has to be fast."
1158   (if (gnus-extra-header header headers)
1159       (cond
1160        ((eq header 'X-Spam-Status)
1161         (string-to-number (gnus-replace-in-string
1162                            (gnus-extra-header header headers)
1163                            ".*hits=" "")))
1164        ;; for CRM checking, it's probably faster to just do the string match
1165        ((and spam-use-crm114 (string-match "( pR: \\([0-9.-]+\\)" header))
1166         (match-string 1 header))
1167        ((eq header 'X-Bogosity)
1168         (string-to-number (gnus-replace-in-string
1169                            (gnus-replace-in-string
1170                             (gnus-extra-header header headers)
1171                             ".*spamicity=" "")
1172                            ",.*" "")))
1173        (t nil))
1174     nil))
1175
1176 (defun spam-summary-score (headers &optional specific-header)
1177   "Score an article for the summary buffer, as fast as possible.
1178 With SPECIFIC-HEADER, returns only that header's score.
1179 Will not return a nil score."
1180   (let (score)
1181     (dolist (header 
1182              (if specific-header
1183                  (list specific-header)
1184                (spam-necessary-extra-headers)))
1185       (setq score 
1186             (spam-extra-header-to-number header headers))
1187       (when score 
1188         (return)))
1189     (or score 0)))
1190
1191 (defun spam-generic-score (&optional recheck)
1192   "Invoke whatever scoring method we can."
1193   (interactive "P")
1194   (cond
1195    ((or spam-use-spamassassin spam-use-spamassassin-headers)
1196     (spam-spamassassin-score recheck))
1197    ((or spam-use-bsfilter spam-use-bsfilter-headers)
1198     (spam-bsfilter-score recheck))
1199    (spam-use-crm114
1200     (spam-crm114-score))
1201    (t (spam-bogofilter-score recheck))))
1202 ;;}}}
1203
1204 ;;{{{ set up widening, processor checks
1205
1206 ;;; set up IMAP widening if it's necessary
1207 (defun spam-setup-widening ()
1208   (when (spam-widening-needed-p)
1209     (setq nnimap-split-download-body-default t)))
1210
1211 (defun spam-widening-needed-p (&optional force-symbols)
1212   (let (found)
1213     (dolist (backend (spam-backend-list))
1214       (when (and (spam-backend-statistical-p backend)
1215                  (or (symbol-value backend) 
1216                      (memq backend force-symbols)))
1217         (setq found backend)))
1218     found))
1219
1220 (defvar spam-list-of-processors
1221   ;; note the nil processors are not defined in gnus.el
1222   '((gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
1223     (gnus-group-spam-exit-processor-bsfilter     spam spam-use-bsfilter)
1224     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
1225     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
1226     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
1227     (gnus-group-spam-exit-processor-spamoracle   spam spam-use-spamoracle)
1228     (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
1229     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
1230     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
1231     (gnus-group-ham-exit-processor-bsfilter      ham spam-use-bsfilter)
1232     (gnus-group-ham-exit-processor-stat          ham spam-use-stat)
1233     (gnus-group-ham-exit-processor-whitelist     ham spam-use-whitelist)
1234     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
1235     (gnus-group-ham-exit-processor-copy          ham spam-use-ham-copy)
1236     (gnus-group-ham-exit-processor-spamassassin  ham spam-use-spamassassin)
1237     (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle))
1238   "The OBSOLETE `spam-list-of-processors' list.
1239 This list contains pairs associating the obsolete ham/spam exit
1240 processor variables with a classification and a spam-use-*
1241 variable.  When the processor variable is nil, just the
1242 classification and spam-use-* check variable are used.  This is
1243 superceded by the new spam backend code, so it's only consulted
1244 for backwards compatibility.")
1245
1246 (defun spam-group-processor-p (group backend &optional classification)
1247   "Checks if GROUP has a BACKEND with CLASSIFICATION registered.
1248 Also accepts the obsolete processors, which can be found in
1249 gnus.el and in spam-list-of-processors.  In the case of mover
1250 backends, checks the setting of spam-summary-exit-behavior in
1251 addition to the set values for the group."
1252   (if (and (stringp group)
1253            (symbolp backend))
1254       (let ((old-style (assq backend spam-list-of-processors))
1255             (parameters (nth 0 (gnus-parameter-spam-process group)))
1256             found)
1257         (if old-style  ; old-style processor
1258             (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style))
1259           ;; now search for the parameter
1260           (dolist (parameter parameters)
1261             (when (and (null found)
1262                        (listp parameter)
1263                        (eq classification (nth 0 parameter))
1264                        (eq backend (nth 1 parameter)))
1265               (setq found t)))
1266
1267           ;; now, if the parameter was not found, do the
1268           ;; spam-summary-exit-behavior-logic for mover backends
1269           (unless found
1270             (when (spam-backend-mover-p backend)
1271               (setq 
1272                found
1273                (cond
1274                 ((eq spam-summary-exit-behavior 'move-all) t)
1275                 ((eq spam-summary-exit-behavior 'move-none) nil)
1276                 ((eq spam-summary-exit-behavior 'default)
1277                  (or (eq classification 'spam) ;move spam out of all groups
1278                      ;; move ham out of spam groups
1279                      (and (eq classification 'ham)
1280                           (spam-group-spam-contents-p group))))
1281                 (t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s" 
1282                                spam-summary-exit-behavior))))))
1283
1284           found))
1285     nil))
1286
1287 ;;}}}
1288
1289 ;;{{{ Summary entry and exit processing.
1290
1291 (defun spam-mark-junk-as-spam-routine ()
1292   ;; check the global list of group names spam-junk-mailgroups and the
1293   ;; group parameters
1294   (when (spam-group-spam-contents-p gnus-newsgroup-name)
1295     (gnus-message 6 "Marking %s articles as spam"
1296                   (if spam-mark-only-unseen-as-spam
1297                       "unseen"
1298                     "unread"))
1299     (let ((articles (if spam-mark-only-unseen-as-spam
1300                         gnus-newsgroup-unseen
1301                       gnus-newsgroup-unreads)))
1302       (if spam-mark-new-messages-in-spam-group-as-spam
1303           (dolist (article articles)
1304             (gnus-summary-mark-article article gnus-spam-mark))
1305         (gnus-message 9 "Did not mark new messages as spam.")))))
1306
1307 (defun spam-summary-prepare ()
1308   (setq spam-old-articles
1309         (list (cons 'ham (spam-list-articles gnus-newsgroup-articles 'ham))
1310               (cons 'spam (spam-list-articles gnus-newsgroup-articles 'spam))))
1311   (spam-mark-junk-as-spam-routine))
1312
1313 ;; The spam processors are invoked for any group, spam or ham or neither
1314 (defun spam-summary-prepare-exit ()
1315   (unless gnus-group-is-exiting-without-update-p
1316     (gnus-message 6 "Exiting summary buffer and applying spam rules")
1317
1318     ;; first of all, unregister any articles that are no longer ham or spam
1319     ;; we have to iterate over the processors, or else we'll be too slow
1320     (dolist (classification (spam-classifications))
1321       (let* ((old-articles (cdr-safe (assq classification spam-old-articles)))
1322              (new-articles (spam-list-articles
1323                             gnus-newsgroup-articles
1324                             classification))
1325              (changed-articles (spam-set-difference new-articles old-articles)))
1326         ;; now that we have the changed articles, we go through the processors
1327         (dolist (backend (spam-backend-list))
1328           (let (unregister-list)
1329             (dolist (article changed-articles)
1330               (let ((id (spam-fetch-field-message-id-fast article)))
1331                 (when (spam-log-unregistration-needed-p
1332                        id 'process classification backend)
1333                   (push article unregister-list))))
1334             ;; call spam-register-routine with specific articles to unregister,
1335             ;; when there are articles to unregister and the check is enabled
1336             (when (and unregister-list (symbol-value backend))
1337               (spam-backend-put-article-todo-list backend 
1338                                                   classification 
1339                                                   unregister-list
1340                                                   t))))))
1341
1342     ;; do the non-moving backends first, then the moving ones
1343     (dolist (backend-type '(non-mover mover))
1344       (dolist (classification (spam-classifications))
1345         (dolist (backend (spam-backend-list backend-type))
1346           (when (spam-group-processor-p
1347                  gnus-newsgroup-name
1348                  backend
1349                  classification)
1350             (spam-backend-put-article-todo-list backend 
1351                                                 classification
1352                                                 (spam-list-articles
1353                                                  gnus-newsgroup-articles
1354                                                  classification))))))
1355
1356     (spam-resolve-registrations-routine) ; do the registrations now
1357
1358     ;; we mark all the leftover spam articles as expired at the end
1359     (dolist (article (spam-list-articles
1360                       gnus-newsgroup-articles
1361                       'spam))
1362       (gnus-summary-mark-article article gnus-expirable-mark)))
1363
1364   (setq spam-old-articles nil))
1365
1366 ;;}}}
1367
1368 ;;{{{ spam-use-move and spam-use-copy backend support functions
1369
1370 (defun spam-copy-or-move-routine (copy groups articles classification)
1371
1372   (when (and (car-safe groups) (listp (car-safe groups)))
1373     (setq groups (pop groups)))
1374
1375   (unless (listp groups)
1376     (setq groups (list groups)))
1377
1378     ;; remove the current process mark
1379   (gnus-summary-kill-process-mark)
1380
1381   (let ((backend-supports-deletions
1382          (gnus-check-backend-function
1383           'request-move-article gnus-newsgroup-name))
1384         (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
1385         article mark deletep respool)
1386
1387     (when (member 'respool groups)
1388       (setq respool t)                  ; boolean for later
1389       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
1390
1391     ;; now do the actual move
1392     (dolist (group groups)
1393       (when (and articles (stringp group))
1394
1395         ;; first, mark the article with the process mark and, if needed,
1396         ;; the unread or expired mark (for ham and spam respectively)
1397         (dolist (article articles)
1398           (when (and (eq classification 'ham)
1399                      spam-mark-ham-unread-before-move-from-spam-group)
1400             (gnus-message 9 "Marking ham article %d unread before move"
1401                           article)
1402             (gnus-summary-mark-article article gnus-unread-mark))
1403           (when (and (eq classification 'spam)
1404                      (not copy))
1405             (gnus-message 9 "Marking spam article %d expirable before move"
1406                           article)
1407             (gnus-summary-mark-article article gnus-expirable-mark))
1408           (gnus-summary-set-process-mark article)
1409             
1410           (if respool              ; respooling is with a "fake" group
1411               (let ((spam-split-disabled
1412                      (or spam-split-disabled
1413                          (and (eq classification 'ham) 
1414                               spam-disable-spam-split-during-ham-respool))))
1415                 (gnus-message 9 "Respooling article %d with method %s"
1416                               article respool-method)
1417                 (gnus-summary-respool-article nil respool-method))
1418             (if (or (not backend-supports-deletions) ; else, we are not respooling
1419                     (> (length groups) 1))
1420                 (progn              ; if copying, copy and set deletep
1421                   (gnus-message 9 "Copying article %d to group %s"
1422                                 article group)
1423                   (gnus-summary-copy-article nil group)
1424                   (setq deletep t))
1425               (gnus-message 9 "Moving article %d to group %s"
1426                             article group)
1427               (gnus-summary-move-article nil group))))) ; else move articles
1428         
1429       ;; now delete the articles, unless a) copy is t, and there was a copy done
1430       ;;                                 b) a move was done to a single group
1431       ;;                                 c) backend-supports-deletions is nil
1432       (unless copy
1433         (when (and deletep backend-supports-deletions)
1434           (dolist (article articles)
1435               (gnus-summary-set-process-mark article)
1436               (gnus-message 9 "Deleting article %d" article))
1437           (when articles
1438             (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
1439               (gnus-summary-delete-article nil)))))
1440         
1441       (gnus-summary-yank-process-mark)
1442       (length articles))))
1443
1444 (defun spam-copy-spam-routine (articles)
1445   (spam-copy-or-move-routine 
1446    t 
1447    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1448    articles
1449    'spam))
1450
1451 (defun spam-move-spam-routine (articles)
1452   (spam-copy-or-move-routine 
1453    nil
1454    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1455    articles
1456    'spam))
1457
1458 (defun spam-copy-ham-routine (articles)
1459   (spam-copy-or-move-routine 
1460    t 
1461    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1462    articles
1463    'ham))
1464
1465 (defun spam-move-ham-routine (articles)
1466   (spam-copy-or-move-routine 
1467    nil
1468    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1469    articles
1470    'ham))
1471
1472 ;;}}}
1473
1474 ;;{{{ article and field retrieval code
1475 (defun spam-get-article-as-string (article)
1476   (when (numberp article)
1477     (with-temp-buffer
1478       (gnus-request-article-this-buffer
1479        article
1480        gnus-newsgroup-name)
1481       (buffer-string))))
1482
1483 ;; disabled for now
1484 ;; (defun spam-get-article-as-filename (article)
1485 ;;   (let ((article-filename))
1486 ;;     (when (numberp article)
1487 ;;       (nnml-possibly-change-directory
1488 ;;        (gnus-group-real-name gnus-newsgroup-name))
1489 ;;       (setq article-filename (expand-file-name
1490 ;;                              (int-to-string article) nnml-current-directory)))
1491 ;;     (if (file-exists-p article-filename)
1492 ;;      article-filename
1493 ;;       nil)))
1494
1495 (defun spam-fetch-field-fast (article field &optional prepared-data-header)
1496   "Fetch a FIELD for ARTICLE quickly, using the internal gnus-data-list function.
1497 When PREPARED-DATA-HEADER is given, don't look in the Gnus data.
1498 When FIELD is 'number, ARTICLE can be any number (since we want
1499 to find it out)."
1500   (when (numberp article)
1501     (let* ((data-header (or prepared-data-header
1502                             (spam-fetch-article-header article))))
1503       (if (arrayp data-header)
1504         (cond
1505          ((equal field 'number)
1506           (mail-header-number data-header))
1507          ((equal field 'from)
1508           (mail-header-from data-header))
1509          ((equal field 'message-id)
1510           (mail-header-message-id data-header))
1511          ((equal field 'subject)
1512           (mail-header-subject data-header))
1513          ((equal field 'references)
1514           (mail-header-references data-header))
1515          ((equal field 'date)
1516           (mail-header-date data-header))
1517          ((equal field 'xref)
1518           (mail-header-xref data-header))
1519          ((equal field 'extra)
1520           (mail-header-extra data-header))
1521          (t
1522           (gnus-error 
1523            5 
1524            "spam-fetch-field-fast: unknown field %s requested" 
1525            field)
1526           nil))
1527         (gnus-message 6 "Article %d has a nil data header" article)))))
1528
1529 (defun spam-fetch-field-from-fast (article &optional prepared-data-header)
1530   (spam-fetch-field-fast article 'from prepared-data-header))
1531
1532 (defun spam-fetch-field-subject-fast (article &optional prepared-data-header)
1533   (spam-fetch-field-fast article 'subject prepared-data-header))
1534
1535 (defun spam-fetch-field-message-id-fast (article &optional prepared-data-header)
1536   (spam-fetch-field-fast article 'message-id prepared-data-header))
1537
1538 (defun spam-generate-fake-headers (article)
1539   (let ((dh (spam-fetch-article-header article)))
1540     (if dh
1541         (concat
1542          (format
1543           ;; 80-character limit makes for strange constructs
1544           (concat "From: %s\nSubject: %s\nMessage-ID: %s\n"
1545                   "Date: %s\nReferences: %s\nXref: %s\n")
1546           (spam-fetch-field-fast article 'from dh)
1547           (spam-fetch-field-fast article 'subject dh)
1548           (spam-fetch-field-fast article 'message-id dh)
1549           (spam-fetch-field-fast article 'date dh)
1550           (spam-fetch-field-fast article 'references dh)
1551           (spam-fetch-field-fast article 'xref dh))
1552          (when (spam-fetch-field-fast article 'extra dh)
1553            (format "%s\n" (spam-fetch-field-fast article 'extra dh))))
1554       (gnus-message
1555        5
1556        "spam-generate-fake-headers: article %d didn't have a valid header"
1557        article))))
1558
1559 (defun spam-fetch-article-header (article)
1560   (save-excursion
1561     (set-buffer gnus-summary-buffer)
1562     (gnus-read-header article)
1563     (nth 3 (assq article gnus-newsgroup-data))))
1564 ;;}}}
1565
1566 ;;{{{ Spam determination.
1567
1568 (defun spam-split (&rest specific-checks)
1569   "Split this message into the `spam' group if it is spam.
1570 This function can be used as an entry in the variable `nnmail-split-fancy',
1571 for example like this: (: spam-split).  It can take checks as
1572 parameters.  A string as a parameter will set the
1573 spam-split-group to that string.
1574
1575 See the Info node `(gnus)Fancy Mail Splitting' for more details."
1576   (interactive)
1577   (setq spam-split-last-successful-check nil)
1578   (unless spam-split-disabled
1579     (let ((spam-split-group-choice spam-split-group))
1580       (dolist (check specific-checks)
1581         (when (stringp check)
1582           (setq spam-split-group-choice check)
1583           (setq specific-checks (delq check specific-checks))))
1584
1585       (let ((spam-split-group spam-split-group-choice)
1586             (widening-needed-check (spam-widening-needed-p specific-checks)))
1587         (save-excursion
1588           (save-restriction
1589             (when widening-needed-check
1590               (widen)
1591               (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
1592                             widening-needed-check))
1593             (let ((backends (spam-backend-list))
1594                   decision)
1595               (while (and backends (not decision))
1596                 (let* ((backend (pop backends))
1597                        (check-function (spam-backend-check backend))
1598                        (spam-split-group (if spam-split-symbolic-return
1599                                              'spam
1600                                            spam-split-group)))
1601                   (when (or
1602                          ;; either, given specific checks, this is one of them
1603                          (memq backend specific-checks)
1604                          ;; or, given no specific checks, spam-use-CHECK is set
1605                          (and (null specific-checks) (symbol-value backend)))
1606                     (gnus-message 6 "spam-split: calling the %s function"
1607                                   check-function)
1608                     (setq decision (funcall check-function))
1609                     ;; if we got a decision at all, save the current check
1610                     (when decision
1611                       (setq spam-split-last-successful-check backend))
1612
1613                     (when (eq decision 'spam)
1614                       (unless spam-split-symbolic-return
1615                         (gnus-error
1616                          5
1617                          (format "spam-split got %s but %s is nil"
1618                                  decision
1619                                  spam-split-symbolic-return)))))))
1620               (if (eq decision t)
1621                   (if spam-split-symbolic-return-positive 'ham nil)
1622                 decision))))))))
1623
1624 (defun spam-find-spam ()
1625   "This function will detect spam in the current newsgroup using spam-split."
1626   (interactive)
1627
1628   (let* ((group gnus-newsgroup-name)
1629          (autodetect (gnus-parameter-spam-autodetect group))
1630          (methods (gnus-parameter-spam-autodetect-methods group))
1631          (first-method (nth 0 methods))
1632          (articles (if spam-autodetect-recheck-messages
1633                        gnus-newsgroup-articles
1634                      gnus-newsgroup-unseen))
1635          article-cannot-be-faked)
1636
1637     
1638     (dolist (backend methods)
1639       (when (spam-backend-statistical-p backend)
1640         (setq article-cannot-be-faked t)
1641         (return)))
1642
1643     (when (memq 'default methods)
1644       (setq article-cannot-be-faked t))
1645
1646     (when (and autodetect
1647                (not (equal first-method 'none)))
1648       (mapcar
1649        (lambda (article)
1650          (let ((id (spam-fetch-field-message-id-fast article))
1651                (subject (spam-fetch-field-subject-fast article))
1652                (sender (spam-fetch-field-from-fast article))
1653                registry-lookup)
1654            
1655            (unless id
1656              (gnus-message 6 "Article %d has no message ID!" article))
1657          
1658            (when (and id spam-log-to-registry)
1659              (setq registry-lookup (spam-log-registration-type id 'incoming))
1660              (when registry-lookup
1661                (gnus-message
1662                 9
1663                 "spam-find-spam: message %s was already registered incoming"
1664                 id)))
1665
1666            (let* ((spam-split-symbolic-return t)
1667                   (spam-split-symbolic-return-positive t)
1668                   (fake-headers (spam-generate-fake-headers article))
1669                   (split-return
1670                    (or registry-lookup
1671                        (with-temp-buffer
1672                          (if article-cannot-be-faked
1673                              (gnus-request-article-this-buffer
1674                               article
1675                               group)
1676                            ;; else, we fake the article
1677                            (when fake-headers (insert fake-headers)))
1678                          (if (or (null first-method)
1679                                  (equal first-method 'default))
1680                              (spam-split)
1681                            (apply 'spam-split methods))))))
1682              (if (equal split-return 'spam)
1683                  (gnus-summary-mark-article article gnus-spam-mark))
1684            
1685              (when (and id split-return spam-log-to-registry)
1686                (when (zerop (gnus-registry-group-count id))
1687                  (gnus-registry-add-group
1688                   id group subject sender))
1689                
1690                (unless registry-lookup
1691                  (spam-log-processing-to-registry
1692                   id
1693                   'incoming
1694                   split-return
1695                   spam-split-last-successful-check
1696                   group))))))
1697        articles))))
1698
1699 ;;}}}
1700
1701 ;;{{{ registration/unregistration functions
1702
1703 (defun spam-resolve-registrations-routine ()
1704   "Go through the backends and register or unregister articles as needed."
1705   (dolist (backend-type '(non-mover mover))
1706     (dolist (classification (spam-classifications))
1707       (dolist (backend (spam-backend-list backend-type))
1708         (let ((rlist (spam-backend-get-article-todo-list
1709                       backend classification))
1710               (ulist (spam-backend-get-article-todo-list
1711                       backend classification t))
1712               (delcount 0))
1713
1714           ;; clear the old lists right away
1715           (spam-backend-put-article-todo-list backend 
1716                                               classification
1717                                               nil
1718                                               nil)
1719           (spam-backend-put-article-todo-list backend 
1720                                               classification
1721                                               nil
1722                                               t)
1723
1724           ;; eliminate duplicates
1725           (dolist (article (copy-sequence ulist))
1726             (when (memq article rlist)
1727               (incf delcount)
1728               (setq rlist (delq article rlist))
1729               (setq ulist (delq article ulist))))
1730           
1731           (unless (zerop delcount)
1732             (gnus-message 
1733              9 
1734              "%d messages were saved the trouble of unregistering and then registering"
1735              delcount))
1736           
1737           ;; unregister articles
1738           (unless (zerop (length ulist))
1739             (let ((num (spam-unregister-routine classification backend ulist)))
1740               (when (> num 0)
1741                 (gnus-message 
1742                  6
1743                  "%d %s messages were unregistered by backend %s."
1744                  num
1745                  classification
1746                  backend))))
1747             
1748             ;; register articles
1749             (unless (zerop (length rlist))
1750               (let ((num (spam-register-routine classification backend rlist)))
1751                 (when (> num 0)
1752                   (gnus-message 
1753                    6
1754                    "%d %s messages were registered by backend %s."
1755                    num
1756                    classification
1757                    backend)))))))))
1758
1759 (defun spam-unregister-routine (classification
1760                                 backend 
1761                                 specific-articles)
1762   (spam-register-routine classification backend specific-articles t))
1763
1764 (defun spam-register-routine (classification
1765                               backend 
1766                               specific-articles
1767                               &optional unregister)
1768   (when (and (spam-classification-valid-p classification)
1769              (spam-backend-valid-p backend))
1770     (let* ((register-function
1771             (spam-backend-function backend classification 'registration))
1772            (unregister-function
1773             (spam-backend-function backend classification 'unregistration))
1774            (run-function (if unregister
1775                              unregister-function
1776                            register-function))
1777            (log-function (if unregister
1778                              'spam-log-undo-registration
1779                            'spam-log-processing-to-registry))
1780            article articles)
1781
1782       (when run-function
1783         ;; make list of articles, using specific-articles if given
1784         (setq articles (or specific-articles
1785                            (spam-list-articles
1786                             gnus-newsgroup-articles
1787                             classification)))
1788         ;; process them
1789         (when (> (length articles) 0)
1790           (gnus-message 5 "%s %d %s articles as %s using backend %s"
1791                         (if unregister "Unregistering" "Registering")
1792                         (length articles)
1793                         (if specific-articles "specific" "")
1794                         classification
1795                         backend)
1796           (funcall run-function articles)
1797           ;; now log all the registrations (or undo them, depending on
1798           ;; unregister)
1799           (dolist (article articles)
1800             (funcall log-function
1801                      (spam-fetch-field-message-id-fast article)
1802                      'process
1803                      classification
1804                      backend
1805                      gnus-newsgroup-name))))
1806       ;; return the number of articles processed
1807       (length articles))))
1808
1809 ;;; log a ham- or spam-processor invocation to the registry
1810 (defun spam-log-processing-to-registry (id type classification backend group)
1811   (when spam-log-to-registry
1812     (if (and (stringp id)
1813              (stringp group)
1814              (spam-process-type-valid-p type)
1815              (spam-classification-valid-p classification)
1816              (spam-backend-valid-p backend))
1817         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1818               (cell (list classification backend group)))
1819           (push cell cell-list)
1820           (gnus-registry-store-extra-entry
1821            id
1822            type
1823            cell-list))
1824
1825       (gnus-error
1826        7
1827        (format "%s call with bad ID, type, classification, spam-backend, or group"
1828                "spam-log-processing-to-registry")))))
1829
1830 ;;; check if a ham- or spam-processor registration has been done
1831 (defun spam-log-registered-p (id type)
1832   (when spam-log-to-registry
1833     (if (and (stringp id)
1834              (spam-process-type-valid-p type))
1835         (cdr-safe (gnus-registry-fetch-extra id type))
1836       (progn
1837         (gnus-error
1838          7
1839          (format "%s called with bad ID, type, classification, or spam-backend"
1840                  "spam-log-registered-p"))
1841         nil))))
1842
1843 ;;; check what a ham- or spam-processor registration says
1844 ;;; returns nil if conflicting registrations are found
1845 (defun spam-log-registration-type (id type)
1846   (let ((count 0)
1847         decision)
1848     (dolist (reg (spam-log-registered-p id type))
1849       (let ((classification (nth 0 reg)))
1850         (when (spam-classification-valid-p classification)
1851           (when (and decision
1852                      (not (eq classification decision)))
1853             (setq count (+ 1 count)))
1854           (setq decision classification))))
1855     (if (< 0 count)
1856         nil
1857       decision)))
1858
1859
1860 ;;; check if a ham- or spam-processor registration needs to be undone
1861 (defun spam-log-unregistration-needed-p (id type classification backend)
1862   (when spam-log-to-registry
1863     (if (and (stringp id)
1864              (spam-process-type-valid-p type)
1865              (spam-classification-valid-p classification)
1866              (spam-backend-valid-p backend))
1867         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1868               found)
1869           (dolist (cell cell-list)
1870             (unless found
1871               (when (and (eq classification (nth 0 cell))
1872                          (eq backend (nth 1 cell)))
1873                 (setq found t))))
1874           found)
1875       (progn
1876         (gnus-error
1877          7
1878          (format "%s called with bad ID, type, classification, or spam-backend"
1879                  "spam-log-unregistration-needed-p"))
1880         nil))))
1881
1882
1883 ;;; undo a ham- or spam-processor registration (the group is not used)
1884 (defun spam-log-undo-registration (id type classification backend &optional group)
1885   (when (and spam-log-to-registry
1886              (spam-log-unregistration-needed-p id type classification backend))
1887     (if (and (stringp id)
1888              (spam-process-type-valid-p type)
1889              (spam-classification-valid-p classification)
1890              (spam-backend-valid-p backend))
1891         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1892               new-cell-list found)
1893           (dolist (cell cell-list)
1894             (unless (and (eq classification (nth 0 cell))
1895                          (eq backend (nth 1 cell)))
1896               (push cell new-cell-list)))
1897           (gnus-registry-store-extra-entry
1898            id
1899            type
1900            new-cell-list))
1901       (progn
1902         (gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group"
1903                               "spam-log-undo-registration"))
1904         nil))))
1905
1906 ;;}}}
1907
1908 ;;{{{ backend functions
1909
1910 ;;{{{ Gmane xrefs
1911 (defun spam-check-gmane-xref ()
1912   (let ((header (or
1913                  (message-fetch-field "Xref")
1914                  (message-fetch-field "Newsgroups"))))
1915     (when header                        ; return nil when no header
1916       (when (string-match spam-gmane-xref-spam-group
1917                           header)
1918           spam-split-group))))
1919
1920 ;;}}}
1921
1922 ;;{{{ Regex body
1923
1924 (defun spam-check-regex-body ()
1925   (let ((spam-regex-headers-ham spam-regex-body-ham)
1926         (spam-regex-headers-spam spam-regex-body-spam))
1927     (spam-check-regex-headers t)))
1928
1929 ;;}}}
1930
1931 ;;{{{ Regex headers
1932
1933 (defun spam-check-regex-headers (&optional body)
1934   (let ((type (if body "body" "header"))
1935         ret found)
1936     (dolist (h-regex spam-regex-headers-ham)
1937       (unless found
1938         (goto-char (point-min))
1939         (when (re-search-forward h-regex nil t)
1940           (message "Ham regex %s search positive." type)
1941           (setq found t))))
1942     (dolist (s-regex spam-regex-headers-spam)
1943       (unless found
1944         (goto-char (point-min))
1945         (when (re-search-forward s-regex nil t)
1946           (message "Spam regex %s search positive." type)
1947           (setq found t)
1948           (setq ret spam-split-group))))
1949     ret))
1950
1951 ;;}}}
1952
1953 ;;{{{ Blackholes.
1954
1955 (defun spam-reverse-ip-string (ip)
1956   (when (stringp ip)
1957     (mapconcat 'identity
1958                (nreverse (split-string ip "\\."))
1959                ".")))
1960
1961 (defun spam-check-blackholes ()
1962   "Check the Received headers for blackholed relays."
1963   (let ((headers (message-fetch-field "received"))
1964         ips matches)
1965     (when headers
1966       (with-temp-buffer
1967         (insert headers)
1968         (goto-char (point-min))
1969         (gnus-message 6 "Checking headers for relay addresses")
1970         (while (re-search-forward
1971                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
1972           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
1973           (push (spam-reverse-ip-string (match-string 1))
1974                 ips)))
1975       (dolist (server spam-blackhole-servers)
1976         (dolist (ip ips)
1977           (unless (and spam-blackhole-good-server-regex
1978                        ;; match the good-server-regex against the reversed (again) IP string
1979                        (string-match
1980                         spam-blackhole-good-server-regex
1981                         (spam-reverse-ip-string ip)))
1982             (unless matches
1983               (let ((query-string (concat ip "." server)))
1984                 (if spam-use-dig
1985                     (let ((query-result (query-dig query-string)))
1986                       (when query-result
1987                         (gnus-message 6 "(DIG): positive blackhole check '%s'"
1988                                       query-result)
1989                         (push (list ip server query-result)
1990                               matches)))
1991                   ;; else, if not using dig.el
1992                   (when (query-dns query-string)
1993                     (gnus-message 6 "positive blackhole check")
1994                     (push (list ip server (query-dns query-string 'TXT))
1995                           matches)))))))))
1996     (when matches
1997       spam-split-group)))
1998 ;;}}}
1999
2000 ;;{{{ Hashcash.
2001
2002 (eval-when-compile
2003   (autoload 'mail-check-payment "hashcash"))
2004
2005 (condition-case nil
2006     (progn
2007       (require 'hashcash)
2008
2009       (defun spam-check-hashcash ()
2010         "Check the headers for hashcash payments."
2011         (mail-check-payment)))   ;mail-check-payment returns a boolean
2012
2013   (file-error))
2014 ;;}}}
2015
2016 ;;{{{ BBDB
2017
2018 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
2019 ;;; <sacha@giotto.sj.ru>
2020
2021 ;; all this is done inside a condition-case to trap errors
2022
2023 (eval-when-compile
2024   (autoload 'bbdb-buffer "bbdb")
2025   (autoload 'bbdb-create-internal "bbdb")
2026   (autoload 'bbdb-records "bbdb")
2027   (autoload 'bbdb-search-simple "bbdb"))
2028
2029 (eval-and-compile
2030   (when (condition-case nil
2031             (progn
2032               (require 'bbdb)
2033               (require 'bbdb-com))
2034           (file-error
2035            (defalias 'spam-BBDB-register-routine 'ignore)
2036            (defalias 'spam-enter-ham-BBDB 'ignore)
2037            nil))
2038
2039     ;; when the BBDB changes, we want to clear out our cache
2040     (defun spam-clear-cache-BBDB (&rest immaterial)
2041       (spam-clear-cache 'spam-use-BBDB))
2042
2043     (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
2044
2045     (defun spam-enter-ham-BBDB (addresses &optional remove)
2046       "Enter an address into the BBDB; implies ham (non-spam) sender"
2047       (dolist (from addresses)
2048         (when (stringp from)
2049           (let* ((parsed-address (gnus-extract-address-components from))
2050                  (name (or (nth 0 parsed-address) "Ham Sender"))
2051                  (remove-function (if remove
2052                                       'bbdb-delete-record-internal
2053                                     'ignore))
2054                  (net-address (nth 1 parsed-address))
2055                  (record (and net-address
2056                               (bbdb-search-simple nil net-address))))
2057             (when net-address
2058               (gnus-message 6 "%s address %s %s BBDB"
2059                             (if remove "Deleting" "Adding")
2060                             from
2061                             (if remove "from" "to"))
2062               (if record
2063                   (funcall remove-function record)
2064                 (bbdb-create-internal name nil net-address nil nil
2065                                       "ham sender added by spam.el")))))))
2066
2067     (defun spam-BBDB-register-routine (articles &optional unregister)
2068       (let (addresses)
2069         (dolist (article articles)
2070           (when (stringp (spam-fetch-field-from-fast article))
2071             (push (spam-fetch-field-from-fast article) addresses)))
2072         ;; now do the register/unregister action
2073         (spam-enter-ham-BBDB addresses unregister)))
2074
2075     (defun spam-BBDB-unregister-routine (articles)
2076       (spam-BBDB-register-routine articles t))
2077
2078     (defun spam-check-BBDB ()
2079       "Mail from people in the BBDB is classified as ham or non-spam"
2080       (let ((who (message-fetch-field "from"))
2081             bbdb-cache bbdb-hashtable)
2082         (when spam-cache-lookups
2083           (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
2084           (unless bbdb-cache
2085             (setq bbdb-cache
2086                   ;; this is the expanded (bbdb-hashtable) macro
2087                   ;; without the debugging support
2088                   (with-current-buffer (bbdb-buffer)
2089                     (save-excursion
2090                       (save-window-excursion
2091                         (bbdb-records nil t)
2092                         bbdb-hashtable))))
2093             (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
2094         (when who
2095           (setq who (nth 1 (gnus-extract-address-components who)))
2096           (if
2097               (if spam-cache-lookups
2098                   (symbol-value
2099                    (intern-soft who bbdb-cache))
2100                 (bbdb-search-simple nil who))
2101               t
2102             (if spam-use-BBDB-exclusive
2103                 spam-split-group
2104               nil)))))))
2105
2106 ;;}}}
2107
2108 ;;{{{ ifile
2109
2110 ;;; check the ifile backend; return nil if the mail was NOT classified
2111 ;;; as spam
2112
2113 (defun spam-get-ifile-database-parameter ()
2114   "Get the command-line parameter for ifile's database from
2115   spam-ifile-database-path."
2116   (if spam-ifile-database-path
2117       (format "--db-file=%s" spam-ifile-database-path)
2118     nil))
2119
2120 (defun spam-check-ifile ()
2121   "Check the ifile backend for the classification of this message."
2122   (let ((article-buffer-name (buffer-name))
2123         category return)
2124     (with-temp-buffer
2125       (let ((temp-buffer-name (buffer-name))
2126             (db-param (spam-get-ifile-database-parameter)))
2127         (save-excursion
2128           (set-buffer article-buffer-name)
2129           (apply 'call-process-region
2130                  (point-min) (point-max) spam-ifile-path
2131                  nil temp-buffer-name nil "-c"
2132                  (if db-param `(,db-param "-q") `("-q"))))
2133         ;; check the return now (we're back in the temp buffer)
2134         (goto-char (point-min))
2135         (if (not (eobp))
2136             (setq category (buffer-substring (point) (point-at-eol))))
2137         (when (not (zerop (length category))) ; we need a category here
2138           (if spam-ifile-all-categories
2139               (setq return category)
2140             ;; else, if spam-ifile-all-categories is not set...
2141             (when (string-equal spam-ifile-spam-category category)
2142               (setq return spam-split-group)))))) ; note return is nil otherwise
2143     return))
2144
2145 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
2146   "Register an article, given as a string, with a category.
2147 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
2148   (let ((category (or category gnus-newsgroup-name))
2149         (add-or-delete-option (if unregister "-d" "-i"))
2150         (db (spam-get-ifile-database-parameter))
2151         parameters)
2152     (with-temp-buffer
2153       (dolist (article articles)
2154         (let ((article-string (spam-get-article-as-string article)))
2155           (when (stringp article-string)
2156             (insert article-string))))
2157       (apply 'call-process-region
2158              (point-min) (point-max) spam-ifile-path
2159              nil nil nil
2160              add-or-delete-option category
2161              (if db `(,db "-h") `("-h"))))))
2162
2163 (defun spam-ifile-register-spam-routine (articles &optional unregister)
2164   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
2165
2166 (defun spam-ifile-unregister-spam-routine (articles)
2167   (spam-ifile-register-spam-routine articles t))
2168
2169 (defun spam-ifile-register-ham-routine (articles &optional unregister)
2170   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
2171
2172 (defun spam-ifile-unregister-ham-routine (articles)
2173   (spam-ifile-register-ham-routine articles t))
2174
2175 ;;}}}
2176
2177 ;;{{{ spam-stat
2178
2179 (eval-when-compile
2180   (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
2181   (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
2182   (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
2183   (autoload 'spam-stat-buffer-is-spam "spam-stat")
2184   (autoload 'spam-stat-load "spam-stat")
2185   (autoload 'spam-stat-save "spam-stat")
2186   (autoload 'spam-stat-split-fancy "spam-stat"))
2187
2188 (eval-and-compile
2189   (when (condition-case nil
2190             (let ((spam-stat-install-hooks nil))
2191               (require 'spam-stat))
2192           (file-error
2193            (defalias 'spam-stat-register-ham-routine 'ignore)
2194            (defalias 'spam-stat-register-spam-routine 'ignore)
2195            nil))
2196
2197     (defun spam-check-stat ()
2198       "Check the spam-stat backend for the classification of this message"
2199       (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
2200             (spam-stat-buffer (buffer-name)) ; stat the current buffer
2201             category return)
2202         (spam-stat-split-fancy)))
2203
2204     (defun spam-stat-register-spam-routine (articles &optional unregister)
2205       (dolist (article articles)
2206         (let ((article-string (spam-get-article-as-string article)))
2207           (with-temp-buffer
2208             (insert article-string)
2209             (if unregister
2210                 (spam-stat-buffer-change-to-non-spam)
2211               (spam-stat-buffer-is-spam))))))
2212
2213     (defun spam-stat-unregister-spam-routine (articles)
2214       (spam-stat-register-spam-routine articles t))
2215
2216     (defun spam-stat-register-ham-routine (articles &optional unregister)
2217       (dolist (article articles)
2218         (let ((article-string (spam-get-article-as-string article)))
2219           (with-temp-buffer
2220             (insert article-string)
2221             (if unregister
2222                 (spam-stat-buffer-change-to-spam)
2223               (spam-stat-buffer-is-non-spam))))))
2224
2225     (defun spam-stat-unregister-ham-routine (articles)
2226       (spam-stat-register-ham-routine articles t))
2227
2228     (defun spam-maybe-spam-stat-load ()
2229       (when spam-use-stat (spam-stat-load)))
2230
2231     (defun spam-maybe-spam-stat-save ()
2232       (when spam-use-stat (spam-stat-save)))))
2233
2234 ;;}}}
2235
2236 ;;{{{ Blacklists and whitelists.
2237
2238 (defvar spam-whitelist-cache nil)
2239 (defvar spam-blacklist-cache nil)
2240
2241 (defun spam-kill-whole-line ()
2242   (beginning-of-line)
2243   (let ((kill-whole-line t))
2244     (kill-line)))
2245
2246 ;;; address can be a list, too
2247 (defun spam-enter-whitelist (address &optional remove)
2248   "Enter ADDRESS (list or single) into the whitelist.
2249 With a non-nil REMOVE, remove them."
2250   (interactive "sAddress: ")
2251   (spam-enter-list address spam-whitelist remove)
2252   (setq spam-whitelist-cache nil)
2253   (spam-clear-cache 'spam-use-whitelist))
2254
2255 ;;; address can be a list, too
2256 (defun spam-enter-blacklist (address &optional remove)
2257   "Enter ADDRESS (list or single) into the blacklist.
2258 With a non-nil REMOVE, remove them."
2259   (interactive "sAddress: ")
2260   (spam-enter-list address spam-blacklist remove)
2261   (setq spam-blacklist-cache nil)
2262   (spam-clear-cache 'spam-use-whitelist))
2263
2264 (defun spam-enter-list (addresses file &optional remove)
2265   "Enter ADDRESSES into the given FILE.
2266 Either the whitelist or the blacklist files can be used.  With
2267 REMOVE not nil, remove the ADDRESSES."
2268   (if (stringp addresses)
2269       (spam-enter-list (list addresses) file remove)
2270     ;; else, we have a list of addresses here
2271     (unless (file-exists-p (file-name-directory file))
2272       (make-directory (file-name-directory file) t))
2273     (save-excursion
2274       (set-buffer
2275        (find-file-noselect file))
2276       (dolist (a addresses)
2277         (when (stringp a)
2278           (goto-char (point-min))
2279           (if (re-search-forward (regexp-quote a) nil t)
2280               ;; found the address
2281               (when remove
2282                 (spam-kill-whole-line))
2283             ;; else, the address was not found
2284             (unless remove
2285               (goto-char (point-max))
2286               (unless (bobp)
2287                 (insert "\n"))
2288               (insert a "\n")))))
2289       (save-buffer))))
2290
2291 (defun spam-filelist-build-cache (type)
2292   (let ((cache (if (eq type 'spam-use-blacklist)
2293                    spam-blacklist-cache
2294                  spam-whitelist-cache))
2295         parsed-cache)
2296     (unless (gethash type spam-caches)
2297       (while cache
2298         (let ((address (pop cache)))
2299           (unless (zerop (length address)) ; 0 for a nil address too
2300             (setq address (regexp-quote address))
2301             ;; fix regexp-quote's treatment of user-intended regexes
2302             (while (string-match "\\\\\\*" address)
2303               (setq address (replace-match ".*" t t address))))
2304           (push address parsed-cache)))
2305       (puthash type parsed-cache spam-caches))))
2306
2307 (defun spam-filelist-check-cache (type from)
2308   (when (stringp from)
2309     (spam-filelist-build-cache type)
2310     (let (found)
2311       (dolist (address (gethash type spam-caches))
2312         (when (and address (string-match address from))
2313           (setq found t)
2314           (return)))
2315       found)))
2316
2317 ;;; returns t if the sender is in the whitelist, nil or
2318 ;;; spam-split-group otherwise
2319 (defun spam-check-whitelist ()
2320   ;; FIXME!  Should it detect when file timestamps change?
2321   (unless spam-whitelist-cache
2322     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
2323   (if (spam-from-listed-p 'spam-use-whitelist)
2324       t
2325     (if spam-use-whitelist-exclusive
2326         spam-split-group
2327       nil)))
2328
2329 (defun spam-check-blacklist ()
2330   ;; FIXME!  Should it detect when file timestamps change?
2331   (unless spam-blacklist-cache
2332     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
2333   (and (spam-from-listed-p 'spam-use-blacklist)
2334        spam-split-group))
2335
2336 (defun spam-parse-list (file)
2337   (when (file-readable-p file)
2338     (let (contents address)
2339       (with-temp-buffer
2340         (insert-file-contents file)
2341         (while (not (eobp))
2342           (setq address (buffer-substring (point) (point-at-eol)))
2343           (forward-line 1)
2344           ;; insert the e-mail address if detected, otherwise the raw data
2345           (unless (zerop (length address))
2346             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
2347               (push (or pure-address address) contents)))))
2348       (nreverse contents))))
2349
2350 (defun spam-from-listed-p (type)
2351   (let ((from (message-fetch-field "from"))
2352         found)
2353     (spam-filelist-check-cache type from)))
2354
2355 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
2356   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
2357         (declassification (if blacklist 'ham 'spam))
2358         (enter-function
2359          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2360         (remove-function
2361          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2362         from addresses unregister-list article-unregister-list)
2363     (dolist (article articles)
2364       (let ((from (spam-fetch-field-from-fast article))
2365             (id (spam-fetch-field-message-id-fast article))
2366             sender-ignored)
2367         (when (stringp from)
2368           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2369             (when (and (not sender-ignored)
2370                        (stringp ignore-regex)
2371                        (string-match ignore-regex from))
2372               (setq sender-ignored t)))
2373           ;; remember the messages we need to unregister, unless remove is set
2374           (when (and
2375                  (null unregister)
2376                  (spam-log-unregistration-needed-p
2377                   id 'process declassification de-symbol))
2378             (push article article-unregister-list)
2379             (push from unregister-list))
2380           (unless sender-ignored
2381             (push from addresses)))))
2382
2383     (if unregister
2384         (funcall enter-function addresses t) ; unregister all these addresses
2385       ;; else, register normally and unregister what we need to
2386       (funcall remove-function unregister-list t)
2387       (dolist (article article-unregister-list)
2388         (spam-log-undo-registration
2389          (spam-fetch-field-message-id-fast article)
2390          'process
2391          declassification
2392          de-symbol))
2393       (funcall enter-function addresses nil))))
2394
2395 (defun spam-blacklist-unregister-routine (articles)
2396   (spam-blacklist-register-routine articles t))
2397
2398 (defun spam-blacklist-register-routine (articles &optional unregister)
2399   (spam-filelist-register-routine articles t unregister))
2400
2401 (defun spam-whitelist-unregister-routine (articles)
2402   (spam-whitelist-register-routine articles t))
2403
2404 (defun spam-whitelist-register-routine (articles &optional unregister)
2405   (spam-filelist-register-routine articles nil unregister))
2406
2407 ;;}}}
2408
2409 ;;{{{ Spam-report glue (gmane and resend reporting)
2410 (defun spam-report-gmane-register-routine (articles)
2411   (when articles
2412     (apply 'spam-report-gmane articles)))
2413
2414 (defun spam-report-resend-register-ham-routine (articles)
2415   (spam-report-resend-register-routine articles t))
2416
2417 (defun spam-report-resend-register-routine (articles &optional ham)
2418   (let* ((resend-to-gp 
2419           (if ham
2420               (gnus-parameter-ham-resend-to gnus-newsgroup-name)
2421             (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
2422          (spam-report-resend-to (or (car-safe resend-to-gp)
2423                                     spam-report-resend-to)))
2424     (spam-report-resend articles ham)))
2425
2426 ;;}}}
2427
2428 ;;{{{ Bogofilter
2429 (defun spam-check-bogofilter-headers (&optional score)
2430   (let ((header (message-fetch-field spam-bogofilter-header)))
2431     (when header                        ; return nil when no header
2432       (if score                         ; scoring mode
2433           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2434               (match-string 1 header)
2435             "0")
2436         ;; spam detection mode
2437         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2438                             header)
2439           spam-split-group)))))
2440
2441 ;; return something sensible if the score can't be determined
2442 (defun spam-bogofilter-score (&optional recheck)
2443   "Get the Bogofilter spamicity score"
2444   (interactive "P")
2445   (save-window-excursion
2446     (gnus-summary-show-article t)
2447     (set-buffer gnus-article-buffer)
2448     (let ((score (or (unless recheck
2449                        (spam-check-bogofilter-headers t))
2450                      (spam-check-bogofilter t))))
2451       (gnus-summary-show-article)
2452       (message "Spamicity score %s" score)
2453       (or score "0"))))
2454
2455 (defun spam-verify-bogofilter ()
2456   "Verify the Bogofilter version is sufficient."
2457   (when (eq spam-bogofilter-valid 'unknown)
2458     (setq spam-bogofilter-valid
2459           (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
2460                              (shell-command-to-string 
2461                               (format "%s -V" spam-bogofilter-path))))))
2462   spam-bogofilter-valid)
2463   
2464 (defun spam-check-bogofilter (&optional score)
2465   "Check the Bogofilter backend for the classification of this message."
2466   (if (spam-verify-bogofilter)
2467       (let ((article-buffer-name (buffer-name))
2468             (db spam-bogofilter-database-directory)
2469             return)
2470         (with-temp-buffer
2471           (let ((temp-buffer-name (buffer-name)))
2472             (save-excursion
2473               (set-buffer article-buffer-name)
2474               (apply 'call-process-region
2475                      (point-min) (point-max)
2476                      spam-bogofilter-path
2477                      nil temp-buffer-name nil
2478                      (if db `("-d" ,db "-v") `("-v"))))
2479             (setq return (spam-check-bogofilter-headers score))))
2480         return)
2481     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2482
2483 (defun spam-bogofilter-register-with-bogofilter (articles
2484                                                  spam
2485                                                  &optional unregister)
2486   "Register an article, given as a string, as spam or non-spam."
2487   (if (spam-verify-bogofilter)
2488       (dolist (article articles)
2489         (let ((article-string (spam-get-article-as-string article))
2490               (db spam-bogofilter-database-directory)
2491               (switch (if unregister
2492                           (if spam
2493                               spam-bogofilter-spam-strong-switch
2494                             spam-bogofilter-ham-strong-switch)
2495                         (if spam
2496                             spam-bogofilter-spam-switch
2497                           spam-bogofilter-ham-switch))))
2498           (when (stringp article-string)
2499             (with-temp-buffer
2500               (insert article-string)
2501               
2502               (apply 'call-process-region
2503                      (point-min) (point-max)
2504                      spam-bogofilter-path
2505                      nil nil nil switch
2506                      (if db `("-d" ,db "-v") `("-v")))))))
2507     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2508
2509 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2510   (spam-bogofilter-register-with-bogofilter articles t unregister))
2511
2512 (defun spam-bogofilter-unregister-spam-routine (articles)
2513   (spam-bogofilter-register-spam-routine articles t))
2514
2515 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2516   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2517
2518 (defun spam-bogofilter-unregister-ham-routine (articles)
2519   (spam-bogofilter-register-ham-routine articles t))
2520
2521
2522 ;;}}}
2523
2524 ;;{{{ spamoracle
2525 (defun spam-check-spamoracle ()
2526   "Run spamoracle on an article to determine whether it's spam."
2527   (let ((article-buffer-name (buffer-name)))
2528     (with-temp-buffer
2529       (let ((temp-buffer-name (buffer-name)))
2530         (save-excursion
2531           (set-buffer article-buffer-name)
2532           (let ((status
2533                  (apply 'call-process-region
2534                         (point-min) (point-max)
2535                         spam-spamoracle-binary
2536                         nil temp-buffer-name nil
2537                         (if spam-spamoracle-database
2538                             `("-f" ,spam-spamoracle-database "mark")
2539                           '("mark")))))
2540             (if (eq 0 status)
2541                 (progn
2542                   (set-buffer temp-buffer-name)
2543                   (goto-char (point-min))
2544                   (when (re-search-forward "^X-Spam: yes;" nil t)
2545                     spam-split-group))
2546               (error "Error running spamoracle: %s" status))))))))
2547
2548 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2549   "Run spamoracle in training mode."
2550   (with-temp-buffer
2551     (let ((temp-buffer-name (buffer-name)))
2552       (save-excursion
2553         (goto-char (point-min))
2554         (dolist (article articles)
2555           (insert (spam-get-article-as-string article)))
2556         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2557                         "-spam"
2558                       "-good"))
2559                (status
2560                 (apply 'call-process-region
2561                        (point-min) (point-max)
2562                        spam-spamoracle-binary
2563                        nil temp-buffer-name nil
2564                        (if spam-spamoracle-database
2565                            `("-f" ,spam-spamoracle-database
2566                              "add" ,arg)
2567                          `("add" ,arg)))))
2568           (unless (eq 0 status)
2569             (error "Error running spamoracle: %s" status)))))))
2570
2571 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2572   (spam-spamoracle-learn articles nil unregister))
2573
2574 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2575   (spam-spamoracle-learn-ham articles t))
2576
2577 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2578   (spam-spamoracle-learn articles t unregister))
2579
2580 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2581   (spam-spamoracle-learn-spam articles t))
2582
2583 ;;}}}
2584
2585 ;;{{{ SpamAssassin
2586 ;;; based mostly on the bogofilter code
2587 (defun spam-check-spamassassin-headers (&optional score)
2588   "Check the SpamAssassin headers for the classification of this message."
2589   (if score                             ; scoring mode
2590       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2591         (when header
2592           (if (string-match "hits=\\(-?[0-9.]+\\)" header)
2593               (match-string 1 header)
2594             "0")))
2595     ;; spam detection mode
2596     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)))
2597           (when header                  ; return nil when no header
2598             (when (string-match spam-spamassassin-positive-spam-flag-header
2599                                 header)
2600               spam-split-group)))))
2601
2602 (defun spam-check-spamassassin (&optional score)
2603   "Check the SpamAssassin backend for the classification of this message."
2604   (let ((article-buffer-name (buffer-name)))
2605     (with-temp-buffer
2606       (let ((temp-buffer-name (buffer-name)))
2607         (save-excursion
2608           (set-buffer article-buffer-name)
2609           (apply 'call-process-region
2610                  (point-min) (point-max) spam-spamassassin-path
2611                  nil temp-buffer-name nil spam-spamassassin-arguments))
2612         ;; check the return now (we're back in the temp buffer)
2613         (goto-char (point-min))
2614         (spam-check-spamassassin-headers score)))))
2615
2616 ;; return something sensible if the score can't be determined
2617 (defun spam-spamassassin-score (&optional recheck)
2618   "Get the SpamAssassin score"
2619   (interactive "P")
2620   (save-window-excursion
2621     (gnus-summary-show-article t)
2622     (set-buffer gnus-article-buffer)
2623     (let ((score (or (unless recheck
2624                        (spam-check-spamassassin-headers t))
2625                      (spam-check-spamassassin t))))
2626       (gnus-summary-show-article)
2627       (message "SpamAssassin score %s" score)
2628       (or score "0"))))
2629
2630 (defun spam-spamassassin-register-with-sa-learn (articles spam
2631                                                  &optional unregister)
2632   "Register articles with spamassassin's sa-learn as spam or non-spam."
2633   (if articles
2634       (let ((action (if unregister spam-sa-learn-unregister-switch
2635                       (if spam spam-sa-learn-spam-switch
2636                         spam-sa-learn-ham-switch)))
2637             (summary-buffer-name (buffer-name)))
2638         (with-temp-buffer
2639           ;; group the articles into mbox format
2640           (dolist (article articles)
2641             (let (article-string)
2642               (save-excursion
2643                 (set-buffer summary-buffer-name)
2644                 (setq article-string (spam-get-article-as-string article)))
2645               (when (stringp article-string)
2646                 (insert "From \n") ; mbox separator (sa-learn only checks the
2647                                    ; first five chars, so we can get away with
2648                                    ; a bogus line))
2649                 (insert article-string)
2650                 (insert "\n"))))
2651           ;; call sa-learn on all messages at the same time
2652           (apply 'call-process-region
2653                  (point-min) (point-max)
2654                  spam-sa-learn-path
2655                  nil nil nil "--mbox"
2656                  (if spam-sa-learn-rebuild
2657                      (list action)
2658                    `("--no-rebuild" ,action)))))))
2659
2660 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2661   (spam-spamassassin-register-with-sa-learn articles t unregister))
2662
2663 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2664   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2665
2666 (defun spam-spamassassin-unregister-spam-routine (articles)
2667   (spam-spamassassin-register-with-sa-learn articles t t))
2668
2669 (defun spam-spamassassin-unregister-ham-routine (articles)
2670   (spam-spamassassin-register-with-sa-learn articles nil t))
2671
2672 ;;}}}
2673
2674 ;;{{{ Bsfilter
2675 ;;; based mostly on the bogofilter code
2676 (defun spam-check-bsfilter-headers (&optional score)
2677   (if score
2678       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2679           "0")
2680     (let ((header (nnmail-fetch-field spam-bsfilter-header)))
2681       (when header ; return nil when no header
2682         (when (string-match "YES" header)
2683           spam-split-group)))))
2684
2685 ;; return something sensible if the score can't be determined
2686 (defun spam-bsfilter-score (&optional recheck)
2687   "Get the Bsfilter spamicity score"
2688   (interactive "P")
2689   (save-window-excursion
2690     (gnus-summary-show-article t)
2691     (set-buffer gnus-article-buffer)
2692     (let ((score (or (unless recheck
2693                        (spam-check-bsfilter-headers t))
2694                      (spam-check-bsfilter t))))
2695       (gnus-summary-show-article)
2696       (message "Spamicity score %s" score)
2697       (or score "0"))))
2698
2699 (defun spam-check-bsfilter (&optional score)
2700   "Check the Bsfilter backend for the classification of this message"
2701   (let ((article-buffer-name (buffer-name))
2702         (dir spam-bsfilter-database-directory)
2703         return)
2704     (with-temp-buffer
2705       (let ((temp-buffer-name (buffer-name)))
2706         (save-excursion
2707           (set-buffer article-buffer-name)
2708           (apply 'call-process-region
2709                  (point-min) (point-max)
2710                  spam-bsfilter-path
2711                  nil temp-buffer-name nil
2712                  "--pipe"
2713                  "--insert-flag"
2714                  "--insert-probability"
2715                  (when dir
2716                    (list "--homedir" dir))))
2717         (setq return (spam-check-bsfilter-headers score))))
2718     return))
2719
2720 (defun spam-bsfilter-register-with-bsfilter (articles
2721                                              spam
2722                                              &optional unregister)
2723   "Register an article, given as a string, as spam or non-spam."
2724   (dolist (article articles)
2725     (let ((article-string (spam-get-article-as-string article))
2726           (switch (if unregister
2727                       (if spam
2728                           spam-bsfilter-spam-strong-switch
2729                         spam-bsfilter-ham-strong-switch)
2730                     (if spam
2731                         spam-bsfilter-spam-switch
2732                       spam-bsfilter-ham-switch))))
2733       (when (stringp article-string)
2734         (with-temp-buffer
2735           (insert article-string)
2736           (apply 'call-process-region
2737                  (point-min) (point-max)
2738                  spam-bsfilter-path
2739                  nil nil nil switch
2740                  "--update"
2741                  (when spam-bsfilter-database-directory
2742                    (list "--homedir"
2743                          spam-bsfilter-database-directory))))))))
2744
2745 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2746   (spam-bsfilter-register-with-bsfilter articles t unregister))
2747
2748 (defun spam-bsfilter-unregister-spam-routine (articles)
2749   (spam-bsfilter-register-spam-routine articles t))
2750
2751 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2752   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2753
2754 (defun spam-bsfilter-unregister-ham-routine (articles)
2755   (spam-bsfilter-register-ham-routine articles t))
2756
2757 ;;}}}
2758
2759 ;;{{{ CRM114 Mailfilter
2760 (defun spam-check-crm114-headers (&optional score)
2761   (let ((header (message-fetch-field spam-crm114-header)))
2762     (when header                        ; return nil when no header
2763       (if score                         ; scoring mode
2764           (if (string-match "( pR: \\([0-9.-]+\\)" header)
2765               (match-string 1 header)
2766             "0")
2767         ;; spam detection mode
2768         (when (string-match spam-crm114-positive-spam-header
2769                             header)
2770           spam-split-group)))))
2771
2772 ;; return something sensible if the score can't be determined
2773 (defun spam-crm114-score ()
2774   "Get the CRM114 Mailfilter pR"
2775   (interactive)
2776   (save-window-excursion
2777     (gnus-summary-show-article t)
2778     (set-buffer gnus-article-buffer)
2779     (let ((score (or (spam-check-crm114-headers t)
2780                      (spam-check-crm114 t))))
2781       (gnus-summary-show-article)
2782       (message "pR: %s" score)
2783       (or score "0"))))
2784
2785 (defun spam-check-crm114 (&optional score)
2786   "Check the CRM114 Mailfilter backend for the classification of this message"
2787   (let ((article-buffer-name (buffer-name))
2788         (db spam-crm114-database-directory)
2789         return)
2790     (with-temp-buffer
2791       (let ((temp-buffer-name (buffer-name)))
2792         (save-excursion
2793           (set-buffer article-buffer-name)
2794           (apply 'call-process-region
2795                  (point-min) (point-max)
2796                  spam-crm114-program
2797                  nil temp-buffer-name nil
2798                  (when db (list (concat "--fileprefix=" db)))))
2799         (setq return (spam-check-crm114-headers score))))
2800     return))
2801
2802 (defun spam-crm114-register-with-crm114 (articles
2803                                          spam
2804                                          &optional unregister)
2805   "Register an article, given as a string, as spam or non-spam."
2806   (dolist (article articles)
2807     (let ((article-string (spam-get-article-as-string article))
2808           (db spam-crm114-database-directory)
2809           (switch (if unregister
2810                       (if spam
2811                           spam-crm114-spam-strong-switch
2812                         spam-crm114-ham-strong-switch)
2813                     (if spam
2814                         spam-crm114-spam-switch
2815                       spam-crm114-ham-switch))))
2816       (when (stringp article-string)
2817         (with-temp-buffer
2818           (insert article-string)
2819
2820           (apply 'call-process-region
2821                  (point-min) (point-max)
2822                  spam-crm114-program
2823                  nil nil nil
2824                  (when db (list switch (concat "--fileprefix=" db)))))))))
2825
2826 (defun spam-crm114-register-spam-routine (articles &optional unregister)
2827   (spam-crm114-register-with-crm114 articles t unregister))
2828
2829 (defun spam-crm114-unregister-spam-routine (articles)
2830   (spam-crm114-register-spam-routine articles t))
2831
2832 (defun spam-crm114-register-ham-routine (articles &optional unregister)
2833   (spam-crm114-register-with-crm114 articles nil unregister))
2834
2835 (defun spam-crm114-unregister-ham-routine (articles)
2836   (spam-crm114-register-ham-routine articles t))
2837
2838 ;;}}}
2839
2840 ;;}}}
2841
2842 ;;{{{ Hooks
2843
2844 ;;;###autoload
2845 (defun spam-initialize (&rest symbols)
2846   "Install the spam.el hooks and do other initialization.
2847 When SYMBOLS is given, set those variables to t.  This is so you
2848 can call spam-initialize before you set spam-use-* variables on
2849 explicitly, and matters only if you need the extra headers
2850 installed through spam-necessary-extra-headers."
2851   (interactive)
2852
2853   (dolist (var symbols)
2854     (set var t))
2855
2856   (dolist (header (spam-necessary-extra-headers))
2857     (add-to-list 'nnmail-extra-headers header)
2858     (add-to-list 'gnus-extra-headers header))
2859
2860   (setq spam-install-hooks t)
2861   ;; TODO: How do we redo this every time spam-face is customized?
2862   (push '((eq mark gnus-spam-mark) . spam-face)
2863         gnus-summary-highlight)
2864   ;; Add hooks for loading and saving the spam stats
2865   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2866   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2867   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2868   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2869   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2870   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2871   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2872
2873 (defun spam-unload-hook ()
2874   "Uninstall the spam.el hooks"
2875   (interactive)
2876   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2877   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2878   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2879   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2880   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2881   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2882   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2883
2884 (add-hook 'spam-unload-hook 'spam-unload-hook)
2885
2886 (when spam-install-hooks
2887   (spam-initialize))
2888 ;;}}}
2889
2890 (provide 'spam)
2891
2892 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
2893 ;;; spam.el ends here