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