(spam-summary-score-preferred-header): global preference
[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     (spam-summary-score headers spam-summary-score-preferred-header)))
1142
1143 (defun spam-article-sort-by-spam-status (h1 h2)
1144   "Sort articles by score."
1145   (let (result)
1146     (dolist (header (spam-necessary-extra-headers))
1147       (let ((s1 (spam-summary-score h1 header))
1148             (s2 (spam-summary-score h2 header)))
1149       (unless (= s1 s2)
1150         (setq result (< s1 s2))
1151         (return))))
1152     result))
1153
1154 (defun spam-extra-header-to-number (header headers)
1155   "Transform an extra HEADER to a number, using list of HEADERS.
1156 Note this has to be fast."
1157   (if (gnus-extra-header header headers)
1158       (cond
1159        ((eq header 'X-Spam-Status)
1160         (string-to-number (gnus-replace-in-string
1161                            (gnus-extra-header header headers)
1162                            ".*hits=" "")))
1163        ;; for CRM checking, it's probably faster to just do the string match
1164        ((and spam-use-crm114 (string-match "( pR: \\([0-9.-]+\\)" header))
1165         (match-string 1 header))
1166        ((eq header 'X-Bogosity)
1167         (string-to-number (gnus-replace-in-string
1168                            (gnus-replace-in-string
1169                             (gnus-extra-header header headers)
1170                             ".*spamicity=" "")
1171                            ",.*" "")))
1172        (t nil))
1173     nil))
1174
1175 (defun spam-summary-score (headers &optional specific-header)
1176   "Score an article for the summary buffer, as fast as possible.
1177 With SPECIFIC-HEADER, returns only that header's score.
1178 Will not return a nil score."
1179   (let (score)
1180     (dolist (header 
1181              (if specific-header
1182                  (list specific-header)
1183                (spam-necessary-extra-headers)))
1184       (setq score 
1185             (spam-extra-header-to-number header headers))
1186       (when score 
1187         (return)))
1188     (or score 0)))
1189
1190 (defun spam-generic-score (&optional recheck)
1191   "Invoke whatever scoring method we can."
1192   (interactive "P")
1193   (cond
1194    ((or spam-use-spamassassin spam-use-spamassassin-headers)
1195     (spam-spamassassin-score recheck))
1196    ((or spam-use-bsfilter spam-use-bsfilter-headers)
1197     (spam-bsfilter-score recheck))
1198    (spam-use-crm114
1199     (spam-crm114-score))
1200    (t (spam-bogofilter-score recheck))))
1201 ;;}}}
1202
1203 ;;{{{ set up widening, processor checks
1204
1205 ;;; set up IMAP widening if it's necessary
1206 (defun spam-setup-widening ()
1207   (when (spam-widening-needed-p)
1208     (setq nnimap-split-download-body-default t)))
1209
1210 (defun spam-widening-needed-p (&optional force-symbols)
1211   (let (found)
1212     (dolist (backend (spam-backend-list))
1213       (when (and (spam-backend-statistical-p backend)
1214                  (or (symbol-value backend) 
1215                      (memq backend force-symbols)))
1216         (setq found backend)))
1217     found))
1218
1219 (defvar spam-list-of-processors
1220   ;; note the nil processors are not defined in gnus.el
1221   '((gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
1222     (gnus-group-spam-exit-processor-bsfilter     spam spam-use-bsfilter)
1223     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
1224     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
1225     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
1226     (gnus-group-spam-exit-processor-spamoracle   spam spam-use-spamoracle)
1227     (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
1228     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
1229     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
1230     (gnus-group-ham-exit-processor-bsfilter      ham spam-use-bsfilter)
1231     (gnus-group-ham-exit-processor-stat          ham spam-use-stat)
1232     (gnus-group-ham-exit-processor-whitelist     ham spam-use-whitelist)
1233     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
1234     (gnus-group-ham-exit-processor-copy          ham spam-use-ham-copy)
1235     (gnus-group-ham-exit-processor-spamassassin  ham spam-use-spamassassin)
1236     (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle))
1237   "The OBSOLETE `spam-list-of-processors' list.
1238 This list contains pairs associating the obsolete ham/spam exit
1239 processor variables with a classification and a spam-use-*
1240 variable.  When the processor variable is nil, just the
1241 classification and spam-use-* check variable are used.  This is
1242 superceded by the new spam backend code, so it's only consulted
1243 for backwards compatibility.")
1244
1245 (defun spam-group-processor-p (group backend &optional classification)
1246   "Checks if GROUP has a BACKEND with CLASSIFICATION registered.
1247 Also accepts the obsolete processors, which can be found in
1248 gnus.el and in spam-list-of-processors.  In the case of mover
1249 backends, checks the setting of spam-summary-exit-behavior in
1250 addition to the set values for the group."
1251   (if (and (stringp group)
1252            (symbolp backend))
1253       (let ((old-style (assq backend spam-list-of-processors))
1254             (parameters (nth 0 (gnus-parameter-spam-process group)))
1255             found)
1256         (if old-style  ; old-style processor
1257             (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style))
1258           ;; now search for the parameter
1259           (dolist (parameter parameters)
1260             (when (and (null found)
1261                        (listp parameter)
1262                        (eq classification (nth 0 parameter))
1263                        (eq backend (nth 1 parameter)))
1264               (setq found t)))
1265
1266           ;; now, if the parameter was not found, do the
1267           ;; spam-summary-exit-behavior-logic for mover backends
1268           (unless found
1269             (when (spam-backend-mover-p backend)
1270               (setq 
1271                found
1272                (cond
1273                 ((eq spam-summary-exit-behavior 'move-all) t)
1274                 ((eq spam-summary-exit-behavior 'move-none) nil)
1275                 ((eq spam-summary-exit-behavior 'default)
1276                  (or (eq classification 'spam) ;move spam out of all groups
1277                      ;; move ham out of spam groups
1278                      (and (eq classification 'ham)
1279                           (spam-group-spam-contents-p group))))
1280                 (t (gnus-error 5 "Unknown spam-summary-exit-behavior: %s" 
1281                                spam-summary-exit-behavior))))))
1282
1283           found))
1284     nil))
1285
1286 ;;}}}
1287
1288 ;;{{{ Summary entry and exit processing.
1289
1290 (defun spam-mark-junk-as-spam-routine ()
1291   ;; check the global list of group names spam-junk-mailgroups and the
1292   ;; group parameters
1293   (when (spam-group-spam-contents-p gnus-newsgroup-name)
1294     (gnus-message 6 "Marking %s articles as spam"
1295                   (if spam-mark-only-unseen-as-spam
1296                       "unseen"
1297                     "unread"))
1298     (let ((articles (if spam-mark-only-unseen-as-spam
1299                         gnus-newsgroup-unseen
1300                       gnus-newsgroup-unreads)))
1301       (if spam-mark-new-messages-in-spam-group-as-spam
1302           (dolist (article articles)
1303             (gnus-summary-mark-article article gnus-spam-mark))
1304         (gnus-message 9 "Did not mark new messages as spam.")))))
1305
1306 (defun spam-summary-prepare ()
1307   (setq spam-old-articles
1308         (list (cons 'ham (spam-list-articles gnus-newsgroup-articles 'ham))
1309               (cons 'spam (spam-list-articles gnus-newsgroup-articles 'spam))))
1310   (spam-mark-junk-as-spam-routine))
1311
1312 ;; The spam processors are invoked for any group, spam or ham or neither
1313 (defun spam-summary-prepare-exit ()
1314   (unless gnus-group-is-exiting-without-update-p
1315     (gnus-message 6 "Exiting summary buffer and applying spam rules")
1316
1317     ;; first of all, unregister any articles that are no longer ham or spam
1318     ;; we have to iterate over the processors, or else we'll be too slow
1319     (dolist (classification (spam-classifications))
1320       (let* ((old-articles (cdr-safe (assq classification spam-old-articles)))
1321              (new-articles (spam-list-articles
1322                             gnus-newsgroup-articles
1323                             classification))
1324              (changed-articles (spam-set-difference new-articles old-articles)))
1325         ;; now that we have the changed articles, we go through the processors
1326         (dolist (backend (spam-backend-list))
1327           (let (unregister-list)
1328             (dolist (article changed-articles)
1329               (let ((id (spam-fetch-field-message-id-fast article)))
1330                 (when (spam-log-unregistration-needed-p
1331                        id 'process classification backend)
1332                   (push article unregister-list))))
1333             ;; call spam-register-routine with specific articles to unregister,
1334             ;; when there are articles to unregister and the check is enabled
1335             (when (and unregister-list (symbol-value backend))
1336               (spam-backend-put-article-todo-list backend 
1337                                                   classification 
1338                                                   unregister-list
1339                                                   t))))))
1340
1341     ;; do the non-moving backends first, then the moving ones
1342     (dolist (backend-type '(non-mover mover))
1343       (dolist (classification (spam-classifications))
1344         (dolist (backend (spam-backend-list backend-type))
1345           (when (spam-group-processor-p
1346                  gnus-newsgroup-name
1347                  backend
1348                  classification)
1349             (spam-backend-put-article-todo-list backend 
1350                                                 classification
1351                                                 (spam-list-articles
1352                                                  gnus-newsgroup-articles
1353                                                  classification))))))
1354
1355     (spam-resolve-registrations-routine) ; do the registrations now
1356
1357     ;; we mark all the leftover spam articles as expired at the end
1358     (dolist (article (spam-list-articles
1359                       gnus-newsgroup-articles
1360                       'spam))
1361       (gnus-summary-mark-article article gnus-expirable-mark)))
1362
1363   (setq spam-old-articles nil))
1364
1365 ;;}}}
1366
1367 ;;{{{ spam-use-move and spam-use-copy backend support functions
1368
1369 (defun spam-copy-or-move-routine (copy groups articles classification)
1370
1371   (when (and (car-safe groups) (listp (car-safe groups)))
1372     (setq groups (pop groups)))
1373
1374   (unless (listp groups)
1375     (setq groups (list groups)))
1376
1377     ;; remove the current process mark
1378   (gnus-summary-kill-process-mark)
1379
1380   (let ((backend-supports-deletions
1381          (gnus-check-backend-function
1382           'request-move-article gnus-newsgroup-name))
1383         (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
1384         article mark deletep respool)
1385
1386     (when (member 'respool groups)
1387       (setq respool t)                  ; boolean for later
1388       (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
1389
1390     ;; now do the actual move
1391     (dolist (group groups)
1392       (when (and articles (stringp group))
1393
1394         ;; first, mark the article with the process mark and, if needed,
1395         ;; the unread or expired mark (for ham and spam respectively)
1396         (dolist (article articles)
1397           (when (and (eq classification 'ham)
1398                      spam-mark-ham-unread-before-move-from-spam-group)
1399             (gnus-message 9 "Marking ham article %d unread before move"
1400                           article)
1401             (gnus-summary-mark-article article gnus-unread-mark))
1402           (when (and (eq classification 'spam)
1403                      (not copy))
1404             (gnus-message 9 "Marking spam article %d expirable before move"
1405                           article)
1406             (gnus-summary-mark-article article gnus-expirable-mark))
1407           (gnus-summary-set-process-mark article)
1408             
1409           (if respool              ; respooling is with a "fake" group
1410               (let ((spam-split-disabled
1411                      (or spam-split-disabled
1412                          (and (eq classification 'ham) 
1413                               spam-disable-spam-split-during-ham-respool))))
1414                 (gnus-message 9 "Respooling article %d with method %s"
1415                               article respool-method)
1416                 (gnus-summary-respool-article nil respool-method))
1417             (if (or (not backend-supports-deletions) ; else, we are not respooling
1418                     (> (length groups) 1))
1419                 (progn              ; if copying, copy and set deletep
1420                   (gnus-message 9 "Copying article %d to group %s"
1421                                 article group)
1422                   (gnus-summary-copy-article nil group)
1423                   (setq deletep t))
1424               (gnus-message 9 "Moving article %d to group %s"
1425                             article group)
1426               (gnus-summary-move-article nil group))))) ; else move articles
1427         
1428       ;; now delete the articles, unless a) copy is t, and there was a copy done
1429       ;;                                 b) a move was done to a single group
1430       ;;                                 c) backend-supports-deletions is nil
1431       (unless copy
1432         (when (and deletep backend-supports-deletions)
1433           (dolist (article articles)
1434               (gnus-summary-set-process-mark article)
1435               (gnus-message 9 "Deleting article %d" article))
1436           (when articles
1437             (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
1438               (gnus-summary-delete-article nil)))))
1439         
1440       (gnus-summary-yank-process-mark)
1441       (length articles))))
1442
1443 (defun spam-copy-spam-routine (articles)
1444   (spam-copy-or-move-routine 
1445    t 
1446    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1447    articles
1448    'spam))
1449
1450 (defun spam-move-spam-routine (articles)
1451   (spam-copy-or-move-routine 
1452    nil
1453    (gnus-parameter-spam-process-destination gnus-newsgroup-name)
1454    articles
1455    'spam))
1456
1457 (defun spam-copy-ham-routine (articles)
1458   (spam-copy-or-move-routine 
1459    t 
1460    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1461    articles
1462    'ham))
1463
1464 (defun spam-move-ham-routine (articles)
1465   (spam-copy-or-move-routine 
1466    nil
1467    (gnus-parameter-ham-process-destination gnus-newsgroup-name)
1468    articles
1469    'ham))
1470
1471 ;;}}}
1472
1473 ;;{{{ article and field retrieval code
1474 (defun spam-get-article-as-string (article)
1475   (when (numberp article)
1476     (with-temp-buffer
1477       (gnus-request-article-this-buffer
1478        article
1479        gnus-newsgroup-name)
1480       (buffer-string))))
1481
1482 ;; disabled for now
1483 ;; (defun spam-get-article-as-filename (article)
1484 ;;   (let ((article-filename))
1485 ;;     (when (numberp article)
1486 ;;       (nnml-possibly-change-directory
1487 ;;        (gnus-group-real-name gnus-newsgroup-name))
1488 ;;       (setq article-filename (expand-file-name
1489 ;;                              (int-to-string article) nnml-current-directory)))
1490 ;;     (if (file-exists-p article-filename)
1491 ;;      article-filename
1492 ;;       nil)))
1493
1494 (defun spam-fetch-field-fast (article field &optional prepared-data-header)
1495   "Fetch a FIELD for ARTICLE quickly, using the internal gnus-data-list function.
1496 When PREPARED-DATA-HEADER is given, don't look in the Gnus data.
1497 When FIELD is 'number, ARTICLE can be any number (since we want
1498 to find it out)."
1499   (when (numberp article)
1500     (let* ((data-header (or prepared-data-header
1501                             (spam-fetch-article-header article))))
1502       (if (arrayp data-header)
1503         (cond
1504          ((equal field 'number)
1505           (mail-header-number data-header))
1506          ((equal field 'from)
1507           (mail-header-from data-header))
1508          ((equal field 'message-id)
1509           (mail-header-message-id data-header))
1510          ((equal field 'subject)
1511           (mail-header-subject data-header))
1512          ((equal field 'references)
1513           (mail-header-references data-header))
1514          ((equal field 'date)
1515           (mail-header-date data-header))
1516          ((equal field 'xref)
1517           (mail-header-xref data-header))
1518          ((equal field 'extra)
1519           (mail-header-extra data-header))
1520          (t
1521           (gnus-error 
1522            5 
1523            "spam-fetch-field-fast: unknown field %s requested" 
1524            field)
1525           nil))
1526         (gnus-message 6 "Article %d has a nil data header" article)))))
1527
1528 (defun spam-fetch-field-from-fast (article &optional prepared-data-header)
1529   (spam-fetch-field-fast article 'from prepared-data-header))
1530
1531 (defun spam-fetch-field-subject-fast (article &optional prepared-data-header)
1532   (spam-fetch-field-fast article 'subject prepared-data-header))
1533
1534 (defun spam-fetch-field-message-id-fast (article &optional prepared-data-header)
1535   (spam-fetch-field-fast article 'message-id prepared-data-header))
1536
1537 (defun spam-generate-fake-headers (article)
1538   (let ((dh (spam-fetch-article-header article)))
1539     (if dh
1540         (concat
1541          (format
1542           ;; 80-character limit makes for strange constructs
1543           (concat "From: %s\nSubject: %s\nMessage-ID: %s\n"
1544                   "Date: %s\nReferences: %s\nXref: %s\n")
1545           (spam-fetch-field-fast article 'from dh)
1546           (spam-fetch-field-fast article 'subject dh)
1547           (spam-fetch-field-fast article 'message-id dh)
1548           (spam-fetch-field-fast article 'date dh)
1549           (spam-fetch-field-fast article 'references dh)
1550           (spam-fetch-field-fast article 'xref dh))
1551          (when (spam-fetch-field-fast article 'extra dh)
1552            (format "%s\n" (spam-fetch-field-fast article 'extra dh))))
1553       (gnus-message
1554        5
1555        "spam-generate-fake-headers: article %d didn't have a valid header"
1556        article))))
1557
1558 (defun spam-fetch-article-header (article)
1559   (save-excursion
1560     (set-buffer gnus-summary-buffer)
1561     (gnus-read-header article)
1562     (nth 3 (assq article gnus-newsgroup-data))))
1563 ;;}}}
1564
1565 ;;{{{ Spam determination.
1566
1567 (defun spam-split (&rest specific-checks)
1568   "Split this message into the `spam' group if it is spam.
1569 This function can be used as an entry in the variable `nnmail-split-fancy',
1570 for example like this: (: spam-split).  It can take checks as
1571 parameters.  A string as a parameter will set the
1572 spam-split-group to that string.
1573
1574 See the Info node `(gnus)Fancy Mail Splitting' for more details."
1575   (interactive)
1576   (setq spam-split-last-successful-check nil)
1577   (unless spam-split-disabled
1578     (let ((spam-split-group-choice spam-split-group))
1579       (dolist (check specific-checks)
1580         (when (stringp check)
1581           (setq spam-split-group-choice check)
1582           (setq specific-checks (delq check specific-checks))))
1583
1584       (let ((spam-split-group spam-split-group-choice)
1585             (widening-needed-check (spam-widening-needed-p specific-checks)))
1586         (save-excursion
1587           (save-restriction
1588             (when widening-needed-check
1589               (widen)
1590               (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
1591                             widening-needed-check))
1592             (let ((backends (spam-backend-list))
1593                   decision)
1594               (while (and backends (not decision))
1595                 (let* ((backend (pop backends))
1596                        (check-function (spam-backend-check backend))
1597                        (spam-split-group (if spam-split-symbolic-return
1598                                              'spam
1599                                            spam-split-group)))
1600                   (when (or
1601                          ;; either, given specific checks, this is one of them
1602                          (memq backend specific-checks)
1603                          ;; or, given no specific checks, spam-use-CHECK is set
1604                          (and (null specific-checks) (symbol-value backend)))
1605                     (gnus-message 6 "spam-split: calling the %s function"
1606                                   check-function)
1607                     (setq decision (funcall check-function))
1608                     ;; if we got a decision at all, save the current check
1609                     (when decision
1610                       (setq spam-split-last-successful-check backend))
1611
1612                     (when (eq decision 'spam)
1613                       (unless spam-split-symbolic-return
1614                         (gnus-error
1615                          5
1616                          (format "spam-split got %s but %s is nil"
1617                                  decision
1618                                  spam-split-symbolic-return)))))))
1619               (if (eq decision t)
1620                   (if spam-split-symbolic-return-positive 'ham nil)
1621                 decision))))))))
1622
1623 (defun spam-find-spam ()
1624   "This function will detect spam in the current newsgroup using spam-split."
1625   (interactive)
1626
1627   (let* ((group gnus-newsgroup-name)
1628          (autodetect (gnus-parameter-spam-autodetect group))
1629          (methods (gnus-parameter-spam-autodetect-methods group))
1630          (first-method (nth 0 methods))
1631          (articles (if spam-autodetect-recheck-messages
1632                        gnus-newsgroup-articles
1633                      gnus-newsgroup-unseen))
1634          article-cannot-be-faked)
1635
1636     
1637     (dolist (backend methods)
1638       (when (spam-backend-statistical-p backend)
1639         (setq article-cannot-be-faked t)
1640         (return)))
1641
1642     (when (memq 'default methods)
1643       (setq article-cannot-be-faked t))
1644
1645     (when (and autodetect
1646                (not (equal first-method 'none)))
1647       (mapcar
1648        (lambda (article)
1649          (let ((id (spam-fetch-field-message-id-fast article))
1650                (subject (spam-fetch-field-subject-fast article))
1651                (sender (spam-fetch-field-from-fast article))
1652                registry-lookup)
1653            
1654            (unless id
1655              (gnus-message 6 "Article %d has no message ID!" article))
1656          
1657            (when (and id spam-log-to-registry)
1658              (setq registry-lookup (spam-log-registration-type id 'incoming))
1659              (when registry-lookup
1660                (gnus-message
1661                 9
1662                 "spam-find-spam: message %s was already registered incoming"
1663                 id)))
1664
1665            (let* ((spam-split-symbolic-return t)
1666                   (spam-split-symbolic-return-positive t)
1667                   (fake-headers (spam-generate-fake-headers article))
1668                   (split-return
1669                    (or registry-lookup
1670                        (with-temp-buffer
1671                          (if article-cannot-be-faked
1672                              (gnus-request-article-this-buffer
1673                               article
1674                               group)
1675                            ;; else, we fake the article
1676                            (when fake-headers (insert fake-headers)))
1677                          (if (or (null first-method)
1678                                  (equal first-method 'default))
1679                              (spam-split)
1680                            (apply 'spam-split methods))))))
1681              (if (equal split-return 'spam)
1682                  (gnus-summary-mark-article article gnus-spam-mark))
1683            
1684              (when (and id split-return spam-log-to-registry)
1685                (when (zerop (gnus-registry-group-count id))
1686                  (gnus-registry-add-group
1687                   id group subject sender))
1688                
1689                (unless registry-lookup
1690                  (spam-log-processing-to-registry
1691                   id
1692                   'incoming
1693                   split-return
1694                   spam-split-last-successful-check
1695                   group))))))
1696        articles))))
1697
1698 ;;}}}
1699
1700 ;;{{{ registration/unregistration functions
1701
1702 (defun spam-resolve-registrations-routine ()
1703   "Go through the backends and register or unregister articles as needed."
1704   (dolist (backend-type '(non-mover mover))
1705     (dolist (classification (spam-classifications))
1706       (dolist (backend (spam-backend-list backend-type))
1707         (let ((rlist (spam-backend-get-article-todo-list
1708                       backend classification))
1709               (ulist (spam-backend-get-article-todo-list
1710                       backend classification t))
1711               (delcount 0))
1712
1713           ;; clear the old lists right away
1714           (spam-backend-put-article-todo-list backend 
1715                                               classification
1716                                               nil
1717                                               nil)
1718           (spam-backend-put-article-todo-list backend 
1719                                               classification
1720                                               nil
1721                                               t)
1722
1723           ;; eliminate duplicates
1724           (dolist (article (copy-sequence ulist))
1725             (when (memq article rlist)
1726               (incf delcount)
1727               (setq rlist (delq article rlist))
1728               (setq ulist (delq article ulist))))
1729           
1730           (unless (zerop delcount)
1731             (gnus-message 
1732              9 
1733              "%d messages were saved the trouble of unregistering and then registering"
1734              delcount))
1735           
1736           ;; unregister articles
1737           (unless (zerop (length ulist))
1738             (let ((num (spam-unregister-routine classification backend ulist)))
1739               (when (> num 0)
1740                 (gnus-message 
1741                  6
1742                  "%d %s messages were unregistered by backend %s."
1743                  num
1744                  classification
1745                  backend))))
1746             
1747             ;; register articles
1748             (unless (zerop (length rlist))
1749               (let ((num (spam-register-routine classification backend rlist)))
1750                 (when (> num 0)
1751                   (gnus-message 
1752                    6
1753                    "%d %s messages were registered by backend %s."
1754                    num
1755                    classification
1756                    backend)))))))))
1757
1758 (defun spam-unregister-routine (classification
1759                                 backend 
1760                                 specific-articles)
1761   (spam-register-routine classification backend specific-articles t))
1762
1763 (defun spam-register-routine (classification
1764                               backend 
1765                               specific-articles
1766                               &optional unregister)
1767   (when (and (spam-classification-valid-p classification)
1768              (spam-backend-valid-p backend))
1769     (let* ((register-function
1770             (spam-backend-function backend classification 'registration))
1771            (unregister-function
1772             (spam-backend-function backend classification 'unregistration))
1773            (run-function (if unregister
1774                              unregister-function
1775                            register-function))
1776            (log-function (if unregister
1777                              'spam-log-undo-registration
1778                            'spam-log-processing-to-registry))
1779            article articles)
1780
1781       (when run-function
1782         ;; make list of articles, using specific-articles if given
1783         (setq articles (or specific-articles
1784                            (spam-list-articles
1785                             gnus-newsgroup-articles
1786                             classification)))
1787         ;; process them
1788         (when (> (length articles) 0)
1789           (gnus-message 5 "%s %d %s articles as %s using backend %s"
1790                         (if unregister "Unregistering" "Registering")
1791                         (length articles)
1792                         (if specific-articles "specific" "")
1793                         classification
1794                         backend)
1795           (funcall run-function articles)
1796           ;; now log all the registrations (or undo them, depending on
1797           ;; unregister)
1798           (dolist (article articles)
1799             (funcall log-function
1800                      (spam-fetch-field-message-id-fast article)
1801                      'process
1802                      classification
1803                      backend
1804                      gnus-newsgroup-name))))
1805       ;; return the number of articles processed
1806       (length articles))))
1807
1808 ;;; log a ham- or spam-processor invocation to the registry
1809 (defun spam-log-processing-to-registry (id type classification backend group)
1810   (when spam-log-to-registry
1811     (if (and (stringp id)
1812              (stringp group)
1813              (spam-process-type-valid-p type)
1814              (spam-classification-valid-p classification)
1815              (spam-backend-valid-p backend))
1816         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1817               (cell (list classification backend group)))
1818           (push cell cell-list)
1819           (gnus-registry-store-extra-entry
1820            id
1821            type
1822            cell-list))
1823
1824       (gnus-error
1825        7
1826        (format "%s call with bad ID, type, classification, spam-backend, or group"
1827                "spam-log-processing-to-registry")))))
1828
1829 ;;; check if a ham- or spam-processor registration has been done
1830 (defun spam-log-registered-p (id type)
1831   (when spam-log-to-registry
1832     (if (and (stringp id)
1833              (spam-process-type-valid-p type))
1834         (cdr-safe (gnus-registry-fetch-extra id type))
1835       (progn
1836         (gnus-error
1837          7
1838          (format "%s called with bad ID, type, classification, or spam-backend"
1839                  "spam-log-registered-p"))
1840         nil))))
1841
1842 ;;; check what a ham- or spam-processor registration says
1843 ;;; returns nil if conflicting registrations are found
1844 (defun spam-log-registration-type (id type)
1845   (let ((count 0)
1846         decision)
1847     (dolist (reg (spam-log-registered-p id type))
1848       (let ((classification (nth 0 reg)))
1849         (when (spam-classification-valid-p classification)
1850           (when (and decision
1851                      (not (eq classification decision)))
1852             (setq count (+ 1 count)))
1853           (setq decision classification))))
1854     (if (< 0 count)
1855         nil
1856       decision)))
1857
1858
1859 ;;; check if a ham- or spam-processor registration needs to be undone
1860 (defun spam-log-unregistration-needed-p (id type classification backend)
1861   (when spam-log-to-registry
1862     (if (and (stringp id)
1863              (spam-process-type-valid-p type)
1864              (spam-classification-valid-p classification)
1865              (spam-backend-valid-p backend))
1866         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1867               found)
1868           (dolist (cell cell-list)
1869             (unless found
1870               (when (and (eq classification (nth 0 cell))
1871                          (eq backend (nth 1 cell)))
1872                 (setq found t))))
1873           found)
1874       (progn
1875         (gnus-error
1876          7
1877          (format "%s called with bad ID, type, classification, or spam-backend"
1878                  "spam-log-unregistration-needed-p"))
1879         nil))))
1880
1881
1882 ;;; undo a ham- or spam-processor registration (the group is not used)
1883 (defun spam-log-undo-registration (id type classification backend &optional group)
1884   (when (and spam-log-to-registry
1885              (spam-log-unregistration-needed-p id type classification backend))
1886     (if (and (stringp id)
1887              (spam-process-type-valid-p type)
1888              (spam-classification-valid-p classification)
1889              (spam-backend-valid-p backend))
1890         (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
1891               new-cell-list found)
1892           (dolist (cell cell-list)
1893             (unless (and (eq classification (nth 0 cell))
1894                          (eq backend (nth 1 cell)))
1895               (push cell new-cell-list)))
1896           (gnus-registry-store-extra-entry
1897            id
1898            type
1899            new-cell-list))
1900       (progn
1901         (gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group"
1902                               "spam-log-undo-registration"))
1903         nil))))
1904
1905 ;;}}}
1906
1907 ;;{{{ backend functions
1908
1909 ;;{{{ Gmane xrefs
1910 (defun spam-check-gmane-xref ()
1911   (let ((header (or
1912                  (message-fetch-field "Xref")
1913                  (message-fetch-field "Newsgroups"))))
1914     (when header                        ; return nil when no header
1915       (when (string-match spam-gmane-xref-spam-group
1916                           header)
1917           spam-split-group))))
1918
1919 ;;}}}
1920
1921 ;;{{{ Regex body
1922
1923 (defun spam-check-regex-body ()
1924   (let ((spam-regex-headers-ham spam-regex-body-ham)
1925         (spam-regex-headers-spam spam-regex-body-spam))
1926     (spam-check-regex-headers t)))
1927
1928 ;;}}}
1929
1930 ;;{{{ Regex headers
1931
1932 (defun spam-check-regex-headers (&optional body)
1933   (let ((type (if body "body" "header"))
1934         ret found)
1935     (dolist (h-regex spam-regex-headers-ham)
1936       (unless found
1937         (goto-char (point-min))
1938         (when (re-search-forward h-regex nil t)
1939           (message "Ham regex %s search positive." type)
1940           (setq found t))))
1941     (dolist (s-regex spam-regex-headers-spam)
1942       (unless found
1943         (goto-char (point-min))
1944         (when (re-search-forward s-regex nil t)
1945           (message "Spam regex %s search positive." type)
1946           (setq found t)
1947           (setq ret spam-split-group))))
1948     ret))
1949
1950 ;;}}}
1951
1952 ;;{{{ Blackholes.
1953
1954 (defun spam-reverse-ip-string (ip)
1955   (when (stringp ip)
1956     (mapconcat 'identity
1957                (nreverse (split-string ip "\\."))
1958                ".")))
1959
1960 (defun spam-check-blackholes ()
1961   "Check the Received headers for blackholed relays."
1962   (let ((headers (message-fetch-field "received"))
1963         ips matches)
1964     (when headers
1965       (with-temp-buffer
1966         (insert headers)
1967         (goto-char (point-min))
1968         (gnus-message 6 "Checking headers for relay addresses")
1969         (while (re-search-forward
1970                 "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
1971           (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
1972           (push (spam-reverse-ip-string (match-string 1))
1973                 ips)))
1974       (dolist (server spam-blackhole-servers)
1975         (dolist (ip ips)
1976           (unless (and spam-blackhole-good-server-regex
1977                        ;; match the good-server-regex against the reversed (again) IP string
1978                        (string-match
1979                         spam-blackhole-good-server-regex
1980                         (spam-reverse-ip-string ip)))
1981             (unless matches
1982               (let ((query-string (concat ip "." server)))
1983                 (if spam-use-dig
1984                     (let ((query-result (query-dig query-string)))
1985                       (when query-result
1986                         (gnus-message 6 "(DIG): positive blackhole check '%s'"
1987                                       query-result)
1988                         (push (list ip server query-result)
1989                               matches)))
1990                   ;; else, if not using dig.el
1991                   (when (query-dns query-string)
1992                     (gnus-message 6 "positive blackhole check")
1993                     (push (list ip server (query-dns query-string 'TXT))
1994                           matches)))))))))
1995     (when matches
1996       spam-split-group)))
1997 ;;}}}
1998
1999 ;;{{{ Hashcash.
2000
2001 (condition-case nil
2002     (progn
2003       (require 'hashcash)
2004
2005       (defun spam-check-hashcash ()
2006         "Check the headers for hashcash payments."
2007         (mail-check-payment)))   ;mail-check-payment returns a boolean
2008
2009   (file-error (progn
2010                 (defalias 'mail-check-payment 'ignore)
2011                 (defalias 'spam-check-hashcash 'ignore))))
2012 ;;}}}
2013
2014 ;;{{{ BBDB
2015
2016 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
2017 ;;; <sacha@giotto.sj.ru>
2018
2019 ;; all this is done inside a condition-case to trap errors
2020
2021 (condition-case nil
2022     (progn
2023       (require 'bbdb)
2024       (require 'bbdb-com)
2025
2026       ;; when the BBDB changes, we want to clear out our cache
2027       (defun spam-clear-cache-BBDB (&rest immaterial)
2028         (spam-clear-cache 'spam-use-BBDB))
2029
2030       (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
2031
2032       (defun spam-enter-ham-BBDB (addresses &optional remove)
2033         "Enter an address into the BBDB; implies ham (non-spam) sender"
2034         (dolist (from addresses)
2035           (when (stringp from)
2036             (let* ((parsed-address (gnus-extract-address-components from))
2037                    (name (or (nth 0 parsed-address) "Ham Sender"))
2038                    (remove-function (if remove
2039                                         'bbdb-delete-record-internal
2040                                       'ignore))
2041                    (net-address (nth 1 parsed-address))
2042                    (record (and net-address
2043                                 (bbdb-search-simple nil net-address))))
2044               (when net-address
2045                 (gnus-message 6 "%s address %s %s BBDB"
2046                               (if remove "Deleting" "Adding")
2047                               from
2048                               (if remove "from" "to"))
2049                 (if record
2050                     (funcall remove-function record)
2051                   (bbdb-create-internal name nil net-address nil nil
2052                                         "ham sender added by spam.el")))))))
2053
2054       (defun spam-BBDB-register-routine (articles &optional unregister)
2055         (let (addresses)
2056           (dolist (article articles)
2057             (when (stringp (spam-fetch-field-from-fast article))
2058               (push (spam-fetch-field-from-fast article) addresses)))
2059           ;; now do the register/unregister action
2060           (spam-enter-ham-BBDB addresses unregister)))
2061
2062       (defun spam-BBDB-unregister-routine (articles)
2063         (spam-BBDB-register-routine articles t))
2064
2065       (defun spam-check-BBDB ()
2066         "Mail from people in the BBDB is classified as ham or non-spam"
2067         (let ((who (message-fetch-field "from"))
2068               bbdb-cache bbdb-hashtable)
2069           (when spam-cache-lookups
2070             (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches))
2071             (unless bbdb-cache
2072               (setq bbdb-cache
2073                     ;; this is the expanded (bbdb-hashtable) macro
2074                     ;; without the debugging support
2075                     (with-current-buffer (bbdb-buffer)
2076                       (save-excursion
2077                         (save-window-excursion
2078                           (bbdb-records nil t)
2079                           bbdb-hashtable))))
2080               (puthash 'spam-use-BBDB bbdb-cache spam-caches)))
2081           (when who
2082             (setq who (nth 1 (gnus-extract-address-components who)))
2083             (if
2084                 (if spam-cache-lookups
2085                     (symbol-value
2086                      (intern-soft who bbdb-cache))
2087                   (bbdb-search-simple nil who))
2088                 t
2089               (if spam-use-BBDB-exclusive
2090                   spam-split-group
2091                 nil))))))
2092
2093   (file-error (progn
2094                 (defalias 'bbdb-search-simple 'ignore)
2095                 (defalias 'bbdb-records 'ignore)
2096                 (defalias 'bbdb-buffer 'ignore)
2097                 (defalias 'spam-check-BBDB 'ignore)
2098                 (defalias 'spam-BBDB-register-routine 'ignore)
2099                 (defalias 'spam-enter-ham-BBDB 'ignore)
2100                 (defalias 'bbdb-create-internal 'ignore)
2101                 (defalias 'bbdb-delete-record-internal 'ignore)
2102                 (defalias 'bbdb-records 'ignore))))
2103
2104 ;;}}}
2105
2106 ;;{{{ ifile
2107
2108 ;;; check the ifile backend; return nil if the mail was NOT classified
2109 ;;; as spam
2110
2111 (defun spam-get-ifile-database-parameter ()
2112   "Get the command-line parameter for ifile's database from
2113   spam-ifile-database-path."
2114   (if spam-ifile-database-path
2115       (format "--db-file=%s" spam-ifile-database-path)
2116     nil))
2117
2118 (defun spam-check-ifile ()
2119   "Check the ifile backend for the classification of this message."
2120   (let ((article-buffer-name (buffer-name))
2121         category return)
2122     (with-temp-buffer
2123       (let ((temp-buffer-name (buffer-name))
2124             (db-param (spam-get-ifile-database-parameter)))
2125         (save-excursion
2126           (set-buffer article-buffer-name)
2127           (apply 'call-process-region
2128                  (point-min) (point-max) spam-ifile-path
2129                  nil temp-buffer-name nil "-c"
2130                  (if db-param `(,db-param "-q") `("-q"))))
2131         ;; check the return now (we're back in the temp buffer)
2132         (goto-char (point-min))
2133         (if (not (eobp))
2134             (setq category (buffer-substring (point) (point-at-eol))))
2135         (when (not (zerop (length category))) ; we need a category here
2136           (if spam-ifile-all-categories
2137               (setq return category)
2138             ;; else, if spam-ifile-all-categories is not set...
2139             (when (string-equal spam-ifile-spam-category category)
2140               (setq return spam-split-group)))))) ; note return is nil otherwise
2141     return))
2142
2143 (defun spam-ifile-register-with-ifile (articles category &optional unregister)
2144   "Register an article, given as a string, with a category.
2145 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
2146   (let ((category (or category gnus-newsgroup-name))
2147         (add-or-delete-option (if unregister "-d" "-i"))
2148         (db (spam-get-ifile-database-parameter))
2149         parameters)
2150     (with-temp-buffer
2151       (dolist (article articles)
2152         (let ((article-string (spam-get-article-as-string article)))
2153           (when (stringp article-string)
2154             (insert article-string))))
2155       (apply 'call-process-region
2156              (point-min) (point-max) spam-ifile-path
2157              nil nil nil
2158              add-or-delete-option category
2159              (if db `(,db "-h") `("-h"))))))
2160
2161 (defun spam-ifile-register-spam-routine (articles &optional unregister)
2162   (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
2163
2164 (defun spam-ifile-unregister-spam-routine (articles)
2165   (spam-ifile-register-spam-routine articles t))
2166
2167 (defun spam-ifile-register-ham-routine (articles &optional unregister)
2168   (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
2169
2170 (defun spam-ifile-unregister-ham-routine (articles)
2171   (spam-ifile-register-ham-routine articles t))
2172
2173 ;;}}}
2174
2175 ;;{{{ spam-stat
2176
2177 (condition-case nil
2178     (progn
2179       (let ((spam-stat-install-hooks nil))
2180         (require 'spam-stat))
2181
2182       (defun spam-check-stat ()
2183         "Check the spam-stat backend for the classification of this message"
2184         (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
2185               (spam-stat-buffer (buffer-name)) ; stat the current buffer
2186               category return)
2187           (spam-stat-split-fancy)))
2188
2189       (defun spam-stat-register-spam-routine (articles &optional unregister)
2190         (dolist (article articles)
2191           (let ((article-string (spam-get-article-as-string article)))
2192             (with-temp-buffer
2193               (insert article-string)
2194               (if unregister
2195                   (spam-stat-buffer-change-to-non-spam)
2196               (spam-stat-buffer-is-spam))))))
2197
2198       (defun spam-stat-unregister-spam-routine (articles)
2199         (spam-stat-register-spam-routine articles t))
2200
2201       (defun spam-stat-register-ham-routine (articles &optional unregister)
2202         (dolist (article articles)
2203           (let ((article-string (spam-get-article-as-string article)))
2204             (with-temp-buffer
2205               (insert article-string)
2206               (if unregister
2207                   (spam-stat-buffer-change-to-spam)
2208               (spam-stat-buffer-is-non-spam))))))
2209
2210       (defun spam-stat-unregister-ham-routine (articles)
2211         (spam-stat-register-ham-routine articles t))
2212
2213       (defun spam-maybe-spam-stat-load ()
2214         (when spam-use-stat (spam-stat-load)))
2215
2216       (defun spam-maybe-spam-stat-save ()
2217         (when spam-use-stat (spam-stat-save))))
2218
2219   (file-error (progn
2220                 (defalias 'spam-stat-load 'ignore)
2221                 (defalias 'spam-stat-save 'ignore)
2222                 (defalias 'spam-maybe-spam-stat-load 'ignore)
2223                 (defalias 'spam-maybe-spam-stat-save 'ignore)
2224                 (defalias 'spam-stat-register-ham-routine 'ignore)
2225                 (defalias 'spam-stat-unregister-ham-routine 'ignore)
2226                 (defalias 'spam-stat-register-spam-routine 'ignore)
2227                 (defalias 'spam-stat-unregister-spam-routine 'ignore)
2228                 (defalias 'spam-stat-buffer-is-spam 'ignore)
2229                 (defalias 'spam-stat-buffer-change-to-spam 'ignore)
2230                 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
2231                 (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
2232                 (defalias 'spam-stat-split-fancy 'ignore)
2233                 (defalias 'spam-check-stat 'ignore))))
2234
2235
2236
2237 ;;}}}
2238
2239 ;;{{{ Blacklists and whitelists.
2240
2241 (defvar spam-whitelist-cache nil)
2242 (defvar spam-blacklist-cache nil)
2243
2244 (defun spam-kill-whole-line ()
2245   (beginning-of-line)
2246   (let ((kill-whole-line t))
2247     (kill-line)))
2248
2249 ;;; address can be a list, too
2250 (defun spam-enter-whitelist (address &optional remove)
2251   "Enter ADDRESS (list or single) into the whitelist.
2252 With a non-nil REMOVE, remove them."
2253   (interactive "sAddress: ")
2254   (spam-enter-list address spam-whitelist remove)
2255   (setq spam-whitelist-cache nil)
2256   (spam-clear-cache 'spam-use-whitelist))
2257
2258 ;;; address can be a list, too
2259 (defun spam-enter-blacklist (address &optional remove)
2260   "Enter ADDRESS (list or single) into the blacklist.
2261 With a non-nil REMOVE, remove them."
2262   (interactive "sAddress: ")
2263   (spam-enter-list address spam-blacklist remove)
2264   (setq spam-blacklist-cache nil)
2265   (spam-clear-cache 'spam-use-whitelist))
2266
2267 (defun spam-enter-list (addresses file &optional remove)
2268   "Enter ADDRESSES into the given FILE.
2269 Either the whitelist or the blacklist files can be used.  With
2270 REMOVE not nil, remove the ADDRESSES."
2271   (if (stringp addresses)
2272       (spam-enter-list (list addresses) file remove)
2273     ;; else, we have a list of addresses here
2274     (unless (file-exists-p (file-name-directory file))
2275       (make-directory (file-name-directory file) t))
2276     (save-excursion
2277       (set-buffer
2278        (find-file-noselect file))
2279       (dolist (a addresses)
2280         (when (stringp a)
2281           (goto-char (point-min))
2282           (if (re-search-forward (regexp-quote a) nil t)
2283               ;; found the address
2284               (when remove
2285                 (spam-kill-whole-line))
2286             ;; else, the address was not found
2287             (unless remove
2288               (goto-char (point-max))
2289               (unless (bobp)
2290                 (insert "\n"))
2291               (insert a "\n")))))
2292       (save-buffer))))
2293
2294 (defun spam-filelist-build-cache (type)
2295   (let ((cache (if (eq type 'spam-use-blacklist)
2296                    spam-blacklist-cache
2297                  spam-whitelist-cache))
2298         parsed-cache)
2299     (unless (gethash type spam-caches)
2300       (while cache
2301         (let ((address (pop cache)))
2302           (unless (zerop (length address)) ; 0 for a nil address too
2303             (setq address (regexp-quote address))
2304             ;; fix regexp-quote's treatment of user-intended regexes
2305             (while (string-match "\\\\\\*" address)
2306               (setq address (replace-match ".*" t t address))))
2307           (push address parsed-cache)))
2308       (puthash type parsed-cache spam-caches))))
2309
2310 (defun spam-filelist-check-cache (type from)
2311   (when (stringp from)
2312     (spam-filelist-build-cache type)
2313     (let (found)
2314       (dolist (address (gethash type spam-caches))
2315         (when (and address (string-match address from))
2316           (setq found t)
2317           (return)))
2318       found)))
2319
2320 ;;; returns t if the sender is in the whitelist, nil or
2321 ;;; spam-split-group otherwise
2322 (defun spam-check-whitelist ()
2323   ;; FIXME!  Should it detect when file timestamps change?
2324   (unless spam-whitelist-cache
2325     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
2326   (if (spam-from-listed-p 'spam-use-whitelist)
2327       t
2328     (if spam-use-whitelist-exclusive
2329         spam-split-group
2330       nil)))
2331
2332 (defun spam-check-blacklist ()
2333   ;; FIXME!  Should it detect when file timestamps change?
2334   (unless spam-blacklist-cache
2335     (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
2336   (and (spam-from-listed-p 'spam-use-blacklist)
2337        spam-split-group))
2338
2339 (defun spam-parse-list (file)
2340   (when (file-readable-p file)
2341     (let (contents address)
2342       (with-temp-buffer
2343         (insert-file-contents file)
2344         (while (not (eobp))
2345           (setq address (buffer-substring (point) (point-at-eol)))
2346           (forward-line 1)
2347           ;; insert the e-mail address if detected, otherwise the raw data
2348           (unless (zerop (length address))
2349             (let ((pure-address (nth 1 (gnus-extract-address-components address))))
2350               (push (or pure-address address) contents)))))
2351       (nreverse contents))))
2352
2353 (defun spam-from-listed-p (type)
2354   (let ((from (message-fetch-field "from"))
2355         found)
2356     (spam-filelist-check-cache type from)))
2357
2358 (defun spam-filelist-register-routine (articles blacklist &optional unregister)
2359   (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
2360         (declassification (if blacklist 'ham 'spam))
2361         (enter-function
2362          (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
2363         (remove-function
2364          (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
2365         from addresses unregister-list article-unregister-list)
2366     (dolist (article articles)
2367       (let ((from (spam-fetch-field-from-fast article))
2368             (id (spam-fetch-field-message-id-fast article))
2369             sender-ignored)
2370         (when (stringp from)
2371           (dolist (ignore-regex spam-blacklist-ignored-regexes)
2372             (when (and (not sender-ignored)
2373                        (stringp ignore-regex)
2374                        (string-match ignore-regex from))
2375               (setq sender-ignored t)))
2376           ;; remember the messages we need to unregister, unless remove is set
2377           (when (and
2378                  (null unregister)
2379                  (spam-log-unregistration-needed-p
2380                   id 'process declassification de-symbol))
2381             (push article article-unregister-list)
2382             (push from unregister-list))
2383           (unless sender-ignored
2384             (push from addresses)))))
2385
2386     (if unregister
2387         (funcall enter-function addresses t) ; unregister all these addresses
2388       ;; else, register normally and unregister what we need to
2389       (funcall remove-function unregister-list t)
2390       (dolist (article article-unregister-list)
2391         (spam-log-undo-registration
2392          (spam-fetch-field-message-id-fast article)
2393          'process
2394          declassification
2395          de-symbol))
2396       (funcall enter-function addresses nil))))
2397
2398 (defun spam-blacklist-unregister-routine (articles)
2399   (spam-blacklist-register-routine articles t))
2400
2401 (defun spam-blacklist-register-routine (articles &optional unregister)
2402   (spam-filelist-register-routine articles t unregister))
2403
2404 (defun spam-whitelist-unregister-routine (articles)
2405   (spam-whitelist-register-routine articles t))
2406
2407 (defun spam-whitelist-register-routine (articles &optional unregister)
2408   (spam-filelist-register-routine articles nil unregister))
2409
2410 ;;}}}
2411
2412 ;;{{{ Spam-report glue (gmane and resend reporting)
2413 (defun spam-report-gmane-register-routine (articles)
2414   (when articles
2415     (apply 'spam-report-gmane articles)))
2416
2417 (defun spam-report-resend-register-ham-routine (articles)
2418   (spam-report-resend-register-routine articles t))
2419
2420 (defun spam-report-resend-register-routine (articles &optional ham)
2421   (let* ((resend-to-gp 
2422           (if ham
2423               (gnus-parameter-ham-resend-to gnus-newsgroup-name)
2424             (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
2425          (spam-report-resend-to (or (car-safe resend-to-gp)
2426                                     spam-report-resend-to)))
2427     (spam-report-resend articles ham)))
2428
2429 ;;}}}
2430
2431 ;;{{{ Bogofilter
2432 (defun spam-check-bogofilter-headers (&optional score)
2433   (let ((header (message-fetch-field spam-bogofilter-header)))
2434     (when header                        ; return nil when no header
2435       (if score                         ; scoring mode
2436           (if (string-match "spamicity=\\([0-9.]+\\)" header)
2437               (match-string 1 header)
2438             "0")
2439         ;; spam detection mode
2440         (when (string-match spam-bogofilter-bogosity-positive-spam-header
2441                             header)
2442           spam-split-group)))))
2443
2444 ;; return something sensible if the score can't be determined
2445 (defun spam-bogofilter-score (&optional recheck)
2446   "Get the Bogofilter spamicity score"
2447   (interactive "P")
2448   (save-window-excursion
2449     (gnus-summary-show-article t)
2450     (set-buffer gnus-article-buffer)
2451     (let ((score (or (unless recheck
2452                        (spam-check-bogofilter-headers t))
2453                      (spam-check-bogofilter t))))
2454       (gnus-summary-show-article)
2455       (message "Spamicity score %s" score)
2456       (or score "0"))))
2457
2458 (defun spam-verify-bogofilter ()
2459   "Verify the Bogofilter version is sufficient."
2460   (when (eq spam-bogofilter-valid 'unknown)
2461     (setq spam-bogofilter-valid
2462           (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\."
2463                              (shell-command-to-string 
2464                               (format "%s -V" spam-bogofilter-path))))))
2465   spam-bogofilter-valid)
2466   
2467 (defun spam-check-bogofilter (&optional score)
2468   "Check the Bogofilter backend for the classification of this message."
2469   (if (spam-verify-bogofilter)
2470       (let ((article-buffer-name (buffer-name))
2471             (db spam-bogofilter-database-directory)
2472             return)
2473         (with-temp-buffer
2474           (let ((temp-buffer-name (buffer-name)))
2475             (save-excursion
2476               (set-buffer article-buffer-name)
2477               (apply 'call-process-region
2478                      (point-min) (point-max)
2479                      spam-bogofilter-path
2480                      nil temp-buffer-name nil
2481                      (if db `("-d" ,db "-v") `("-v"))))
2482             (setq return (spam-check-bogofilter-headers score))))
2483         return)
2484     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2485
2486 (defun spam-bogofilter-register-with-bogofilter (articles
2487                                                  spam
2488                                                  &optional unregister)
2489   "Register an article, given as a string, as spam or non-spam."
2490   (if (spam-verify-bogofilter)
2491       (dolist (article articles)
2492         (let ((article-string (spam-get-article-as-string article))
2493               (db spam-bogofilter-database-directory)
2494               (switch (if unregister
2495                           (if spam
2496                               spam-bogofilter-spam-strong-switch
2497                             spam-bogofilter-ham-strong-switch)
2498                         (if spam
2499                             spam-bogofilter-spam-switch
2500                           spam-bogofilter-ham-switch))))
2501           (when (stringp article-string)
2502             (with-temp-buffer
2503               (insert article-string)
2504               
2505               (apply 'call-process-region
2506                      (point-min) (point-max)
2507                      spam-bogofilter-path
2508                      nil nil nil switch
2509                      (if db `("-d" ,db "-v") `("-v")))))))
2510     (gnus-error "`spam.el' doesnt support obsolete bogofilter versions")))
2511
2512 (defun spam-bogofilter-register-spam-routine (articles &optional unregister)
2513   (spam-bogofilter-register-with-bogofilter articles t unregister))
2514
2515 (defun spam-bogofilter-unregister-spam-routine (articles)
2516   (spam-bogofilter-register-spam-routine articles t))
2517
2518 (defun spam-bogofilter-register-ham-routine (articles &optional unregister)
2519   (spam-bogofilter-register-with-bogofilter articles nil unregister))
2520
2521 (defun spam-bogofilter-unregister-ham-routine (articles)
2522   (spam-bogofilter-register-ham-routine articles t))
2523
2524
2525 ;;}}}
2526
2527 ;;{{{ spamoracle
2528 (defun spam-check-spamoracle ()
2529   "Run spamoracle on an article to determine whether it's spam."
2530   (let ((article-buffer-name (buffer-name)))
2531     (with-temp-buffer
2532       (let ((temp-buffer-name (buffer-name)))
2533         (save-excursion
2534           (set-buffer article-buffer-name)
2535           (let ((status
2536                  (apply 'call-process-region
2537                         (point-min) (point-max)
2538                         spam-spamoracle-binary
2539                         nil temp-buffer-name nil
2540                         (if spam-spamoracle-database
2541                             `("-f" ,spam-spamoracle-database "mark")
2542                           '("mark")))))
2543             (if (eq 0 status)
2544                 (progn
2545                   (set-buffer temp-buffer-name)
2546                   (goto-char (point-min))
2547                   (when (re-search-forward "^X-Spam: yes;" nil t)
2548                     spam-split-group))
2549               (error "Error running spamoracle: %s" status))))))))
2550
2551 (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
2552   "Run spamoracle in training mode."
2553   (with-temp-buffer
2554     (let ((temp-buffer-name (buffer-name)))
2555       (save-excursion
2556         (goto-char (point-min))
2557         (dolist (article articles)
2558           (insert (spam-get-article-as-string article)))
2559         (let* ((arg (if (spam-xor unregister article-is-spam-p)
2560                         "-spam"
2561                       "-good"))
2562                (status
2563                 (apply 'call-process-region
2564                        (point-min) (point-max)
2565                        spam-spamoracle-binary
2566                        nil temp-buffer-name nil
2567                        (if spam-spamoracle-database
2568                            `("-f" ,spam-spamoracle-database
2569                              "add" ,arg)
2570                          `("add" ,arg)))))
2571           (unless (eq 0 status)
2572             (error "Error running spamoracle: %s" status)))))))
2573
2574 (defun spam-spamoracle-learn-ham (articles &optional unregister)
2575   (spam-spamoracle-learn articles nil unregister))
2576
2577 (defun spam-spamoracle-unlearn-ham (articles &optional unregister)
2578   (spam-spamoracle-learn-ham articles t))
2579
2580 (defun spam-spamoracle-learn-spam (articles &optional unregister)
2581   (spam-spamoracle-learn articles t unregister))
2582
2583 (defun spam-spamoracle-unlearn-spam (articles &optional unregister)
2584   (spam-spamoracle-learn-spam articles t))
2585
2586 ;;}}}
2587
2588 ;;{{{ SpamAssassin
2589 ;;; based mostly on the bogofilter code
2590 (defun spam-check-spamassassin-headers (&optional score)
2591   "Check the SpamAssassin headers for the classification of this message."
2592   (if score                             ; scoring mode
2593       (let ((header (message-fetch-field spam-spamassassin-spam-status-header)))
2594         (when header
2595           (if (string-match "hits=\\(-?[0-9.]+\\)" header)
2596               (match-string 1 header)
2597             "0")))
2598     ;; spam detection mode
2599     (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)))
2600           (when header                  ; return nil when no header
2601             (when (string-match spam-spamassassin-positive-spam-flag-header
2602                                 header)
2603               spam-split-group)))))
2604
2605 (defun spam-check-spamassassin (&optional score)
2606   "Check the SpamAssassin backend for the classification of this message."
2607   (let ((article-buffer-name (buffer-name)))
2608     (with-temp-buffer
2609       (let ((temp-buffer-name (buffer-name)))
2610         (save-excursion
2611           (set-buffer article-buffer-name)
2612           (apply 'call-process-region
2613                  (point-min) (point-max) spam-spamassassin-path
2614                  nil temp-buffer-name nil spam-spamassassin-arguments))
2615         ;; check the return now (we're back in the temp buffer)
2616         (goto-char (point-min))
2617         (spam-check-spamassassin-headers score)))))
2618
2619 ;; return something sensible if the score can't be determined
2620 (defun spam-spamassassin-score (&optional recheck)
2621   "Get the SpamAssassin score"
2622   (interactive "P")
2623   (save-window-excursion
2624     (gnus-summary-show-article t)
2625     (set-buffer gnus-article-buffer)
2626     (let ((score (or (unless recheck
2627                        (spam-check-spamassassin-headers t))
2628                      (spam-check-spamassassin t))))
2629       (gnus-summary-show-article)
2630       (message "SpamAssassin score %s" score)
2631       (or score "0"))))
2632
2633 (defun spam-spamassassin-register-with-sa-learn (articles spam
2634                                                  &optional unregister)
2635   "Register articles with spamassassin's sa-learn as spam or non-spam."
2636   (if articles
2637       (let ((action (if unregister spam-sa-learn-unregister-switch
2638                       (if spam spam-sa-learn-spam-switch
2639                         spam-sa-learn-ham-switch)))
2640             (summary-buffer-name (buffer-name)))
2641         (with-temp-buffer
2642           ;; group the articles into mbox format
2643           (dolist (article articles)
2644             (let (article-string)
2645               (save-excursion
2646                 (set-buffer summary-buffer-name)
2647                 (setq article-string (spam-get-article-as-string article)))
2648               (when (stringp article-string)
2649                 (insert "From \n") ; mbox separator (sa-learn only checks the
2650                                    ; first five chars, so we can get away with
2651                                    ; a bogus line))
2652                 (insert article-string)
2653                 (insert "\n"))))
2654           ;; call sa-learn on all messages at the same time
2655           (apply 'call-process-region
2656                  (point-min) (point-max)
2657                  spam-sa-learn-path
2658                  nil nil nil "--mbox"
2659                  (if spam-sa-learn-rebuild
2660                      (list action)
2661                    `("--no-rebuild" ,action)))))))
2662
2663 (defun spam-spamassassin-register-spam-routine (articles &optional unregister)
2664   (spam-spamassassin-register-with-sa-learn articles t unregister))
2665
2666 (defun spam-spamassassin-register-ham-routine (articles &optional unregister)
2667   (spam-spamassassin-register-with-sa-learn articles nil unregister))
2668
2669 (defun spam-spamassassin-unregister-spam-routine (articles)
2670   (spam-spamassassin-register-with-sa-learn articles t t))
2671
2672 (defun spam-spamassassin-unregister-ham-routine (articles)
2673   (spam-spamassassin-register-with-sa-learn articles nil t))
2674
2675 ;;}}}
2676
2677 ;;{{{ Bsfilter
2678 ;;; based mostly on the bogofilter code
2679 (defun spam-check-bsfilter-headers (&optional score)
2680   (if score
2681       (or (nnmail-fetch-field spam-bsfilter-probability-header)
2682           "0")
2683     (let ((header (nnmail-fetch-field spam-bsfilter-header)))
2684       (when header ; return nil when no header
2685         (when (string-match "YES" header)
2686           spam-split-group)))))
2687
2688 ;; return something sensible if the score can't be determined
2689 (defun spam-bsfilter-score (&optional recheck)
2690   "Get the Bsfilter spamicity score"
2691   (interactive "P")
2692   (save-window-excursion
2693     (gnus-summary-show-article t)
2694     (set-buffer gnus-article-buffer)
2695     (let ((score (or (unless recheck
2696                        (spam-check-bsfilter-headers t))
2697                      (spam-check-bsfilter t))))
2698       (gnus-summary-show-article)
2699       (message "Spamicity score %s" score)
2700       (or score "0"))))
2701
2702 (defun spam-check-bsfilter (&optional score)
2703   "Check the Bsfilter backend for the classification of this message"
2704   (let ((article-buffer-name (buffer-name))
2705         (dir spam-bsfilter-database-directory)
2706         return)
2707     (with-temp-buffer
2708       (let ((temp-buffer-name (buffer-name)))
2709         (save-excursion
2710           (set-buffer article-buffer-name)
2711           (apply 'call-process-region
2712                  (point-min) (point-max)
2713                  spam-bsfilter-path
2714                  nil temp-buffer-name nil
2715                  "--pipe"
2716                  "--insert-flag"
2717                  "--insert-probability"
2718                  (when dir
2719                    (list "--homedir" dir))))
2720         (setq return (spam-check-bsfilter-headers score))))
2721     return))
2722
2723 (defun spam-bsfilter-register-with-bsfilter (articles
2724                                              spam
2725                                              &optional unregister)
2726   "Register an article, given as a string, as spam or non-spam."
2727   (dolist (article articles)
2728     (let ((article-string (spam-get-article-as-string article))
2729           (switch (if unregister
2730                       (if spam
2731                           spam-bsfilter-spam-strong-switch
2732                         spam-bsfilter-ham-strong-switch)
2733                     (if spam
2734                         spam-bsfilter-spam-switch
2735                       spam-bsfilter-ham-switch))))
2736       (when (stringp article-string)
2737         (with-temp-buffer
2738           (insert article-string)
2739           (apply 'call-process-region
2740                  (point-min) (point-max)
2741                  spam-bsfilter-path
2742                  nil nil nil switch
2743                  "--update"
2744                  (when spam-bsfilter-database-directory
2745                    (list "--homedir"
2746                          spam-bsfilter-database-directory))))))))
2747
2748 (defun spam-bsfilter-register-spam-routine (articles &optional unregister)
2749   (spam-bsfilter-register-with-bsfilter articles t unregister))
2750
2751 (defun spam-bsfilter-unregister-spam-routine (articles)
2752   (spam-bsfilter-register-spam-routine articles t))
2753
2754 (defun spam-bsfilter-register-ham-routine (articles &optional unregister)
2755   (spam-bsfilter-register-with-bsfilter articles nil unregister))
2756
2757 (defun spam-bsfilter-unregister-ham-routine (articles)
2758   (spam-bsfilter-register-ham-routine articles t))
2759
2760 ;;}}}
2761
2762 ;;{{{ CRM114 Mailfilter
2763 (defun spam-check-crm114-headers (&optional score)
2764   (let ((header (message-fetch-field spam-crm114-header)))
2765     (when header                        ; return nil when no header
2766       (if score                         ; scoring mode
2767           (if (string-match "( pR: \\([0-9.-]+\\)" header)
2768               (match-string 1 header)
2769             "0")
2770         ;; spam detection mode
2771         (when (string-match spam-crm114-positive-spam-header
2772                             header)
2773           spam-split-group)))))
2774
2775 ;; return something sensible if the score can't be determined
2776 (defun spam-crm114-score ()
2777   "Get the CRM114 Mailfilter pR"
2778   (interactive)
2779   (save-window-excursion
2780     (gnus-summary-show-article t)
2781     (set-buffer gnus-article-buffer)
2782     (let ((score (or (spam-check-crm114-headers t)
2783                      (spam-check-crm114 t))))
2784       (gnus-summary-show-article)
2785       (message "pR: %s" score)
2786       (or score "0"))))
2787
2788 (defun spam-check-crm114 (&optional score)
2789   "Check the CRM114 Mailfilter backend for the classification of this message"
2790   (let ((article-buffer-name (buffer-name))
2791         (db spam-crm114-database-directory)
2792         return)
2793     (with-temp-buffer
2794       (let ((temp-buffer-name (buffer-name)))
2795         (save-excursion
2796           (set-buffer article-buffer-name)
2797           (apply 'call-process-region
2798                  (point-min) (point-max)
2799                  spam-crm114-program
2800                  nil temp-buffer-name nil
2801                  (when db (list (concat "--fileprefix=" db)))))
2802         (setq return (spam-check-crm114-headers score))))
2803     return))
2804
2805 (defun spam-crm114-register-with-crm114 (articles
2806                                          spam
2807                                          &optional unregister)
2808   "Register an article, given as a string, as spam or non-spam."
2809   (dolist (article articles)
2810     (let ((article-string (spam-get-article-as-string article))
2811           (db spam-crm114-database-directory)
2812           (switch (if unregister
2813                       (if spam
2814                           spam-crm114-spam-strong-switch
2815                         spam-crm114-ham-strong-switch)
2816                     (if spam
2817                         spam-crm114-spam-switch
2818                       spam-crm114-ham-switch))))
2819       (when (stringp article-string)
2820         (with-temp-buffer
2821           (insert article-string)
2822
2823           (apply 'call-process-region
2824                  (point-min) (point-max)
2825                  spam-crm114-program
2826                  nil nil nil
2827                  (when db (list switch (concat "--fileprefix=" db)))))))))
2828
2829 (defun spam-crm114-register-spam-routine (articles &optional unregister)
2830   (spam-crm114-register-with-crm114 articles t unregister))
2831
2832 (defun spam-crm114-unregister-spam-routine (articles)
2833   (spam-crm114-register-spam-routine articles t))
2834
2835 (defun spam-crm114-register-ham-routine (articles &optional unregister)
2836   (spam-crm114-register-with-crm114 articles nil unregister))
2837
2838 (defun spam-crm114-unregister-ham-routine (articles)
2839   (spam-crm114-register-ham-routine articles t))
2840
2841 ;;}}}
2842
2843 ;;}}}
2844
2845 ;;{{{ Hooks
2846
2847 ;;;###autoload
2848 (defun spam-initialize (&rest symbols)
2849   "Install the spam.el hooks and do other initialization.
2850 When SYMBOLS is given, set those variables to t.  This is so you
2851 can call spam-initialize before you set spam-use-* variables on
2852 explicitly, and matters only if you need the extra headers
2853 installed through spam-necessary-extra-headers."
2854   (interactive)
2855
2856   (dolist (var symbols)
2857     (set var t))
2858
2859   (dolist (header (spam-necessary-extra-headers))
2860     (add-to-list 'nnmail-extra-headers header)
2861     (add-to-list 'gnus-extra-headers header))
2862
2863   (setq spam-install-hooks t)
2864   ;; TODO: How do we redo this every time spam-face is customized?
2865   (push '((eq mark gnus-spam-mark) . spam-face)
2866         gnus-summary-highlight)
2867   ;; Add hooks for loading and saving the spam stats
2868   (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2869   (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2870   (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2871   (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2872   (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2873   (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2874   (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
2875
2876 (defun spam-unload-hook ()
2877   "Uninstall the spam.el hooks"
2878   (interactive)
2879   (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
2880   (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
2881   (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
2882   (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
2883   (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
2884   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
2885   (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
2886
2887 (add-hook 'spam-unload-hook 'spam-unload-hook)
2888
2889 (when spam-install-hooks
2890   (spam-initialize))
2891 ;;}}}
2892
2893 (provide 'spam)
2894
2895 ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
2896 ;;; spam.el ends here