Fix previous commit.
[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-search-simple "bbdb"))
2027
2028 (eval-and-compile
2029   (when (condition-case nil
2030             (progn
2031               (require 'bbdb)
2032               (require 'bbdb-com))
2033           (file-error
2034            ;; `bbdb-records' should not be bound as an autoload function
2035            ;; before loading bbdb because of `bbdb-hashtable-size'.
2036            (defalias 'bbdb-records 'ignore)
2037            (defalias 'spam-BBDB-register-routine 'ignore)
2038            (defalias 'spam-enter-ham-BBDB 'ignore)
2039            nil))
2040
2041     ;; when the BBDB changes, we want to clear out our cache
2042     (defun spam-clear-cache-BBDB (&rest immaterial)
2043       (spam-clear-cache 'spam-use-BBDB))
2044
2045     (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
2046
2047     (defun spam-enter-ham-BBDB (addresses &optional remove)
2048       "Enter an address into the BBDB; implies ham (non-spam) sender"
2049       (dolist (from addresses)
2050         (when (stringp from)
2051           (let* ((parsed-address (gnus-extract-address-components from))
2052                  (name (or (nth 0 parsed-address) "Ham Sender"))
2053                  (remove-function (if remove
2054                                       'bbdb-delete-record-internal
2055                                     'ignore))
2056                  (net-address (nth 1 parsed-address))
2057                  (record (and net-address
2058                               (bbdb-search-simple nil net-address))))
2059             (when net-address
2060               (gnus-message 6 "%s address %s %s BBDB"
2061                             (if remove "Deleting" "Adding")
2062                             from
2063                             (if remove "from" "to"))
2064               (if record
2065                   (funcall remove-function record)
2066                 (bbdb-create-internal name nil net-address nil nil
2067                                       "ham sender added by spam.el")))))))
2068
2069     (defun spam-BBDB-register-routine (articles &optional unregister)
2070       (let (addresses)
2071         (dolist (article articles)
2072           (when (stringp (spam-fetch-field-from-fast article))
2073             (push (spam-fetch-field-from-fast article) addresses)))
2074         ;; now do the register/unregister action
2075         (spam-enter-ham-BBDB addresses unregister)))
2076
2077     (defun spam-BBDB-unregister-routine (articles)
2078       (spam-BBDB-register-routine articles t))
2079
2080     (defun spam-check-BBDB ()
2081       "Mail from people in the BBDB is classified as ham or non-spam"
2082       (let ((who (message-fetch-field "from"))
2083             bbdb-cache bbdb-hashtable)
2084         (when spam-cache-lookups
2085           (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
2086           (unless bbdb-cache
2087             (setq bbdb-cache
2088                   ;; this is the expanded (bbdb-hashtable) macro
2089                   ;; without the debugging support
2090                   (with-current-buffer (bbdb-buffer)
2091                     (save-excursion
2092                       (save-window-excursion
2093                         (bbdb-records nil t)
2094                         bbdb-hashtable))))
2095             (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
2096         (when who
2097           (setq who (nth 1 (gnus-extract-address-components who)))
2098           (if
2099               (if spam-cache-lookups
2100                   (symbol-value
2101                    (intern-soft who bbdb-cache))
2102                 (bbdb-search-simple nil who))
2103               t
2104             (if spam-use-BBDB-exclusive
2105                 spam-split-group
2106               nil)))))))
2107
2108 ;;}}}
2109
2110 ;;{{{ ifile
2111
2112 ;;; check the ifile backend; return nil if the mail was NOT classified
2113 ;;; as spam
2114
2115 (defun spam-get-ifile-database-parameter ()
2116   "Get the command-line parameter for ifile's database from
2117   spam-ifile-database-path."
2118   (if spam-ifile-database-path
2119       (format "--db-file=%s" spam-ifile-database-path)
2120     nil))
2121
2122 (defun spam-check-ifile ()
2123   "Check the ifile backend for the classification of this message."
2124   (let ((article-buffer-name (buffer-name))
2125         category return)
2126     (with-temp-buffer
2127       (let ((temp-buffer-name (buffer-name))
2128             (db-param (spam-get-ifile-database-parameter)))
2129         (save-excursion
2130           (set-buffer article-buffer-name)
2131           (apply 'call-process-region
2132                  (point-min) (point-max) spam-ifile-path
2133                  nil temp-buffer-name nil "-c"
2134                  (if db-param `(,db-param "-q") `("-q"))))
2135         ;; check the return now (we're back in the temp buffer)
2136         (goto-char (point-min))
2137         (if (not (eobp))
2138             (setq category (buffer-substring (point) (point-at-eol))))
2139         (when (not (zerop (length category))) ; we need a category here
2140           (if spam-ifile-all-categories
2141               (setq return category)
2142             ;; else, if spam-ifile-all-categories is not set...
2143             (when (string-equal spam-ifile-spam-category category)
2144               (setq return spam-split-group)))))) ; note return is nil otherwise
2145     return))
2146
2147 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
2148   "Register an article, given as a string, with a category.
2149 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
2150   (let ((category (or category gnus-newsgroup-name))
2151         (add-or-delete-option (if unregister "-d" "-i"))
2152         (db (spam-get-ifile-database-parameter))
2153         parameters)
2154     (with-temp-buffer
2155       (dolist (article articles)
2156         (let ((article-string (spam-get-article-as-string article)))
2157           (when (stringp article-string)
2158             (insert article-string))))
2159       (apply 'call-process-region
2160              (point-min) (point-max) spam-ifile-path
2161              nil nil nil
2162              add-or-delete-option category
2163              (if db `(,db "-h") `("-h"))))))
2164
2165 (defun spam-ifile-register-spam-routine (articles &optional unregister)
2166   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
2167
2168 (defun spam-ifile-unregister-spam-routine (articles)
2169   (spam-ifile-register-spam-routine articles t))
2170
2171 (defun spam-ifile-register-ham-routine (articles &optional unregister)
2172   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
2173
2174 (defun spam-ifile-unregister-ham-routine (articles)
2175   (spam-ifile-register-ham-routine articles t))
2176
2177 ;;}}}
2178
2179 ;;{{{ spam-stat
2180
2181 (eval-when-compile
2182   (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
2183   (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
2184   (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
2185   (autoload 'spam-stat-buffer-is-spam "spam-stat")
2186   (autoload 'spam-stat-load "spam-stat")
2187   (autoload 'spam-stat-save "spam-stat")
2188   (autoload 'spam-stat-split-fancy "spam-stat"))
2189
2190 (eval-and-compile
2191   (when (condition-case nil
2192             (let ((spam-stat-install-hooks nil))
2193               (require 'spam-stat))
2194           (file-error
2195            (defalias 'spam-stat-register-ham-routine 'ignore)
2196            (defalias 'spam-stat-register-spam-routine 'ignore)
2197            nil))
2198
2199     (defun spam-check-stat ()
2200       "Check the spam-stat backend for the classification of this message"
2201       (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
2202             (spam-stat-buffer (buffer-name)) ; stat the current buffer
2203             category return)
2204         (spam-stat-split-fancy)))
2205
2206     (defun spam-stat-register-spam-routine (articles &optional unregister)
2207       (dolist (article articles)
2208         (let ((article-string (spam-get-article-as-string article)))
2209           (with-temp-buffer
2210             (insert article-string)
2211             (if unregister
2212                 (spam-stat-buffer-change-to-non-spam)
2213               (spam-stat-buffer-is-spam))))))
2214
2215     (defun spam-stat-unregister-spam-routine (articles)
2216       (spam-stat-register-spam-routine articles t))
2217
2218     (defun spam-stat-register-ham-routine (articles &optional unregister)
2219       (dolist (article articles)
2220         (let ((article-string (spam-get-article-as-string article)))
2221           (with-temp-buffer
2222             (insert article-string)
2223             (if unregister
2224                 (spam-stat-buffer-change-to-spam)
2225               (spam-stat-buffer-is-non-spam))))))
2226
2227     (defun spam-stat-unregister-ham-routine (articles)
2228       (spam-stat-register-ham-routine articles t))
2229
2230     (defun spam-maybe-spam-stat-load ()
2231       (when spam-use-stat (spam-stat-load)))
2232
2233     (defun spam-maybe-spam-stat-save ()
2234       (when spam-use-stat (spam-stat-save)))))
2235
2236 ;;}}}
2237
2238 ;;{{{ Blacklists and whitelists.
2239
2240 (defvar spam-whitelist-cache nil)
2241 (defvar spam-blacklist-cache nil)
2242
2243 (defun spam-kill-whole-line ()
2244   (beginning-of-line)
2245   (let ((kill-whole-line t))
2246     (kill-line)))
2247
2248 ;;; address can be a list, too
2249 (defun spam-enter-whitelist (address &optional remove)
2250   "Enter ADDRESS (list or single) into the whitelist.
2251 With a non-nil REMOVE, remove them."
2252   (interactive "sAddress: ")
2253   (spam-enter-list address spam-whitelist remove)
2254   (setq spam-whitelist-cache nil)
2255   (spam-clear-cache 'spam-use-whitelist))
2256
2257 ;;; address can be a list, too
2258 (defun spam-enter-blacklist (address &optional remove)
2259   "Enter ADDRESS (list or single) into the blacklist.
2260 With a non-nil REMOVE, remove them."
2261   (interactive "sAddress: ")
2262   (spam-enter-list address spam-blacklist remove)
2263   (setq spam-blacklist-cache nil)
2264   (spam-clear-cache 'spam-use-whitelist))
2265
2266 (defun spam-enter-list (addresses file &optional remove)
2267   "Enter ADDRESSES into the given FILE.
2268 Either the whitelist or the blacklist files can be used.  With
2269 REMOVE not nil, remove the ADDRESSES."
2270   (if (stringp addresses)
2271       (spam-enter-list (list addresses) file remove)
2272     ;; else, we have a list of addresses here
2273     (unless (file-exists-p (file-name-directory file))
2274       (make-directory (file-name-directory file) t))
2275     (save-excursion
2276       (set-buffer
2277        (find-file-noselect file))
2278       (dolist (a addresses)
2279         (when (stringp a)
2280           (goto-char (point-min))
2281           (if (re-search-forward (regexp-quote a) nil t)
2282               ;; found the address
2283               (when remove
2284                 (spam-kill-whole-line))
2285             ;; else, the address was not found
2286             (unless remove
2287               (goto-char (point-max))
2288               (unless (bobp)
2289                 (insert "\n"))
2290               (insert a "\n")))))
2291       (save-buffer))))
2292
2293 (defun spam-filelist-build-cache (type)
2294   (let ((cache (if (eq type 'spam-use-blacklist)
2295                    spam-blacklist-cache
2296                  spam-whitelist-cache))
2297         parsed-cache)
2298     (unless (gethash type spam-caches)
2299       (while cache
2300         (let ((address (pop cache)))
2301           (unless (zerop (length address)) ; 0 for a nil address too
2302             (setq address (regexp-quote address))
2303             ;; fix regexp-quote's treatment of user-intended regexes
2304             (while (string-match "\\\\\\*" address)
2305               (setq address (replace-match ".*" t t address))))
2306           (push address parsed-cache)))
2307       (puthash type parsed-cache spam-caches))))
2308
2309 (defun spam-filelist-check-cache (type from)
2310   (when (stringp from)
2311     (spam-filelist-build-cache type)
2312     (let (found)
2313       (dolist (address (gethash type spam-caches))
2314         (when (and address (string-match address from))
2315           (setq found t)
2316           (return)))
2317       found)))
2318
2319 ;;; returns t if the sender is in the whitelist, nil or
2320 ;;; spam-split-group otherwise
2321 (defun spam-check-whitelist ()
2322   ;; FIXME!  Should it detect when file timestamps change?
2323   (unless spam-whitelist-cache
2324     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
2325   (if (spam-from-listed-p 'spam-use-whitelist)
2326       t
2327     (if spam-use-whitelist-exclusive
2328         spam-split-group
2329       nil)))
2330
2331 (defun spam-check-blacklist ()
2332   ;; FIXME!  Should it detect when file timestamps change?
2333   (unless spam-blacklist-cache
2334     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
2335   (and (spam-from-listed-p 'spam-use-blacklist)
2336        spam-split-group))
2337
2338 (defun spam-parse-list (file)
2339   (when (file-readable-p file)
2340     (let (contents address)
2341       (with-temp-buffer
2342         (insert-file-contents file)
2343         (while (not (eobp))
2344           (setq address (buffer-substring (point) (point-at-eol)))
2345           (forward-line 1)
2346           ;; insert the e-mail address if detected, otherwise the raw data
2347           (unless (zerop (length address))
2348             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
2349               (push (or pure-address address) contents)))))
2350       (nreverse contents))))
2351
2352 (defun spam-from-listed-p (type)
2353   (let ((from (message-fetch-field "from"))
2354         found)
2355     (spam-filelist-check-cache type from)))
2356
2357 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
2358   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
2359         (declassification (if blacklist 'ham 'spam))
2360         (enter-function
2361          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2362         (remove-function
2363          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2364         from addresses unregister-list article-unregister-list)
2365     (dolist (article articles)
2366       (let ((from (spam-fetch-field-from-fast article))
2367             (id (spam-fetch-field-message-id-fast article))
2368             sender-ignored)
2369         (when (stringp from)
2370           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2371             (when (and (not sender-ignored)
2372                        (stringp ignore-regex)
2373                        (string-match ignore-regex from))
2374               (setq sender-ignored t)))
2375           ;; remember the messages we need to unregister, unless remove is set
2376           (when (and
2377                  (null unregister)
2378                  (spam-log-unregistration-needed-p
2379                   id 'process declassification de-symbol))
2380             (push article article-unregister-list)
2381             (push from unregister-list))
2382           (unless sender-ignored
2383             (push from addresses)))))
2384
2385     (if unregister
2386         (funcall enter-function addresses t) ; unregister all these addresses
2387       ;; else, register normally and unregister what we need to
2388       (funcall remove-function unregister-list t)
2389       (dolist (article article-unregister-list)
2390         (spam-log-undo-registration
2391          (spam-fetch-field-message-id-fast article)
2392          'process
2393          declassification
2394          de-symbol))
2395       (funcall enter-function addresses nil))))
2396
2397 (defun spam-blacklist-unregister-routine (articles)
2398   (spam-blacklist-register-routine articles t))
2399
2400 (defun spam-blacklist-register-routine (articles &optional unregister)
2401   (spam-filelist-register-routine articles t unregister))
2402
2403 (defun spam-whitelist-unregister-routine (articles)
2404   (spam-whitelist-register-routine articles t))
2405
2406 (defun spam-whitelist-register-routine (articles &optional unregister)
2407   (spam-filelist-register-routine articles nil unregister))
2408
2409 ;;}}}
2410
2411 ;;{{{ Spam-report glue (gmane and resend reporting)
2412 (defun spam-report-gmane-register-routine (articles)
2413   (when articles
2414     (apply 'spam-report-gmane articles)))
2415
2416 (defun spam-report-resend-register-ham-routine (articles)
2417   (spam-report-resend-register-routine articles t))
2418
2419 (defun spam-report-resend-register-routine (articles &optional ham)
2420   (let* ((resend-to-gp 
2421           (if ham
2422               (gnus-parameter-ham-resend-to gnus-newsgroup-name)
2423             (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
2424          (spam-report-resend-to (or (car-safe resend-to-gp)
2425                                     spam-report-resend-to)))
2426     (spam-report-resend articles ham)))
2427
2428 ;;}}}
2429
2430 ;;{{{ Bogofilter
2431 (defun spam-check-bogofilter-headers (&optional score)
2432   (let ((header (message-fetch-field spam-bogofilter-header)))
2433     (when header                        ; return nil when no header
2434       (if score                         ; scoring mode
2435           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2436               (match-string 1 header)
2437             "0")
2438         ;; spam detection mode
2439         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2440                             header)
2441           spam-split-group)))))
2442
2443 ;; return something sensible if the score can't be determined
2444 (defun spam-bogofilter-score (&optional recheck)
2445   "Get the Bogofilter spamicity score"
2446   (interactive "P")
2447   (save-window-excursion
2448     (gnus-summary-show-article t)
2449     (set-buffer gnus-article-buffer)
2450     (let ((score (or (unless recheck
2451                        (spam-check-bogofilter-headers t))
2452                      (spam-check-bogofilter t))))
2453       (gnus-summary-show-article)
2454       (message "Spamicity score %s" score)
2455       (or score "0"))))
2456
2457 (defun spam-verify-bogofilter ()
2458   "Verify the Bogofilter version is sufficient."
2459   (when (eq spam-bogofilter-valid 'unknown)
2460     (setq spam-bogofilter-valid
2461           (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
2462                              (shell-command-to-string 
2463                               (format "%s -V" spam-bogofilter-path))))))
2464   spam-bogofilter-valid)
2465   
2466 (defun spam-check-bogofilter (&optional score)
2467   "Check the Bogofilter backend for the classification of this message."
2468   (if (spam-verify-bogofilter)
2469       (let ((article-buffer-name (buffer-name))
2470             (db spam-bogofilter-database-directory)
2471             return)
2472         (with-temp-buffer
2473           (let ((temp-buffer-name (buffer-name)))
2474             (save-excursion
2475               (set-buffer article-buffer-name)
2476               (apply 'call-process-region
2477                      (point-min) (point-max)
2478                      spam-bogofilter-path
2479                      nil temp-buffer-name nil
2480                      (if db `("-d" ,db "-v") `("-v"))))
2481             (setq return (spam-check-bogofilter-headers score))))
2482         return)
2483     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2484
2485 (defun spam-bogofilter-register-with-bogofilter (articles
2486                                                  spam
2487                                                  &optional unregister)
2488   "Register an article, given as a string, as spam or non-spam."
2489   (if (spam-verify-bogofilter)
2490       (dolist (article articles)
2491         (let ((article-string (spam-get-article-as-string article))
2492               (db spam-bogofilter-database-directory)
2493               (switch (if unregister
2494                           (if spam
2495                               spam-bogofilter-spam-strong-switch
2496                             spam-bogofilter-ham-strong-switch)
2497                         (if spam
2498                             spam-bogofilter-spam-switch
2499                           spam-bogofilter-ham-switch))))
2500           (when (stringp article-string)
2501             (with-temp-buffer
2502               (insert article-string)
2503               
2504               (apply 'call-process-region
2505                      (point-min) (point-max)
2506                      spam-bogofilter-path
2507                      nil nil nil switch
2508                      (if db `("-d" ,db "-v") `("-v")))))))
2509     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2510
2511 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2512   (spam-bogofilter-register-with-bogofilter articles t unregister))
2513
2514 (defun spam-bogofilter-unregister-spam-routine (articles)
2515   (spam-bogofilter-register-spam-routine articles t))
2516
2517 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2518   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2519
2520 (defun spam-bogofilter-unregister-ham-routine (articles)
2521   (spam-bogofilter-register-ham-routine articles t))
2522
2523
2524 ;;}}}
2525
2526 ;;{{{ spamoracle
2527 (defun spam-check-spamoracle ()
2528   "Run spamoracle on an article to determine whether it's spam."
2529   (let ((article-buffer-name (buffer-name)))
2530     (with-temp-buffer
2531       (let ((temp-buffer-name (buffer-name)))
2532         (save-excursion
2533           (set-buffer article-buffer-name)
2534           (let ((status
2535                  (apply 'call-process-region
2536                         (point-min) (point-max)
2537                         spam-spamoracle-binary
2538                         nil temp-buffer-name nil
2539                         (if spam-spamoracle-database
2540                             `("-f" ,spam-spamoracle-database "mark")
2541                           '("mark")))))
2542             (if (eq 0 status)
2543                 (progn
2544                   (set-buffer temp-buffer-name)
2545                   (goto-char (point-min))
2546                   (when (re-search-forward "^X-Spam: yes;" nil t)
2547                     spam-split-group))
2548               (error "Error running spamoracle: %s" status))))))))
2549
2550 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2551   "Run spamoracle in training mode."
2552   (with-temp-buffer
2553     (let ((temp-buffer-name (buffer-name)))
2554       (save-excursion
2555         (goto-char (point-min))
2556         (dolist (article articles)
2557           (insert (spam-get-article-as-string article)))
2558         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2559                         "-spam"
2560                       "-good"))
2561                (status
2562                 (apply 'call-process-region
2563                        (point-min) (point-max)
2564                        spam-spamoracle-binary
2565                        nil temp-buffer-name nil
2566                        (if spam-spamoracle-database
2567                            `("-f" ,spam-spamoracle-database
2568                              "add" ,arg)
2569                          `("add" ,arg)))))
2570           (unless (eq 0 status)
2571             (error "Error running spamoracle: %s" status)))))))
2572
2573 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2574   (spam-spamoracle-learn articles nil unregister))
2575
2576 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2577   (spam-spamoracle-learn-ham articles t))
2578
2579 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2580   (spam-spamoracle-learn articles t unregister))
2581
2582 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2583   (spam-spamoracle-learn-spam articles t))
2584
2585 ;;}}}
2586
2587 ;;{{{ SpamAssassin
2588 ;;; based mostly on the bogofilter code
2589 (defun spam-check-spamassassin-headers (&optional score)
2590   "Check the SpamAssassin headers for the classification of this message."
2591   (if score                             ; scoring mode
2592       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2593         (when header
2594           (if (string-match "hits=\\(-?[0-9.]+\\)" header)
2595               (match-string 1 header)
2596             "0")))
2597     ;; spam detection mode
2598     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)))
2599           (when header                  ; return nil when no header
2600             (when (string-match spam-spamassassin-positive-spam-flag-header
2601                                 header)
2602               spam-split-group)))))
2603
2604 (defun spam-check-spamassassin (&optional score)
2605   "Check the SpamAssassin backend for the classification of this message."
2606   (let ((article-buffer-name (buffer-name)))
2607     (with-temp-buffer
2608       (let ((temp-buffer-name (buffer-name)))
2609         (save-excursion
2610           (set-buffer article-buffer-name)
2611           (apply 'call-process-region
2612                  (point-min) (point-max) spam-spamassassin-path
2613                  nil temp-buffer-name nil spam-spamassassin-arguments))
2614         ;; check the return now (we're back in the temp buffer)
2615         (goto-char (point-min))
2616         (spam-check-spamassassin-headers score)))))
2617
2618 ;; return something sensible if the score can't be determined
2619 (defun spam-spamassassin-score (&optional recheck)
2620   "Get the SpamAssassin score"
2621   (interactive "P")
2622   (save-window-excursion
2623     (gnus-summary-show-article t)
2624     (set-buffer gnus-article-buffer)
2625     (let ((score (or (unless recheck
2626                        (spam-check-spamassassin-headers t))
2627                      (spam-check-spamassassin t))))
2628       (gnus-summary-show-article)
2629       (message "SpamAssassin score %s" score)
2630       (or score "0"))))
2631
2632 (defun spam-spamassassin-register-with-sa-learn (articles spam
2633                                                  &optional unregister)
2634   "Register articles with spamassassin's sa-learn as spam or non-spam."
2635   (if articles
2636       (let ((action (if unregister spam-sa-learn-unregister-switch
2637                       (if spam spam-sa-learn-spam-switch
2638                         spam-sa-learn-ham-switch)))
2639             (summary-buffer-name (buffer-name)))
2640         (with-temp-buffer
2641           ;; group the articles into mbox format
2642           (dolist (article articles)
2643             (let (article-string)
2644               (save-excursion
2645                 (set-buffer summary-buffer-name)
2646                 (setq article-string (spam-get-article-as-string article)))
2647               (when (stringp article-string)
2648                 (insert "From \n") ; mbox separator (sa-learn only checks the
2649                                    ; first five chars, so we can get away with
2650                                    ; a bogus line))
2651                 (insert article-string)
2652                 (insert "\n"))))
2653           ;; call sa-learn on all messages at the same time
2654           (apply 'call-process-region
2655                  (point-min) (point-max)
2656                  spam-sa-learn-path
2657                  nil nil nil "--mbox"
2658                  (if spam-sa-learn-rebuild
2659                      (list action)
2660                    `("--no-rebuild" ,action)))))))
2661
2662 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2663   (spam-spamassassin-register-with-sa-learn articles t unregister))
2664
2665 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2666   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2667
2668 (defun spam-spamassassin-unregister-spam-routine (articles)
2669   (spam-spamassassin-register-with-sa-learn articles t t))
2670
2671 (defun spam-spamassassin-unregister-ham-routine (articles)
2672   (spam-spamassassin-register-with-sa-learn articles nil t))
2673
2674 ;;}}}
2675
2676 ;;{{{ Bsfilter
2677 ;;; based mostly on the bogofilter code
2678 (defun spam-check-bsfilter-headers (&optional score)
2679   (if score
2680       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2681           "0")
2682     (let ((header (nnmail-fetch-field spam-bsfilter-header)))
2683       (when header ; return nil when no header
2684         (when (string-match "YES" header)
2685           spam-split-group)))))
2686
2687 ;; return something sensible if the score can't be determined
2688 (defun spam-bsfilter-score (&optional recheck)
2689   "Get the Bsfilter spamicity score"
2690   (interactive "P")
2691   (save-window-excursion
2692     (gnus-summary-show-article t)
2693     (set-buffer gnus-article-buffer)
2694     (let ((score (or (unless recheck
2695                        (spam-check-bsfilter-headers t))
2696                      (spam-check-bsfilter t))))
2697       (gnus-summary-show-article)
2698       (message "Spamicity score %s" score)
2699       (or score "0"))))
2700
2701 (defun spam-check-bsfilter (&optional score)
2702   "Check the Bsfilter backend for the classification of this message"
2703   (let ((article-buffer-name (buffer-name))
2704         (dir spam-bsfilter-database-directory)
2705         return)
2706     (with-temp-buffer
2707       (let ((temp-buffer-name (buffer-name)))
2708         (save-excursion
2709           (set-buffer article-buffer-name)
2710           (apply 'call-process-region
2711                  (point-min) (point-max)
2712                  spam-bsfilter-path
2713                  nil temp-buffer-name nil
2714                  "--pipe"
2715                  "--insert-flag"
2716                  "--insert-probability"
2717                  (when dir
2718                    (list "--homedir" dir))))
2719         (setq return (spam-check-bsfilter-headers score))))
2720     return))
2721
2722 (defun spam-bsfilter-register-with-bsfilter (articles
2723                                              spam
2724                                              &optional unregister)
2725   "Register an article, given as a string, as spam or non-spam."
2726   (dolist (article articles)
2727     (let ((article-string (spam-get-article-as-string article))
2728           (switch (if unregister
2729                       (if spam
2730                           spam-bsfilter-spam-strong-switch
2731                         spam-bsfilter-ham-strong-switch)
2732                     (if spam
2733                         spam-bsfilter-spam-switch
2734                       spam-bsfilter-ham-switch))))
2735       (when (stringp article-string)
2736         (with-temp-buffer
2737           (insert article-string)
2738           (apply 'call-process-region
2739                  (point-min) (point-max)
2740                  spam-bsfilter-path
2741                  nil nil nil switch
2742                  "--update"
2743                  (when spam-bsfilter-database-directory
2744                    (list "--homedir"
2745                          spam-bsfilter-database-directory))))))))
2746
2747 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2748   (spam-bsfilter-register-with-bsfilter articles t unregister))
2749
2750 (defun spam-bsfilter-unregister-spam-routine (articles)
2751   (spam-bsfilter-register-spam-routine articles t))
2752
2753 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2754   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2755
2756 (defun spam-bsfilter-unregister-ham-routine (articles)
2757   (spam-bsfilter-register-ham-routine articles t))
2758
2759 ;;}}}
2760
2761 ;;{{{ CRM114 Mailfilter
2762 (defun spam-check-crm114-headers (&optional score)
2763   (let ((header (message-fetch-field spam-crm114-header)))
2764     (when header                        ; return nil when no header
2765       (if score                         ; scoring mode
2766           (if (string-match "( pR: \\([0-9.-]+\\)" header)
2767               (match-string 1 header)
2768             "0")
2769         ;; spam detection mode
2770         (when (string-match spam-crm114-positive-spam-header
2771                             header)
2772           spam-split-group)))))
2773
2774 ;; return something sensible if the score can't be determined
2775 (defun spam-crm114-score ()
2776   "Get the CRM114 Mailfilter pR"
2777   (interactive)
2778   (save-window-excursion
2779     (gnus-summary-show-article t)
2780     (set-buffer gnus-article-buffer)
2781     (let ((score (or (spam-check-crm114-headers t)
2782                      (spam-check-crm114 t))))
2783       (gnus-summary-show-article)
2784       (message "pR: %s" score)
2785       (or score "0"))))
2786
2787 (defun spam-check-crm114 (&optional score)
2788   "Check the CRM114 Mailfilter backend for the classification of this message"
2789   (let ((article-buffer-name (buffer-name))
2790         (db spam-crm114-database-directory)
2791         return)
2792     (with-temp-buffer
2793       (let ((temp-buffer-name (buffer-name)))
2794         (save-excursion
2795           (set-buffer article-buffer-name)
2796           (apply 'call-process-region
2797                  (point-min) (point-max)
2798                  spam-crm114-program
2799                  nil temp-buffer-name nil
2800                  (when db (list (concat "--fileprefix=" db)))))
2801         (setq return (spam-check-crm114-headers score))))
2802     return))
2803
2804 (defun spam-crm114-register-with-crm114 (articles
2805                                          spam
2806                                          &optional unregister)
2807   "Register an article, given as a string, as spam or non-spam."
2808   (dolist (article articles)
2809     (let ((article-string (spam-get-article-as-string article))
2810           (db spam-crm114-database-directory)
2811           (switch (if unregister
2812                       (if spam
2813                           spam-crm114-spam-strong-switch
2814                         spam-crm114-ham-strong-switch)
2815                     (if spam
2816                         spam-crm114-spam-switch
2817                       spam-crm114-ham-switch))))
2818       (when (stringp article-string)
2819         (with-temp-buffer
2820           (insert article-string)
2821
2822           (apply 'call-process-region
2823                  (point-min) (point-max)
2824                  spam-crm114-program
2825                  nil nil nil
2826                  (when db (list switch (concat "--fileprefix=" db)))))))))
2827
2828 (defun spam-crm114-register-spam-routine (articles &optional unregister)
2829   (spam-crm114-register-with-crm114 articles t unregister))
2830
2831 (defun spam-crm114-unregister-spam-routine (articles)
2832   (spam-crm114-register-spam-routine articles t))
2833
2834 (defun spam-crm114-register-ham-routine (articles &optional unregister)
2835   (spam-crm114-register-with-crm114 articles nil unregister))
2836
2837 (defun spam-crm114-unregister-ham-routine (articles)
2838   (spam-crm114-register-ham-routine articles t))
2839
2840 ;;}}}
2841
2842 ;;}}}
2843
2844 ;;{{{ Hooks
2845
2846 ;;;###autoload
2847 (defun spam-initialize (&rest symbols)
2848   "Install the spam.el hooks and do other initialization.
2849 When SYMBOLS is given, set those variables to t.  This is so you
2850 can call spam-initialize before you set spam-use-* variables on
2851 explicitly, and matters only if you need the extra headers
2852 installed through spam-necessary-extra-headers."
2853   (interactive)
2854
2855   (dolist (var symbols)
2856     (set var t))
2857
2858   (dolist (header (spam-necessary-extra-headers))
2859     (add-to-list 'nnmail-extra-headers header)
2860     (add-to-list 'gnus-extra-headers header))
2861
2862   (setq spam-install-hooks t)
2863   ;; TODO: How do we redo this every time spam-face is customized?
2864   (push '((eq mark gnus-spam-mark) . spam-face)
2865         gnus-summary-highlight)
2866   ;; Add hooks for loading and saving the spam stats
2867   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2868   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2869   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2870   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2871   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2872   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2873   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2874
2875 (defun spam-unload-hook ()
2876   "Uninstall the spam.el hooks"
2877   (interactive)
2878   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2879   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2880   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2881   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2882   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2883   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2884   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2885
2886 (add-hook 'spam-unload-hook 'spam-unload-hook)
2887
2888 (when spam-install-hooks
2889   (spam-initialize))
2890 ;;}}}
2891
2892 (provide 'spam)
2893
2894 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
2895 ;;; spam.el ends here