(spam-user-format-function-S): format the score correctly
[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
84 (defcustom spam-summary-exit-behavior 'default
85   "Exit behavior at the time of summary exit.
86 Note that setting the spam-use-move or spam-use-copy backends on
87 a group through group/topic parameters overrides this mechanism."
88   :type '(choice (const 'default :tag 
89                         "Move spam out of all groups.  Move ham out of spam groups.")
90                  (const 'move-all :tag 
91                         "Move spam out of all groups.  Move ham out of all groups.")
92                  (const 'move-none :tag 
93                         "Never move spam or ham out of any groups."))
94   :group 'spam)
95
96 (defcustom spam-directory (nnheader-concat gnus-directory "spam/")
97   "Directory for spam whitelists and blacklists."
98   :type 'directory
99   :group 'spam)
100
101 (defcustom spam-mark-new-messages-in-spam-group-as-spam t
102   "Whether new messages in a spam group should get the spam-mark."
103   :type 'boolean
104   :group 'spam)
105
106 (defcustom spam-log-to-registry nil
107   "Whether spam/ham processing should be logged in the registry."
108   :type 'boolean
109   :group 'spam)
110
111 (defcustom spam-split-symbolic-return nil
112   "Whether `spam-split' should work with symbols or group names."
113   :type 'boolean
114   :group 'spam)
115
116 (defcustom spam-split-symbolic-return-positive nil
117   "Whether `spam-split' should ALWAYS work with symbols or group names.
118 Do not set this if you use `spam-split' in a fancy split
119   method."
120   :type 'boolean
121   :group 'spam)
122
123 (defcustom spam-mark-only-unseen-as-spam t
124   "Whether only unseen articles should be marked as spam in spam groups.
125 When nil, all unread articles in a spam group are marked as
126 spam.  Set this if you want to leave an article unread in a spam group
127 without losing it to the automatic spam-marking process."
128   :type 'boolean
129   :group 'spam)
130
131 (defcustom spam-mark-ham-unread-before-move-from-spam-group nil
132   "Whether ham should be marked unread before it's moved.
133 The article is moved out of a spam group according to ham-process-destination.
134 This variable is an official entry in the international Longest Variable Name
135 Competition."
136   :type 'boolean
137   :group 'spam)
138
139 (defcustom spam-disable-spam-split-during-ham-respool nil
140   "Whether `spam-split' should be ignored while resplitting ham.
141 This is useful to prevent ham from ending up in the same spam
142 group after the resplit.  Don't set this to t if you have `spam-split' as the
143 last rule in your split configuration."
144   :type 'boolean
145   :group 'spam)
146
147 (defcustom spam-autodetect-recheck-messages nil
148   "Should spam.el recheck all meessages when autodetecting?
149 Normally this is nil, so only unseen messages will be checked."
150   :type 'boolean
151   :group 'spam)
152
153 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
154   "The location of the whitelist.
155 The file format is one regular expression per line.
156 The regular expression is matched against the address."
157   :type 'file
158   :group 'spam)
159
160 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
161   "The location of the blacklist.
162 The file format is one regular expression per line.
163 The regular expression is matched against the address."
164   :type 'file
165   :group 'spam)
166
167 (defcustom spam-use-dig t
168   "Whether `query-dig' should be used instead of `query-dns'."
169   :type 'boolean
170   :group 'spam)
171
172 (defcustom spam-use-gmane-xref nil
173   "Whether the Gmane spam xref should be used by `spam-split'."
174   :type 'boolean
175   :group 'spam)
176
177 (defcustom spam-use-blacklist nil
178   "Whether the blacklist should be used by `spam-split'."
179   :type 'boolean
180   :group 'spam)
181
182 (defcustom spam-blacklist-ignored-regexes nil
183   "Regular expressions that the blacklist should ignore."
184   :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
185   :group 'spam)
186
187 (defcustom spam-use-whitelist nil
188   "Whether the whitelist should be used by `spam-split'."
189   :type 'boolean
190   :group 'spam)
191
192 (defcustom spam-use-whitelist-exclusive nil
193   "Whether whitelist-exclusive should be used by `spam-split'.
194 Exclusive whitelisting means that all messages from senders not in the whitelist
195 are considered spam."
196   :type 'boolean
197   :group 'spam)
198
199 (defcustom spam-use-blackholes nil
200   "Whether blackholes should be used by `spam-split'."
201   :type 'boolean
202   :group 'spam)
203
204 (defcustom spam-use-hashcash nil
205   "Whether hashcash payments should be detected by `spam-split'."
206   :type 'boolean
207   :group 'spam)
208
209 (defcustom spam-use-regex-headers nil
210   "Whether a header regular expression match should be used by `spam-split'.
211 Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
212   :type 'boolean
213   :group 'spam)
214
215 (defcustom spam-use-regex-body nil
216   "Whether a body regular expression match should be used by `spam-split'.
217 Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
218   :type 'boolean
219   :group 'spam)
220
221 (defcustom spam-use-bogofilter-headers nil
222   "Whether bogofilter headers should be used by `spam-split'.
223 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
224   :type 'boolean
225   :group 'spam)
226
227 (defcustom spam-use-bogofilter nil
228   "Whether bogofilter should be invoked by `spam-split'.
229 Enable this if you want Gnus to invoke Bogofilter on new messages."
230   :type 'boolean
231   :group 'spam)
232
233 (defcustom spam-use-bsfilter-headers nil
234   "Whether bsfilter headers should be used by `spam-split'.
235 Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them."
236   :type 'boolean
237   :group 'spam)
238
239 (defcustom spam-use-bsfilter nil
240   "Whether bsfilter should be invoked by `spam-split'.
241 Enable this if you want Gnus to invoke Bsfilter on new messages."
242   :type 'boolean
243   :group 'spam)
244
245 (defcustom spam-use-BBDB nil
246   "Whether BBDB should be used by `spam-split'."
247   :type 'boolean
248   :group 'spam)
249
250 (defcustom spam-use-BBDB-exclusive nil
251   "Whether BBDB-exclusive should be used by `spam-split'.
252 Exclusive BBDB means that all messages from senders not in the BBDB are
253 considered spam."
254   :type 'boolean
255   :group 'spam)
256
257 (defcustom spam-use-ifile nil
258   "Whether ifile should be used by `spam-split'."
259   :type 'boolean
260   :group 'spam)
261
262 (defcustom spam-use-stat nil
263   "Whether `spam-stat' should be used by `spam-split'."
264   :type 'boolean
265   :group 'spam)
266
267 (defcustom spam-use-spamoracle nil
268   "Whether spamoracle should be used by `spam-split'."
269   :type 'boolean
270   :group 'spam)
271
272 (defcustom spam-use-spamassassin nil
273   "Whether spamassassin should be invoked by `spam-split'.
274 Enable this if you want Gnus to invoke SpamAssassin on new messages."
275   :type 'boolean
276   :group 'spam)
277
278 (defcustom spam-use-spamassassin-headers nil
279   "Whether spamassassin headers should be checked by `spam-split'.
280 Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees
281 them."
282   :type 'boolean
283   :group 'spam)
284
285 (defcustom spam-use-crm114 nil
286   "Whether the CRM114 Mailfilter should be used by `spam-split'."
287   :type 'boolean
288   :group 'spam)
289
290 (defcustom spam-install-hooks (or
291                                spam-use-dig
292                                spam-use-gmane-xref
293                                spam-use-blacklist
294                                spam-use-whitelist
295                                spam-use-whitelist-exclusive
296                                spam-use-blackholes
297                                spam-use-hashcash
298                                spam-use-regex-headers
299                                spam-use-regex-body
300                                spam-use-bogofilter
301                                spam-use-bogofilter-headers
302                                spam-use-spamassassin
303                                spam-use-spamassassin-headers
304                                spam-use-bsfilter
305                                spam-use-bsfilter-headers
306                                spam-use-BBDB
307                                spam-use-BBDB-exclusive
308                                spam-use-ifile
309                                spam-use-stat
310                                spam-use-spamoracle
311                                spam-use-crm114)
312   "Whether the spam hooks should be installed.
313 Default to t if one of the spam-use-* variables is set."
314   :group 'spam
315   :type 'boolean)
316
317 (defcustom spam-split-group "spam"
318   "Group name where incoming spam should be put by `spam-split'."
319   :type 'string
320   :group 'spam)
321
322 ;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
323 ;;; not regular expressions
324 (defcustom spam-junk-mailgroups (cons
325                                  spam-split-group
326                                  '("mail.junk" "poste.pourriel"))
327   "Mailgroups with spam contents.
328 All unmarked article in such group receive the spam mark on group entry."
329   :type '(repeat (string :tag "Group"))
330   :group 'spam)
331
332
333 (defcustom spam-gmane-xref-spam-group "gmane.spam.detected"
334   "The group where spam xrefs can be found on Gmane.
335 Only meaningful if you enable `spam-use-gmane-xref'."
336   :type 'string
337   :group 'spam)
338
339 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
340                                     "dev.null.dk" "relays.visi.com")
341   "List of blackhole servers.
342 Only meaningful if you enable `spam-use-blackholes'."
343   :type '(repeat (string :tag "Server"))
344   :group 'spam)
345
346 (defcustom spam-blackhole-good-server-regex nil
347   "String matching IP addresses that should not be checked in the blackholes.
348 Only meaningful if you enable `spam-use-blackholes'."
349   :type '(radio (const nil)
350                 (regexp :format "%t: %v\n" :size 0))
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 (condition-case nil
2003     (progn
2004       (require 'hashcash)
2005
2006       (defun spam-check-hashcash ()
2007         "Check the headers for hashcash payments."
2008         (mail-check-payment)))   ;mail-check-payment returns a boolean
2009
2010   (file-error (progn
2011                 (defalias 'mail-check-payment 'ignore)
2012                 (defalias 'spam-check-hashcash 'ignore))))
2013 ;;}}}
2014
2015 ;;{{{ BBDB
2016
2017 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
2018 ;;; <sacha@giotto.sj.ru>
2019
2020 ;; all this is done inside a condition-case to trap errors
2021
2022 (condition-case nil
2023     (progn
2024       (require 'bbdb)
2025       (require 'bbdb-com)
2026
2027       ;; when the BBDB changes, we want to clear out our cache
2028       (defun spam-clear-cache-BBDB (&rest immaterial)
2029         (spam-clear-cache 'spam-use-BBDB))
2030
2031       (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
2032
2033       (defun spam-enter-ham-BBDB (addresses &optional remove)
2034         "Enter an address into the BBDB; implies ham (non-spam) sender"
2035         (dolist (from addresses)
2036           (when (stringp from)
2037             (let* ((parsed-address (gnus-extract-address-components from))
2038                    (name (or (nth 0 parsed-address) "Ham Sender"))
2039                    (remove-function (if remove
2040                                         'bbdb-delete-record-internal
2041                                       'ignore))
2042                    (net-address (nth 1 parsed-address))
2043                    (record (and net-address
2044                                 (bbdb-search-simple nil net-address))))
2045               (when net-address
2046                 (gnus-message 6 "%s address %s %s BBDB"
2047                               (if remove "Deleting" "Adding")
2048                               from
2049                               (if remove "from" "to"))
2050                 (if record
2051                     (funcall remove-function record)
2052                   (bbdb-create-internal name nil net-address nil nil
2053                                         "ham sender added by spam.el")))))))
2054
2055       (defun spam-BBDB-register-routine (articles &optional unregister)
2056         (let (addresses)
2057           (dolist (article articles)
2058             (when (stringp (spam-fetch-field-from-fast article))
2059               (push (spam-fetch-field-from-fast article) addresses)))
2060           ;; now do the register/unregister action
2061           (spam-enter-ham-BBDB addresses unregister)))
2062
2063       (defun spam-BBDB-unregister-routine (articles)
2064         (spam-BBDB-register-routine articles t))
2065
2066       (defun spam-check-BBDB ()
2067         "Mail from people in the BBDB is classified as ham or non-spam"
2068         (let ((who (message-fetch-field "from"))
2069               bbdb-cache bbdb-hashtable)
2070           (when spam-cache-lookups
2071             (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
2072             (unless bbdb-cache
2073               (setq bbdb-cache
2074                     ;; this is the expanded (bbdb-hashtable) macro
2075                     ;; without the debugging support
2076                     (with-current-buffer (bbdb-buffer)
2077                       (save-excursion
2078                         (save-window-excursion
2079                           (bbdb-records nil t)
2080                           bbdb-hashtable))))
2081               (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
2082           (when who
2083             (setq who (nth 1 (gnus-extract-address-components who)))
2084             (if
2085                 (if spam-cache-lookups
2086                     (symbol-value
2087                      (intern-soft who bbdb-cache))
2088                   (bbdb-search-simple nil who))
2089                 t
2090               (if spam-use-BBDB-exclusive
2091                   spam-split-group
2092                 nil))))))
2093
2094   (file-error (progn
2095                 (defalias 'bbdb-search-simple 'ignore)
2096                 (defalias 'bbdb-records 'ignore)
2097                 (defalias 'bbdb-buffer 'ignore)
2098                 (defalias 'spam-check-BBDB 'ignore)
2099                 (defalias 'spam-BBDB-register-routine 'ignore)
2100                 (defalias 'spam-enter-ham-BBDB 'ignore)
2101                 (defalias 'bbdb-create-internal 'ignore)
2102                 (defalias 'bbdb-delete-record-internal 'ignore)
2103                 (defalias 'bbdb-records 'ignore))))
2104
2105 ;;}}}
2106
2107 ;;{{{ ifile
2108
2109 ;;; check the ifile backend; return nil if the mail was NOT classified
2110 ;;; as spam
2111
2112 (defun spam-get-ifile-database-parameter ()
2113   "Get the command-line parameter for ifile's database from
2114   spam-ifile-database-path."
2115   (if spam-ifile-database-path
2116       (format "--db-file=%s" spam-ifile-database-path)
2117     nil))
2118
2119 (defun spam-check-ifile ()
2120   "Check the ifile backend for the classification of this message."
2121   (let ((article-buffer-name (buffer-name))
2122         category return)
2123     (with-temp-buffer
2124       (let ((temp-buffer-name (buffer-name))
2125             (db-param (spam-get-ifile-database-parameter)))
2126         (save-excursion
2127           (set-buffer article-buffer-name)
2128           (apply 'call-process-region
2129                  (point-min) (point-max) spam-ifile-path
2130                  nil temp-buffer-name nil "-c"
2131                  (if db-param `(,db-param "-q") `("-q"))))
2132         ;; check the return now (we're back in the temp buffer)
2133         (goto-char (point-min))
2134         (if (not (eobp))
2135             (setq category (buffer-substring (point) (point-at-eol))))
2136         (when (not (zerop (length category))) ; we need a category here
2137           (if spam-ifile-all-categories
2138               (setq return category)
2139             ;; else, if spam-ifile-all-categories is not set...
2140             (when (string-equal spam-ifile-spam-category category)
2141               (setq return spam-split-group)))))) ; note return is nil otherwise
2142     return))
2143
2144 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
2145   "Register an article, given as a string, with a category.
2146 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
2147   (let ((category (or category gnus-newsgroup-name))
2148         (add-or-delete-option (if unregister "-d" "-i"))
2149         (db (spam-get-ifile-database-parameter))
2150         parameters)
2151     (with-temp-buffer
2152       (dolist (article articles)
2153         (let ((article-string (spam-get-article-as-string article)))
2154           (when (stringp article-string)
2155             (insert article-string))))
2156       (apply 'call-process-region
2157              (point-min) (point-max) spam-ifile-path
2158              nil nil nil
2159              add-or-delete-option category
2160              (if db `(,db "-h") `("-h"))))))
2161
2162 (defun spam-ifile-register-spam-routine (articles &optional unregister)
2163   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
2164
2165 (defun spam-ifile-unregister-spam-routine (articles)
2166   (spam-ifile-register-spam-routine articles t))
2167
2168 (defun spam-ifile-register-ham-routine (articles &optional unregister)
2169   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
2170
2171 (defun spam-ifile-unregister-ham-routine (articles)
2172   (spam-ifile-register-ham-routine articles t))
2173
2174 ;;}}}
2175
2176 ;;{{{ spam-stat
2177
2178 (condition-case nil
2179     (progn
2180       (let ((spam-stat-install-hooks nil))
2181         (require 'spam-stat))
2182
2183       (defun spam-check-stat ()
2184         "Check the spam-stat backend for the classification of this message"
2185         (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
2186               (spam-stat-buffer (buffer-name)) ; stat the current buffer
2187               category return)
2188           (spam-stat-split-fancy)))
2189
2190       (defun spam-stat-register-spam-routine (articles &optional unregister)
2191         (dolist (article articles)
2192           (let ((article-string (spam-get-article-as-string article)))
2193             (with-temp-buffer
2194               (insert article-string)
2195               (if unregister
2196                   (spam-stat-buffer-change-to-non-spam)
2197               (spam-stat-buffer-is-spam))))))
2198
2199       (defun spam-stat-unregister-spam-routine (articles)
2200         (spam-stat-register-spam-routine articles t))
2201
2202       (defun spam-stat-register-ham-routine (articles &optional unregister)
2203         (dolist (article articles)
2204           (let ((article-string (spam-get-article-as-string article)))
2205             (with-temp-buffer
2206               (insert article-string)
2207               (if unregister
2208                   (spam-stat-buffer-change-to-spam)
2209               (spam-stat-buffer-is-non-spam))))))
2210
2211       (defun spam-stat-unregister-ham-routine (articles)
2212         (spam-stat-register-ham-routine articles t))
2213
2214       (defun spam-maybe-spam-stat-load ()
2215         (when spam-use-stat (spam-stat-load)))
2216
2217       (defun spam-maybe-spam-stat-save ()
2218         (when spam-use-stat (spam-stat-save))))
2219
2220   (file-error (progn
2221                 (defalias 'spam-stat-load 'ignore)
2222                 (defalias 'spam-stat-save 'ignore)
2223                 (defalias 'spam-maybe-spam-stat-load 'ignore)
2224                 (defalias 'spam-maybe-spam-stat-save 'ignore)
2225                 (defalias 'spam-stat-register-ham-routine 'ignore)
2226                 (defalias 'spam-stat-unregister-ham-routine 'ignore)
2227                 (defalias 'spam-stat-register-spam-routine 'ignore)
2228                 (defalias 'spam-stat-unregister-spam-routine 'ignore)
2229                 (defalias 'spam-stat-buffer-is-spam 'ignore)
2230                 (defalias 'spam-stat-buffer-change-to-spam 'ignore)
2231                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
2232                 (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
2233                 (defalias 'spam-stat-split-fancy 'ignore)
2234                 (defalias 'spam-check-stat 'ignore))))
2235
2236
2237
2238 ;;}}}
2239
2240 ;;{{{ Blacklists and whitelists.
2241
2242 (defvar spam-whitelist-cache nil)
2243 (defvar spam-blacklist-cache nil)
2244
2245 (defun spam-kill-whole-line ()
2246   (beginning-of-line)
2247   (let ((kill-whole-line t))
2248     (kill-line)))
2249
2250 ;;; address can be a list, too
2251 (defun spam-enter-whitelist (address &optional remove)
2252   "Enter ADDRESS (list or single) into the whitelist.
2253 With a non-nil REMOVE, remove them."
2254   (interactive "sAddress: ")
2255   (spam-enter-list address spam-whitelist remove)
2256   (setq spam-whitelist-cache nil)
2257   (spam-clear-cache 'spam-use-whitelist))
2258
2259 ;;; address can be a list, too
2260 (defun spam-enter-blacklist (address &optional remove)
2261   "Enter ADDRESS (list or single) into the blacklist.
2262 With a non-nil REMOVE, remove them."
2263   (interactive "sAddress: ")
2264   (spam-enter-list address spam-blacklist remove)
2265   (setq spam-blacklist-cache nil)
2266   (spam-clear-cache 'spam-use-whitelist))
2267
2268 (defun spam-enter-list (addresses file &optional remove)
2269   "Enter ADDRESSES into the given FILE.
2270 Either the whitelist or the blacklist files can be used.  With
2271 REMOVE not nil, remove the ADDRESSES."
2272   (if (stringp addresses)
2273       (spam-enter-list (list addresses) file remove)
2274     ;; else, we have a list of addresses here
2275     (unless (file-exists-p (file-name-directory file))
2276       (make-directory (file-name-directory file) t))
2277     (save-excursion
2278       (set-buffer
2279        (find-file-noselect file))
2280       (dolist (a addresses)
2281         (when (stringp a)
2282           (goto-char (point-min))
2283           (if (re-search-forward (regexp-quote a) nil t)
2284               ;; found the address
2285               (when remove
2286                 (spam-kill-whole-line))
2287             ;; else, the address was not found
2288             (unless remove
2289               (goto-char (point-max))
2290               (unless (bobp)
2291                 (insert "\n"))
2292               (insert a "\n")))))
2293       (save-buffer))))
2294
2295 (defun spam-filelist-build-cache (type)
2296   (let ((cache (if (eq type 'spam-use-blacklist)
2297                    spam-blacklist-cache
2298                  spam-whitelist-cache))
2299         parsed-cache)
2300     (unless (gethash type spam-caches)
2301       (while cache
2302         (let ((address (pop cache)))
2303           (unless (zerop (length address)) ; 0 for a nil address too
2304             (setq address (regexp-quote address))
2305             ;; fix regexp-quote's treatment of user-intended regexes
2306             (while (string-match "\\\\\\*" address)
2307               (setq address (replace-match ".*" t t address))))
2308           (push address parsed-cache)))
2309       (puthash type parsed-cache spam-caches))))
2310
2311 (defun spam-filelist-check-cache (type from)
2312   (when (stringp from)
2313     (spam-filelist-build-cache type)
2314     (let (found)
2315       (dolist (address (gethash type spam-caches))
2316         (when (and address (string-match address from))
2317           (setq found t)
2318           (return)))
2319       found)))
2320
2321 ;;; returns t if the sender is in the whitelist, nil or
2322 ;;; spam-split-group otherwise
2323 (defun spam-check-whitelist ()
2324   ;; FIXME!  Should it detect when file timestamps change?
2325   (unless spam-whitelist-cache
2326     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
2327   (if (spam-from-listed-p 'spam-use-whitelist)
2328       t
2329     (if spam-use-whitelist-exclusive
2330         spam-split-group
2331       nil)))
2332
2333 (defun spam-check-blacklist ()
2334   ;; FIXME!  Should it detect when file timestamps change?
2335   (unless spam-blacklist-cache
2336     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
2337   (and (spam-from-listed-p 'spam-use-blacklist)
2338        spam-split-group))
2339
2340 (defun spam-parse-list (file)
2341   (when (file-readable-p file)
2342     (let (contents address)
2343       (with-temp-buffer
2344         (insert-file-contents file)
2345         (while (not (eobp))
2346           (setq address (buffer-substring (point) (point-at-eol)))
2347           (forward-line 1)
2348           ;; insert the e-mail address if detected, otherwise the raw data
2349           (unless (zerop (length address))
2350             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
2351               (push (or pure-address address) contents)))))
2352       (nreverse contents))))
2353
2354 (defun spam-from-listed-p (type)
2355   (let ((from (message-fetch-field "from"))
2356         found)
2357     (spam-filelist-check-cache type from)))
2358
2359 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
2360   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
2361         (declassification (if blacklist 'ham 'spam))
2362         (enter-function
2363          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2364         (remove-function
2365          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2366         from addresses unregister-list article-unregister-list)
2367     (dolist (article articles)
2368       (let ((from (spam-fetch-field-from-fast article))
2369             (id (spam-fetch-field-message-id-fast article))
2370             sender-ignored)
2371         (when (stringp from)
2372           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2373             (when (and (not sender-ignored)
2374                        (stringp ignore-regex)
2375                        (string-match ignore-regex from))
2376               (setq sender-ignored t)))
2377           ;; remember the messages we need to unregister, unless remove is set
2378           (when (and
2379                  (null unregister)
2380                  (spam-log-unregistration-needed-p
2381                   id 'process declassification de-symbol))
2382             (push article article-unregister-list)
2383             (push from unregister-list))
2384           (unless sender-ignored
2385             (push from addresses)))))
2386
2387     (if unregister
2388         (funcall enter-function addresses t) ; unregister all these addresses
2389       ;; else, register normally and unregister what we need to
2390       (funcall remove-function unregister-list t)
2391       (dolist (article article-unregister-list)
2392         (spam-log-undo-registration
2393          (spam-fetch-field-message-id-fast article)
2394          'process
2395          declassification
2396          de-symbol))
2397       (funcall enter-function addresses nil))))
2398
2399 (defun spam-blacklist-unregister-routine (articles)
2400   (spam-blacklist-register-routine articles t))
2401
2402 (defun spam-blacklist-register-routine (articles &optional unregister)
2403   (spam-filelist-register-routine articles t unregister))
2404
2405 (defun spam-whitelist-unregister-routine (articles)
2406   (spam-whitelist-register-routine articles t))
2407
2408 (defun spam-whitelist-register-routine (articles &optional unregister)
2409   (spam-filelist-register-routine articles nil unregister))
2410
2411 ;;}}}
2412
2413 ;;{{{ Spam-report glue (gmane and resend reporting)
2414 (defun spam-report-gmane-register-routine (articles)
2415   (when articles
2416     (apply 'spam-report-gmane articles)))
2417
2418 (defun spam-report-resend-register-ham-routine (articles)
2419   (spam-report-resend-register-routine articles t))
2420
2421 (defun spam-report-resend-register-routine (articles &optional ham)
2422   (let* ((resend-to-gp 
2423           (if ham
2424               (gnus-parameter-ham-resend-to gnus-newsgroup-name)
2425             (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
2426          (spam-report-resend-to (or (car-safe resend-to-gp)
2427                                     spam-report-resend-to)))
2428     (spam-report-resend articles ham)))
2429
2430 ;;}}}
2431
2432 ;;{{{ Bogofilter
2433 (defun spam-check-bogofilter-headers (&optional score)
2434   (let ((header (message-fetch-field spam-bogofilter-header)))
2435     (when header                        ; return nil when no header
2436       (if score                         ; scoring mode
2437           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2438               (match-string 1 header)
2439             "0")
2440         ;; spam detection mode
2441         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2442                             header)
2443           spam-split-group)))))
2444
2445 ;; return something sensible if the score can't be determined
2446 (defun spam-bogofilter-score (&optional recheck)
2447   "Get the Bogofilter spamicity score"
2448   (interactive "P")
2449   (save-window-excursion
2450     (gnus-summary-show-article t)
2451     (set-buffer gnus-article-buffer)
2452     (let ((score (or (unless recheck
2453                        (spam-check-bogofilter-headers t))
2454                      (spam-check-bogofilter t))))
2455       (gnus-summary-show-article)
2456       (message "Spamicity score %s" score)
2457       (or score "0"))))
2458
2459 (defun spam-verify-bogofilter ()
2460   "Verify the Bogofilter version is sufficient."
2461   (when (eq spam-bogofilter-valid 'unknown)
2462     (setq spam-bogofilter-valid
2463           (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
2464                              (shell-command-to-string 
2465                               (format "%s -V" spam-bogofilter-path))))))
2466   spam-bogofilter-valid)
2467   
2468 (defun spam-check-bogofilter (&optional score)
2469   "Check the Bogofilter backend for the classification of this message."
2470   (if (spam-verify-bogofilter)
2471       (let ((article-buffer-name (buffer-name))
2472             (db spam-bogofilter-database-directory)
2473             return)
2474         (with-temp-buffer
2475           (let ((temp-buffer-name (buffer-name)))
2476             (save-excursion
2477               (set-buffer article-buffer-name)
2478               (apply 'call-process-region
2479                      (point-min) (point-max)
2480                      spam-bogofilter-path
2481                      nil temp-buffer-name nil
2482                      (if db `("-d" ,db "-v") `("-v"))))
2483             (setq return (spam-check-bogofilter-headers score))))
2484         return)
2485     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2486
2487 (defun spam-bogofilter-register-with-bogofilter (articles
2488                                                  spam
2489                                                  &optional unregister)
2490   "Register an article, given as a string, as spam or non-spam."
2491   (if (spam-verify-bogofilter)
2492       (dolist (article articles)
2493         (let ((article-string (spam-get-article-as-string article))
2494               (db spam-bogofilter-database-directory)
2495               (switch (if unregister
2496                           (if spam
2497                               spam-bogofilter-spam-strong-switch
2498                             spam-bogofilter-ham-strong-switch)
2499                         (if spam
2500                             spam-bogofilter-spam-switch
2501                           spam-bogofilter-ham-switch))))
2502           (when (stringp article-string)
2503             (with-temp-buffer
2504               (insert article-string)
2505               
2506               (apply 'call-process-region
2507                      (point-min) (point-max)
2508                      spam-bogofilter-path
2509                      nil nil nil switch
2510                      (if db `("-d" ,db "-v") `("-v")))))))
2511     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2512
2513 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2514   (spam-bogofilter-register-with-bogofilter articles t unregister))
2515
2516 (defun spam-bogofilter-unregister-spam-routine (articles)
2517   (spam-bogofilter-register-spam-routine articles t))
2518
2519 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2520   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2521
2522 (defun spam-bogofilter-unregister-ham-routine (articles)
2523   (spam-bogofilter-register-ham-routine articles t))
2524
2525
2526 ;;}}}
2527
2528 ;;{{{ spamoracle
2529 (defun spam-check-spamoracle ()
2530   "Run spamoracle on an article to determine whether it's spam."
2531   (let ((article-buffer-name (buffer-name)))
2532     (with-temp-buffer
2533       (let ((temp-buffer-name (buffer-name)))
2534         (save-excursion
2535           (set-buffer article-buffer-name)
2536           (let ((status
2537                  (apply 'call-process-region
2538                         (point-min) (point-max)
2539                         spam-spamoracle-binary
2540                         nil temp-buffer-name nil
2541                         (if spam-spamoracle-database
2542                             `("-f" ,spam-spamoracle-database "mark")
2543                           '("mark")))))
2544             (if (eq 0 status)
2545                 (progn
2546                   (set-buffer temp-buffer-name)
2547                   (goto-char (point-min))
2548                   (when (re-search-forward "^X-Spam: yes;" nil t)
2549                     spam-split-group))
2550               (error "Error running spamoracle: %s" status))))))))
2551
2552 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2553   "Run spamoracle in training mode."
2554   (with-temp-buffer
2555     (let ((temp-buffer-name (buffer-name)))
2556       (save-excursion
2557         (goto-char (point-min))
2558         (dolist (article articles)
2559           (insert (spam-get-article-as-string article)))
2560         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2561                         "-spam"
2562                       "-good"))
2563                (status
2564                 (apply 'call-process-region
2565                        (point-min) (point-max)
2566                        spam-spamoracle-binary
2567                        nil temp-buffer-name nil
2568                        (if spam-spamoracle-database
2569                            `("-f" ,spam-spamoracle-database
2570                              "add" ,arg)
2571                          `("add" ,arg)))))
2572           (unless (eq 0 status)
2573             (error "Error running spamoracle: %s" status)))))))
2574
2575 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2576   (spam-spamoracle-learn articles nil unregister))
2577
2578 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2579   (spam-spamoracle-learn-ham articles t))
2580
2581 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2582   (spam-spamoracle-learn articles t unregister))
2583
2584 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2585   (spam-spamoracle-learn-spam articles t))
2586
2587 ;;}}}
2588
2589 ;;{{{ SpamAssassin
2590 ;;; based mostly on the bogofilter code
2591 (defun spam-check-spamassassin-headers (&optional score)
2592   "Check the SpamAssassin headers for the classification of this message."
2593   (if score                             ; scoring mode
2594       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2595         (when header
2596           (if (string-match "hits=\\(-?[0-9.]+\\)" header)
2597               (match-string 1 header)
2598             "0")))
2599     ;; spam detection mode
2600     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)))
2601           (when header                  ; return nil when no header
2602             (when (string-match spam-spamassassin-positive-spam-flag-header
2603                                 header)
2604               spam-split-group)))))
2605
2606 (defun spam-check-spamassassin (&optional score)
2607   "Check the SpamAssassin backend for the classification of this message."
2608   (let ((article-buffer-name (buffer-name)))
2609     (with-temp-buffer
2610       (let ((temp-buffer-name (buffer-name)))
2611         (save-excursion
2612           (set-buffer article-buffer-name)
2613           (apply 'call-process-region
2614                  (point-min) (point-max) spam-spamassassin-path
2615                  nil temp-buffer-name nil spam-spamassassin-arguments))
2616         ;; check the return now (we're back in the temp buffer)
2617         (goto-char (point-min))
2618         (spam-check-spamassassin-headers score)))))
2619
2620 ;; return something sensible if the score can't be determined
2621 (defun spam-spamassassin-score (&optional recheck)
2622   "Get the SpamAssassin score"
2623   (interactive "P")
2624   (save-window-excursion
2625     (gnus-summary-show-article t)
2626     (set-buffer gnus-article-buffer)
2627     (let ((score (or (unless recheck
2628                        (spam-check-spamassassin-headers t))
2629                      (spam-check-spamassassin t))))
2630       (gnus-summary-show-article)
2631       (message "SpamAssassin score %s" score)
2632       (or score "0"))))
2633
2634 (defun spam-spamassassin-register-with-sa-learn (articles spam
2635                                                  &optional unregister)
2636   "Register articles with spamassassin's sa-learn as spam or non-spam."
2637   (if articles
2638       (let ((action (if unregister spam-sa-learn-unregister-switch
2639                       (if spam spam-sa-learn-spam-switch
2640                         spam-sa-learn-ham-switch)))
2641             (summary-buffer-name (buffer-name)))
2642         (with-temp-buffer
2643           ;; group the articles into mbox format
2644           (dolist (article articles)
2645             (let (article-string)
2646               (save-excursion
2647                 (set-buffer summary-buffer-name)
2648                 (setq article-string (spam-get-article-as-string article)))
2649               (when (stringp article-string)
2650                 (insert "From \n") ; mbox separator (sa-learn only checks the
2651                                    ; first five chars, so we can get away with
2652                                    ; a bogus line))
2653                 (insert article-string)
2654                 (insert "\n"))))
2655           ;; call sa-learn on all messages at the same time
2656           (apply 'call-process-region
2657                  (point-min) (point-max)
2658                  spam-sa-learn-path
2659                  nil nil nil "--mbox"
2660                  (if spam-sa-learn-rebuild
2661                      (list action)
2662                    `("--no-rebuild" ,action)))))))
2663
2664 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2665   (spam-spamassassin-register-with-sa-learn articles t unregister))
2666
2667 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2668   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2669
2670 (defun spam-spamassassin-unregister-spam-routine (articles)
2671   (spam-spamassassin-register-with-sa-learn articles t t))
2672
2673 (defun spam-spamassassin-unregister-ham-routine (articles)
2674   (spam-spamassassin-register-with-sa-learn articles nil t))
2675
2676 ;;}}}
2677
2678 ;;{{{ Bsfilter
2679 ;;; based mostly on the bogofilter code
2680 (defun spam-check-bsfilter-headers (&optional score)
2681   (if score
2682       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2683           "0")
2684     (let ((header (nnmail-fetch-field spam-bsfilter-header)))
2685       (when header ; return nil when no header
2686         (when (string-match "YES" header)
2687           spam-split-group)))))
2688
2689 ;; return something sensible if the score can't be determined
2690 (defun spam-bsfilter-score (&optional recheck)
2691   "Get the Bsfilter spamicity score"
2692   (interactive "P")
2693   (save-window-excursion
2694     (gnus-summary-show-article t)
2695     (set-buffer gnus-article-buffer)
2696     (let ((score (or (unless recheck
2697                        (spam-check-bsfilter-headers t))
2698                      (spam-check-bsfilter t))))
2699       (gnus-summary-show-article)
2700       (message "Spamicity score %s" score)
2701       (or score "0"))))
2702
2703 (defun spam-check-bsfilter (&optional score)
2704   "Check the Bsfilter backend for the classification of this message"
2705   (let ((article-buffer-name (buffer-name))
2706         (dir spam-bsfilter-database-directory)
2707         return)
2708     (with-temp-buffer
2709       (let ((temp-buffer-name (buffer-name)))
2710         (save-excursion
2711           (set-buffer article-buffer-name)
2712           (apply 'call-process-region
2713                  (point-min) (point-max)
2714                  spam-bsfilter-path
2715                  nil temp-buffer-name nil
2716                  "--pipe"
2717                  "--insert-flag"
2718                  "--insert-probability"
2719                  (when dir
2720                    (list "--homedir" dir))))
2721         (setq return (spam-check-bsfilter-headers score))))
2722     return))
2723
2724 (defun spam-bsfilter-register-with-bsfilter (articles
2725                                              spam
2726                                              &optional unregister)
2727   "Register an article, given as a string, as spam or non-spam."
2728   (dolist (article articles)
2729     (let ((article-string (spam-get-article-as-string article))
2730           (switch (if unregister
2731                       (if spam
2732                           spam-bsfilter-spam-strong-switch
2733                         spam-bsfilter-ham-strong-switch)
2734                     (if spam
2735                         spam-bsfilter-spam-switch
2736                       spam-bsfilter-ham-switch))))
2737       (when (stringp article-string)
2738         (with-temp-buffer
2739           (insert article-string)
2740           (apply 'call-process-region
2741                  (point-min) (point-max)
2742                  spam-bsfilter-path
2743                  nil nil nil switch
2744                  "--update"
2745                  (when spam-bsfilter-database-directory
2746                    (list "--homedir"
2747                          spam-bsfilter-database-directory))))))))
2748
2749 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2750   (spam-bsfilter-register-with-bsfilter articles t unregister))
2751
2752 (defun spam-bsfilter-unregister-spam-routine (articles)
2753   (spam-bsfilter-register-spam-routine articles t))
2754
2755 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2756   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2757
2758 (defun spam-bsfilter-unregister-ham-routine (articles)
2759   (spam-bsfilter-register-ham-routine articles t))
2760
2761 ;;}}}
2762
2763 ;;{{{ CRM114 Mailfilter
2764 (defun spam-check-crm114-headers (&optional score)
2765   (let ((header (message-fetch-field spam-crm114-header)))
2766     (when header                        ; return nil when no header
2767       (if score                         ; scoring mode
2768           (if (string-match "( pR: \\([0-9.-]+\\)" header)
2769               (match-string 1 header)
2770             "0")
2771         ;; spam detection mode
2772         (when (string-match spam-crm114-positive-spam-header
2773                             header)
2774           spam-split-group)))))
2775
2776 ;; return something sensible if the score can't be determined
2777 (defun spam-crm114-score ()
2778   "Get the CRM114 Mailfilter pR"
2779   (interactive)
2780   (save-window-excursion
2781     (gnus-summary-show-article t)
2782     (set-buffer gnus-article-buffer)
2783     (let ((score (or (spam-check-crm114-headers t)
2784                      (spam-check-crm114 t))))
2785       (gnus-summary-show-article)
2786       (message "pR: %s" score)
2787       (or score "0"))))
2788
2789 (defun spam-check-crm114 (&optional score)
2790   "Check the CRM114 Mailfilter backend for the classification of this message"
2791   (let ((article-buffer-name (buffer-name))
2792         (db spam-crm114-database-directory)
2793         return)
2794     (with-temp-buffer
2795       (let ((temp-buffer-name (buffer-name)))
2796         (save-excursion
2797           (set-buffer article-buffer-name)
2798           (apply 'call-process-region
2799                  (point-min) (point-max)
2800                  spam-crm114-program
2801                  nil temp-buffer-name nil
2802                  (when db (list (concat "--fileprefix=" db)))))
2803         (setq return (spam-check-crm114-headers score))))
2804     return))
2805
2806 (defun spam-crm114-register-with-crm114 (articles
2807                                          spam
2808                                          &optional unregister)
2809   "Register an article, given as a string, as spam or non-spam."
2810   (dolist (article articles)
2811     (let ((article-string (spam-get-article-as-string article))
2812           (db spam-crm114-database-directory)
2813           (switch (if unregister
2814                       (if spam
2815                           spam-crm114-spam-strong-switch
2816                         spam-crm114-ham-strong-switch)
2817                     (if spam
2818                         spam-crm114-spam-switch
2819                       spam-crm114-ham-switch))))
2820       (when (stringp article-string)
2821         (with-temp-buffer
2822           (insert article-string)
2823
2824           (apply 'call-process-region
2825                  (point-min) (point-max)
2826                  spam-crm114-program
2827                  nil nil nil
2828                  (when db (list switch (concat "--fileprefix=" db)))))))))
2829
2830 (defun spam-crm114-register-spam-routine (articles &optional unregister)
2831   (spam-crm114-register-with-crm114 articles t unregister))
2832
2833 (defun spam-crm114-unregister-spam-routine (articles)
2834   (spam-crm114-register-spam-routine articles t))
2835
2836 (defun spam-crm114-register-ham-routine (articles &optional unregister)
2837   (spam-crm114-register-with-crm114 articles nil unregister))
2838
2839 (defun spam-crm114-unregister-ham-routine (articles)
2840   (spam-crm114-register-ham-routine articles t))
2841
2842 ;;}}}
2843
2844 ;;}}}
2845
2846 ;;{{{ Hooks
2847
2848 ;;;###autoload
2849 (defun spam-initialize (&rest symbols)
2850   "Install the spam.el hooks and do other initialization.
2851 When SYMBOLS is given, set those variables to t.  This is so you
2852 can call spam-initialize before you set spam-use-* variables on
2853 explicitly, and matters only if you need the extra headers
2854 installed through spam-necessary-extra-headers."
2855   (interactive)
2856
2857   (dolist (var symbols)
2858     (set var t))
2859
2860   (dolist (header (spam-necessary-extra-headers))
2861     (add-to-list 'nnmail-extra-headers header)
2862     (add-to-list 'gnus-extra-headers header))
2863
2864   (setq spam-install-hooks t)
2865   ;; TODO: How do we redo this every time spam-face is customized?
2866   (push '((eq mark gnus-spam-mark) . spam-face)
2867         gnus-summary-highlight)
2868   ;; Add hooks for loading and saving the spam stats
2869   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2870   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2871   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2872   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2873   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2874   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2875   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2876
2877 (defun spam-unload-hook ()
2878   "Uninstall the spam.el hooks"
2879   (interactive)
2880   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2881   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2882   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2883   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2884   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2885   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2886   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2887
2888 (add-hook 'spam-unload-hook 'spam-unload-hook)
2889
2890 (when spam-install-hooks
2891   (spam-initialize))
2892 ;;}}}
2893
2894 (provide 'spam)
2895
2896 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
2897 ;;; spam.el ends here