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