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