1 |
|
;;; spam.el --- Identifying spam |
2 |
|
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. |
3 |
|
|
4 |
|
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
5 |
|
;; Keywords: network |
6 |
|
|
7 |
|
;; This file is part of GNU Emacs. |
8 |
|
|
9 |
|
;; GNU Emacs is free software; you can redistribute it and/or modify |
10 |
|
;; it under the terms of the GNU General Public License as published by |
11 |
|
;; the Free Software Foundation; either version 2, or (at your option) |
12 |
|
;; any later version. |
13 |
|
|
14 |
|
;; GNU Emacs is distributed in the hope that it will be useful, |
15 |
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
16 |
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
17 |
|
;; GNU General Public License for more details. |
18 |
|
|
19 |
|
;; You should have received a copy of the GNU General Public License |
20 |
|
;; along with GNU Emacs; see the file COPYING. If not, write to the |
21 |
|
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
22 |
|
;; Boston, MA 02111-1307, USA. |
23 |
|
|
24 |
|
;;; Commentary: |
25 |
|
|
26 |
|
;;; This module addresses a few aspects of spam control under Gnus. Page |
27 |
|
;;; breaks are used for grouping declarations and documentation relating to |
28 |
|
;;; each particular aspect. |
29 |
|
|
30 |
|
;;; The integration with Gnus is not yet complete. See various `FIXME' |
31 |
|
;;; comments, below, for supplementary explanations or discussions. |
32 |
|
|
33 |
|
;;; Several TODO items are marked as such |
34 |
|
|
35 |
|
;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting, |
36 |
|
;; remote processing, training through files |
37 |
|
|
38 |
|
;;; Code: |
39 |
|
|
40 |
|
(eval-when-compile (require 'cl)) |
41 |
|
|
42 |
|
(require 'gnus-sum) |
43 |
|
|
44 |
|
(require 'gnus-uu) ; because of key prefix issues |
45 |
|
;;; for the definitions of group content classification and spam processors |
46 |
|
(require 'gnus) |
47 |
|
(require 'message) ;for the message-fetch-field functions |
48 |
|
|
49 |
|
;; for nnimap-split-download-body-default |
50 |
|
(eval-when-compile (require 'nnimap)) |
51 |
|
|
52 |
|
;; autoload executable-find |
53 |
|
(eval-and-compile |
54 |
|
;; executable-find is not autoloaded in Emacs 20 |
55 |
|
(autoload 'executable-find "executable")) |
56 |
|
|
57 |
|
;; autoload query-dig |
58 |
|
(eval-and-compile |
59 |
|
(autoload 'query-dig "dig")) |
60 |
|
|
61 |
|
;; autoload spam-report |
62 |
|
(eval-and-compile |
63 |
|
(autoload 'spam-report-gmane "spam-report")) |
64 |
|
|
65 |
|
;; autoload gnus-registry |
66 |
|
(eval-and-compile |
67 |
|
(autoload 'gnus-registry-group-count "gnus-registry") |
68 |
|
(autoload 'gnus-registry-add-group "gnus-registry") |
69 |
|
(autoload 'gnus-registry-store-extra-entry "gnus-registry") |
70 |
|
(autoload 'gnus-registry-fetch-extra "gnus-registry")) |
71 |
|
|
72 |
|
;; autoload query-dns |
73 |
|
(eval-and-compile |
74 |
|
(autoload 'query-dns "dns")) |
75 |
|
|
76 |
|
;;; Main parameters. |
77 |
|
|
78 |
|
(defgroup spam nil |
79 |
|
"Spam configuration.") |
80 |
|
|
81 |
|
(defcustom spam-directory "~/News/spam/" |
82 |
|
"Directory for spam whitelists and blacklists." |
83 |
|
:type 'directory |
84 |
|
:group 'spam) |
85 |
|
|
86 |
|
(defcustom spam-move-spam-nonspam-groups-only t |
87 |
|
"Whether spam should be moved in non-spam groups only. |
88 |
|
When t, only ham and unclassified groups will have their spam moved |
89 |
|
to the spam-process-destination. When nil, spam will also be moved from |
90 |
|
spam groups." |
91 |
|
:type 'boolean |
92 |
|
:group 'spam) |
93 |
|
|
94 |
|
(defcustom spam-process-ham-in-nonham-groups nil |
95 |
|
"Whether ham should be processed in non-ham groups." |
96 |
|
:type 'boolean |
97 |
|
:group 'spam) |
98 |
|
|
99 |
|
(defcustom spam-log-to-registry nil |
100 |
|
"Whether spam/ham processing should be logged in the registry." |
101 |
|
:type 'boolean |
102 |
|
:group 'spam) |
103 |
|
|
104 |
|
(defcustom spam-split-symbolic-return nil |
105 |
|
"Whether `spam-split' should work with symbols or group names." |
106 |
|
:type 'boolean |
107 |
|
:group 'spam) |
108 |
|
|
109 |
|
(defcustom spam-split-symbolic-return-positive nil |
110 |
|
"Whether `spam-split' should ALWAYS work with symbols or group names. |
111 |
|
Do not set this if you use `spam-split' in a fancy split |
112 |
|
method." |
113 |
|
:type 'boolean |
114 |
|
:group 'spam) |
115 |
|
|
116 |
|
(defcustom spam-process-ham-in-spam-groups nil |
117 |
|
"Whether ham should be processed in spam groups." |
118 |
|
:type 'boolean |
119 |
|
:group 'spam) |
120 |
|
|
121 |
|
(defcustom spam-mark-only-unseen-as-spam t |
122 |
|
"Whether only unseen articles should be marked as spam in spam groups. |
123 |
|
When nil, all unread articles in a spam group are marked as |
124 |
|
spam. Set this if you want to leave an article unread in a spam group |
125 |
|
without losing it to the automatic spam-marking process." |
126 |
|
:type 'boolean |
127 |
|
:group 'spam) |
128 |
|
|
129 |
|
(defcustom spam-mark-ham-unread-before-move-from-spam-group nil |
130 |
|
"Whether ham should be marked unread before it's moved. |
131 |
|
The article is moved out of a spam group according to ham-process-destination. |
132 |
|
This variable is an official entry in the international Longest Variable Name |
133 |
|
Competition." |
134 |
|
:type 'boolean |
135 |
|
:group 'spam) |
136 |
|
|
137 |
|
(defcustom spam-disable-spam-split-during-ham-respool nil |
138 |
|
"Whether `spam-split' should be ignored while resplitting ham in a process |
139 |
|
destination. This is useful to prevent ham from ending up in the same spam |
140 |
|
group after the resplit. Don't set this to t if you have spam-split as the |
141 |
|
last rule in your split configuration." |
142 |
|
:type 'boolean |
143 |
|
:group 'spam) |
144 |
|
|
145 |
|
(defcustom spam-autodetect-recheck-messages nil |
146 |
|
"Should spam.el recheck all meessages when autodetecting? |
147 |
|
Normally this is nil, so only unseen messages will be checked." |
148 |
|
:type 'boolean |
149 |
|
:group 'spam) |
150 |
|
|
151 |
|
(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory) |
152 |
|
"The location of the whitelist. |
153 |
|
The file format is one regular expression per line. |
154 |
|
The regular expression is matched against the address." |
155 |
|
:type 'file |
156 |
|
:group 'spam) |
157 |
|
|
158 |
|
(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory) |
159 |
|
"The location of the blacklist. |
160 |
|
The file format is one regular expression per line. |
161 |
|
The regular expression is matched against the address." |
162 |
|
:type 'file |
163 |
|
:group 'spam) |
164 |
|
|
165 |
|
(defcustom spam-use-dig t |
166 |
|
"Whether `query-dig' should be used instead of `query-dns'." |
167 |
|
:type 'boolean |
168 |
|
:group 'spam) |
169 |
|
|
170 |
|
(defcustom spam-use-blacklist nil |
171 |
|
"Whether the blacklist should be used by `spam-split'." |
172 |
|
:type 'boolean |
173 |
|
:group 'spam) |
174 |
|
|
175 |
|
(defcustom spam-blacklist-ignored-regexes nil |
176 |
|
"Regular expressions that the blacklist should ignore." |
177 |
|
:type '(repeat (regexp :tag "Regular expression to ignore when blacklisting")) |
178 |
|
:group 'spam) |
179 |
|
|
180 |
|
(defcustom spam-use-whitelist nil |
181 |
|
"Whether the whitelist should be used by `spam-split'." |
182 |
|
:type 'boolean |
183 |
|
:group 'spam) |
184 |
|
|
185 |
|
(defcustom spam-use-whitelist-exclusive nil |
186 |
|
"Whether whitelist-exclusive should be used by `spam-split'. |
187 |
|
Exclusive whitelisting means that all messages from senders not in the whitelist |
188 |
|
are considered spam." |
189 |
|
:type 'boolean |
190 |
|
:group 'spam) |
191 |
|
|
192 |
|
(defcustom spam-use-blackholes nil |
193 |
|
"Whether blackholes should be used by `spam-split'." |
194 |
|
:type 'boolean |
195 |
|
:group 'spam) |
196 |
|
|
197 |
|
(defcustom spam-use-hashcash nil |
198 |
|
"Whether hashcash payments should be detected by `spam-split'." |
199 |
|
:type 'boolean |
200 |
|
:group 'spam) |
201 |
|
|
202 |
|
(defcustom spam-use-regex-headers nil |
203 |
|
"Whether a header regular expression match should be used by `spam-split'. |
204 |
|
Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'." |
205 |
|
:type 'boolean |
206 |
|
:group 'spam) |
207 |
|
|
208 |
|
(defcustom spam-use-regex-body nil |
209 |
|
"Whether a body regular expression match should be used by `spam-split'. |
210 |
|
Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'." |
211 |
|
:type 'boolean |
212 |
|
:group 'spam) |
213 |
|
|
214 |
|
(defcustom spam-use-bogofilter-headers nil |
215 |
|
"Whether bogofilter headers should be used by `spam-split'. |
216 |
|
Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them." |
217 |
|
:type 'boolean |
218 |
|
:group 'spam) |
219 |
|
|
220 |
|
(defcustom spam-use-bogofilter nil |
221 |
|
"Whether bogofilter should be invoked by `spam-split'. |
222 |
|
Enable this if you want Gnus to invoke Bogofilter on new messages." |
223 |
|
:type 'boolean |
224 |
|
:group 'spam) |
225 |
|
|
226 |
|
(defcustom spam-use-BBDB nil |
227 |
|
"Whether BBDB should be used by `spam-split'." |
228 |
|
:type 'boolean |
229 |
|
:group 'spam) |
230 |
|
|
231 |
|
(defcustom spam-use-BBDB-exclusive nil |
232 |
|
"Whether BBDB-exclusive should be used by `spam-split'. |
233 |
|
Exclusive BBDB means that all messages from senders not in the BBDB are |
234 |
|
considered spam." |
235 |
|
:type 'boolean |
236 |
|
:group 'spam) |
237 |
|
|
238 |
|
(defcustom spam-use-ifile nil |
239 |
|
"Whether ifile should be used by `spam-split'." |
240 |
|
:type 'boolean |
241 |
|
:group 'spam) |
242 |
|
|
243 |
|
(defcustom spam-use-stat nil |
244 |
|
"Whether `spam-stat' should be used by `spam-split'." |
245 |
|
:type 'boolean |
246 |
|
:group 'spam) |
247 |
|
|
248 |
|
(defcustom spam-use-spamoracle nil |
249 |
|
"Whether spamoracle should be used by `spam-split'." |
250 |
|
:type 'boolean |
251 |
|
:group 'spam) |
252 |
|
|
253 |
|
(defcustom spam-install-hooks (or |
254 |
|
spam-use-dig |
255 |
|
spam-use-blacklist |
256 |
|
spam-use-whitelist |
257 |
|
spam-use-whitelist-exclusive |
258 |
|
spam-use-blackholes |
259 |
|
spam-use-hashcash |
260 |
|
spam-use-regex-headers |
261 |
|
spam-use-regex-body |
262 |
|
spam-use-bogofilter-headers |
263 |
|
spam-use-bogofilter |
264 |
|
spam-use-BBDB |
265 |
|
spam-use-BBDB-exclusive |
266 |
|
spam-use-ifile |
267 |
|
spam-use-stat |
268 |
|
spam-use-spamoracle) |
269 |
|
"Whether the spam hooks should be installed. |
270 |
|
Default to t if one of the spam-use-* variables is set." |
271 |
|
:group 'spam |
272 |
|
:type 'boolean) |
273 |
|
|
274 |
|
(defcustom spam-split-group "spam" |
275 |
|
"Group name where incoming spam should be put by `spam-split'." |
276 |
|
:type 'string |
277 |
|
:group 'spam) |
278 |
|
|
279 |
|
;;; TODO: deprecate this variable, it's confusing since it's a list of strings, |
280 |
|
;;; not regular expressions |
281 |
|
(defcustom spam-junk-mailgroups (cons |
282 |
|
spam-split-group |
283 |
|
'("mail.junk" "poste.pourriel")) |
284 |
|
"Mailgroups with spam contents. |
285 |
|
All unmarked article in such group receive the spam mark on group entry." |
286 |
|
:type '(repeat (string :tag "Group")) |
287 |
|
:group 'spam) |
288 |
|
|
289 |
|
(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" |
290 |
|
"dev.null.dk" "relays.visi.com") |
291 |
|
"List of blackhole servers." |
292 |
|
:type '(repeat (string :tag "Server")) |
293 |
|
:group 'spam) |
294 |
|
|
295 |
|
(defcustom spam-blackhole-good-server-regex nil |
296 |
|
"String matching IP addresses that should not be checked in the blackholes." |
297 |
|
:type '(radio (const nil) |
298 |
|
(regexp :format "%t: %v\n" :size 0)) |
299 |
|
:group 'spam) |
300 |
|
|
301 |
|
(defcustom spam-face 'gnus-splash-face |
302 |
|
"Face for spam-marked articles." |
303 |
|
:type 'face |
304 |
|
:group 'spam) |
305 |
|
|
306 |
|
(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES") |
307 |
|
"Regular expression for positive header spam matches." |
308 |
|
:type '(repeat (regexp :tag "Regular expression to match spam header")) |
309 |
|
:group 'spam) |
310 |
|
|
311 |
|
(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO") |
312 |
|
"Regular expression for positive header ham matches." |
313 |
|
:type '(repeat (regexp :tag "Regular expression to match ham header")) |
314 |
|
:group 'spam) |
315 |
|
|
316 |
|
(defcustom spam-regex-body-spam '() |
317 |
|
"Regular expression for positive body spam matches." |
318 |
|
:type '(repeat (regexp :tag "Regular expression to match spam body")) |
319 |
|
:group 'spam) |
320 |
|
|
321 |
|
(defcustom spam-regex-body-ham '() |
322 |
|
"Regular expression for positive body ham matches." |
323 |
|
:type '(repeat (regexp :tag "Regular expression to match ham body")) |
324 |
|
:group 'spam) |
325 |
|
|
326 |
|
(defgroup spam-ifile nil |
327 |
|
"Spam ifile configuration." |
328 |
|
:group 'spam) |
329 |
|
|
330 |
|
(defcustom spam-ifile-path (executable-find "ifile") |
331 |
|
"File path of the ifile executable program." |
332 |
|
:type '(choice (file :tag "Location of ifile") |
333 |
|
(const :tag "ifile is not installed")) |
334 |
|
:group 'spam-ifile) |
335 |
|
|
336 |
|
(defcustom spam-ifile-database-path nil |
337 |
|
"File path of the ifile database." |
338 |
|
:type '(choice (file :tag "Location of the ifile database") |
339 |
|
(const :tag "Use the default")) |
340 |
|
:group 'spam-ifile) |
341 |
|
|
342 |
|
(defcustom spam-ifile-spam-category "spam" |
343 |
|
"Name of the spam ifile category." |
344 |
|
:type 'string |
345 |
|
:group 'spam-ifile) |
346 |
|
|
347 |
|
(defcustom spam-ifile-ham-category nil |
348 |
|
"Name of the ham ifile category. |
349 |
|
If nil, the current group name will be used." |
350 |
|
:type '(choice (string :tag "Use a fixed category") |
351 |
|
(const :tag "Use the current group name")) |
352 |
|
:group 'spam-ifile) |
353 |
|
|
354 |
|
(defcustom spam-ifile-all-categories nil |
355 |
|
"Whether the ifile check will return all categories, or just spam. |
356 |
|
Set this to t if you want to use the `spam-split' invocation of ifile as |
357 |
|
your main source of newsgroup names." |
358 |
|
:type 'boolean |
359 |
|
:group 'spam-ifile) |
360 |
|
|
361 |
|
(defgroup spam-bogofilter nil |
362 |
|
"Spam bogofilter configuration." |
363 |
|
:group 'spam) |
364 |
|
|
365 |
|
(defcustom spam-bogofilter-path (executable-find "bogofilter") |
366 |
|
"File path of the Bogofilter executable program." |
367 |
|
:type '(choice (file :tag "Location of bogofilter") |
368 |
|
(const :tag "Bogofilter is not installed")) |
369 |
|
:group 'spam-bogofilter) |
370 |
|
|
371 |
|
(defcustom spam-bogofilter-header "X-Bogosity" |
372 |
|
"The header that Bogofilter inserts in messages." |
373 |
|
:type 'string |
374 |
|
:group 'spam-bogofilter) |
375 |
|
|
376 |
|
(defcustom spam-bogofilter-spam-switch "-s" |
377 |
|
"The switch that Bogofilter uses to register spam messages." |
378 |
|
:type 'string |
379 |
|
:group 'spam-bogofilter) |
380 |
|
|
381 |
|
(defcustom spam-bogofilter-ham-switch "-n" |
382 |
|
"The switch that Bogofilter uses to register ham messages." |
383 |
|
:type 'string |
384 |
|
:group 'spam-bogofilter) |
385 |
|
|
386 |
|
(defcustom spam-bogofilter-spam-strong-switch "-S" |
387 |
|
"The switch that Bogofilter uses to unregister ham messages." |
388 |
|
:type 'string |
389 |
|
:group 'spam-bogofilter) |
390 |
|
|
391 |
|
(defcustom spam-bogofilter-ham-strong-switch "-N" |
392 |
|
"The switch that Bogofilter uses to unregister spam messages." |
393 |
|
:type 'string |
394 |
|
:group 'spam-bogofilter) |
395 |
|
|
396 |
|
(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" |
397 |
|
"The regex on `spam-bogofilter-header' for positive spam identification." |
398 |
|
:type 'regexp |
399 |
|
:group 'spam-bogofilter) |
400 |
|
|
401 |
|
(defcustom spam-bogofilter-database-directory nil |
402 |
|
"Directory path of the Bogofilter databases." |
403 |
|
:type '(choice (directory |
404 |
|
:tag "Location of the Bogofilter database directory") |
405 |
|
(const :tag "Use the default")) |
406 |
|
:group 'spam-bogofilter) |
407 |
|
|
408 |
|
(defgroup spam-spamoracle nil |
409 |
|
"Spam spamoracle configuration." |
410 |
|
:group 'spam) |
411 |
|
|
412 |
|
(defcustom spam-spamoracle-database nil |
413 |
|
"Location of spamoracle database file. When nil, use the default |
414 |
|
spamoracle database." |
415 |
|
:type '(choice (directory :tag "Location of spamoracle database file.") |
416 |
|
(const :tag "Use the default")) |
417 |
|
:group 'spam-spamoracle) |
418 |
|
|
419 |
|
(defcustom spam-spamoracle-binary (executable-find "spamoracle") |
420 |
|
"Location of the spamoracle binary." |
421 |
|
:type '(choice (directory :tag "Location of the spamoracle binary") |
422 |
|
(const :tag "Use the default")) |
423 |
|
:group 'spam-spamoracle) |
424 |
|
|
425 |
|
;;; Key bindings for spam control. |
426 |
|
|
427 |
|
(gnus-define-keys gnus-summary-mode-map |
428 |
|
"St" spam-bogofilter-score |
429 |
|
"Sx" gnus-summary-mark-as-spam |
430 |
|
"Mst" spam-bogofilter-score |
431 |
|
"Msx" gnus-summary-mark-as-spam |
432 |
|
"\M-d" gnus-summary-mark-as-spam) |
433 |
|
|
434 |
|
(defvar spam-old-ham-articles nil |
435 |
|
"List of old ham articles, generated when a group is entered.") |
436 |
|
|
437 |
|
(defvar spam-old-spam-articles nil |
438 |
|
"List of old spam articles, generated when a group is entered.") |
439 |
|
|
440 |
|
(defvar spam-split-disabled nil |
441 |
|
"If non-nil, `spam-split' is disabled, and always returns nil.") |
442 |
|
|
443 |
|
(defvar spam-split-last-successful-check nil |
444 |
|
"`spam-split' will set this to nil or a spam-use-XYZ check if it |
445 |
|
finds ham or spam.") |
446 |
|
|
447 |
|
;; convenience functions |
448 |
|
(defun spam-xor (a b) |
449 |
|
"Logical exclusive `or'." |
450 |
|
(and (or a b) (not (and a b)))) |
451 |
|
|
452 |
|
(defun spam-group-ham-mark-p (group mark &optional spam) |
453 |
|
(when (stringp group) |
454 |
|
(let* ((marks (spam-group-ham-marks group spam)) |
455 |
|
(marks (if (symbolp mark) |
456 |
|
marks |
457 |
|
(mapcar 'symbol-value marks)))) |
458 |
|
(memq mark marks)))) |
459 |
|
|
460 |
|
(defun spam-group-spam-mark-p (group mark) |
461 |
|
(spam-group-ham-mark-p group mark t)) |
462 |
|
|
463 |
|
(defun spam-group-ham-marks (group &optional spam) |
464 |
|
(when (stringp group) |
465 |
|
(let* ((marks (if spam |
466 |
|
(gnus-parameter-spam-marks group) |
467 |
|
(gnus-parameter-ham-marks group))) |
468 |
|
(marks (car marks)) |
469 |
|
(marks (if (listp (car marks)) (car marks) marks))) |
470 |
|
marks))) |
471 |
|
|
472 |
|
(defun spam-group-spam-marks (group) |
473 |
|
(spam-group-ham-marks group t)) |
474 |
|
|
475 |
|
(defun spam-group-spam-contents-p (group) |
476 |
|
(if (stringp group) |
477 |
|
(or (member group spam-junk-mailgroups) |
478 |
|
(memq 'gnus-group-spam-classification-spam |
479 |
|
(gnus-parameter-spam-contents group))) |
480 |
|
nil)) |
481 |
|
|
482 |
|
(defun spam-group-ham-contents-p (group) |
483 |
|
(if (stringp group) |
484 |
|
(memq 'gnus-group-spam-classification-ham |
485 |
|
(gnus-parameter-spam-contents group)) |
486 |
|
nil)) |
487 |
|
|
488 |
|
(defvar spam-list-of-processors |
489 |
|
'((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) |
490 |
|
(gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) |
491 |
|
(gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) |
492 |
|
(gnus-group-spam-exit-processor-ifile spam spam-use-ifile) |
493 |
|
(gnus-group-spam-exit-processor-stat spam spam-use-stat) |
494 |
|
(gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) |
495 |
|
(gnus-group-ham-exit-processor-ifile ham spam-use-ifile) |
496 |
|
(gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) |
497 |
|
(gnus-group-ham-exit-processor-stat ham spam-use-stat) |
498 |
|
(gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) |
499 |
|
(gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) |
500 |
|
(gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) |
501 |
|
(gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle)) |
502 |
|
"The spam-list-of-processors list contains pairs associating a |
503 |
|
ham/spam exit processor variable with a classification and a |
504 |
|
spam-use-* variable.") |
505 |
|
|
506 |
|
(defun spam-group-processor-p (group processor) |
507 |
|
(if (and (stringp group) |
508 |
|
(symbolp processor)) |
509 |
|
(or (member processor (nth 0 (gnus-parameter-spam-process group))) |
510 |
|
(spam-group-processor-multiple-p |
511 |
|
group |
512 |
|
(cdr-safe (assoc processor spam-list-of-processors)))) |
513 |
|
nil)) |
514 |
|
|
515 |
|
(defun spam-group-processor-multiple-p (group processor-info) |
516 |
|
(let* ((classification (nth 0 processor-info)) |
517 |
|
(check (nth 1 processor-info)) |
518 |
|
(parameters (nth 0 (gnus-parameter-spam-process group))) |
519 |
|
found) |
520 |
|
(dolist (parameter parameters) |
521 |
|
(when (and (null found) |
522 |
|
(listp parameter) |
523 |
|
(eq classification (nth 0 parameter)) |
524 |
|
(eq check (nth 1 parameter))) |
525 |
|
(setq found t))) |
526 |
|
found)) |
527 |
|
|
528 |
|
(defun spam-group-spam-processor-report-gmane-p (group) |
529 |
|
(spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane)) |
530 |
|
|
531 |
|
(defun spam-group-spam-processor-bogofilter-p (group) |
532 |
|
(spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter)) |
533 |
|
|
534 |
|
(defun spam-group-spam-processor-blacklist-p (group) |
535 |
|
(spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist)) |
536 |
|
|
537 |
|
(defun spam-group-spam-processor-ifile-p (group) |
538 |
|
(spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile)) |
539 |
|
|
540 |
|
(defun spam-group-ham-processor-ifile-p (group) |
541 |
|
(spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile)) |
542 |
|
|
543 |
|
(defun spam-group-spam-processor-spamoracle-p (group) |
544 |
|
(spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle)) |
545 |
|
|
546 |
|
(defun spam-group-ham-processor-bogofilter-p (group) |
547 |
|
(spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter)) |
548 |
|
|
549 |
|
(defun spam-group-spam-processor-stat-p (group) |
550 |
|
(spam-group-processor-p group 'gnus-group-spam-exit-processor-stat)) |
551 |
|
|
552 |
|
(defun spam-group-ham-processor-stat-p (group) |
553 |
|
(spam-group-processor-p group 'gnus-group-ham-exit-processor-stat)) |
554 |
|
|
555 |
|
(defun spam-group-ham-processor-whitelist-p (group) |
556 |
|
(spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist)) |
557 |
|
|
558 |
|
(defun spam-group-ham-processor-BBDB-p (group) |
559 |
|
(spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB)) |
560 |
|
|
561 |
|
(defun spam-group-ham-processor-copy-p (group) |
562 |
|
(spam-group-processor-p group 'gnus-group-ham-exit-processor-copy)) |
563 |
|
|
564 |
|
(defun spam-group-ham-processor-spamoracle-p (group) |
565 |
|
(spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle)) |
566 |
|
|
567 |
|
;;; Summary entry and exit processing. |
568 |
|
|
569 |
|
(defun spam-summary-prepare () |
570 |
|
(setq spam-old-ham-articles |
571 |
|
(spam-list-articles gnus-newsgroup-articles 'ham)) |
572 |
|
(setq spam-old-spam-articles |
573 |
|
(spam-list-articles gnus-newsgroup-articles 'spam)) |
574 |
|
(spam-mark-junk-as-spam-routine)) |
575 |
|
|
576 |
|
;; The spam processors are invoked for any group, spam or ham or neither |
577 |
|
(defun spam-summary-prepare-exit () |
578 |
|
(unless gnus-group-is-exiting-without-update-p |
579 |
|
(gnus-message 6 "Exiting summary buffer and applying spam rules") |
580 |
|
|
581 |
|
;; first of all, unregister any articles that are no longer ham or spam |
582 |
|
;; we have to iterate over the processors, or else we'll be too slow |
583 |
|
(dolist (classification '(spam ham)) |
584 |
|
(let* ((old-articles (if (eq classification 'spam) |
585 |
|
spam-old-spam-articles |
586 |
|
spam-old-ham-articles)) |
587 |
|
(new-articles (spam-list-articles |
588 |
|
gnus-newsgroup-articles |
589 |
|
classification)) |
590 |
|
(changed-articles (gnus-set-difference old-articles new-articles))) |
591 |
|
;; now that we have the changed articles, we go through the processors |
592 |
|
(dolist (processor-param spam-list-of-processors) |
593 |
|
(let ((processor (nth 0 processor-param)) |
594 |
|
(processor-classification (nth 1 processor-param)) |
595 |
|
(check (nth 2 processor-param)) |
596 |
|
unregister-list) |
597 |
|
(dolist (article changed-articles) |
598 |
|
(let ((id (spam-fetch-field-message-id-fast article))) |
599 |
|
(when (spam-log-unregistration-needed-p |
600 |
|
id 'process classification check) |
601 |
|
(push article unregister-list)))) |
602 |
|
;; call spam-register-routine with specific articles to unregister, |
603 |
|
;; when there are articles to unregister and the check is enabled |
604 |
|
(when (and unregister-list (symbol-value check)) |
605 |
|
(spam-register-routine classification check t unregister-list)))))) |
606 |
|
|
607 |
|
;; find all the spam processors applicable to this group |
608 |
|
(dolist (processor-param spam-list-of-processors) |
609 |
|
(let ((processor (nth 0 processor-param)) |
610 |
|
(classification (nth 1 processor-param)) |
611 |
|
(check (nth 2 processor-param))) |
612 |
|
(when (and (eq 'spam classification) |
613 |
|
(spam-group-processor-p gnus-newsgroup-name processor)) |
614 |
|
(spam-register-routine classification check)))) |
615 |
|
|
616 |
|
(if spam-move-spam-nonspam-groups-only |
617 |
|
(when (not (spam-group-spam-contents-p gnus-newsgroup-name)) |
618 |
|
(spam-mark-spam-as-expired-and-move-routine |
619 |
|
(gnus-parameter-spam-process-destination gnus-newsgroup-name))) |
620 |
|
(gnus-message 5 "Marking spam as expired and moving it to %s" |
621 |
|
gnus-newsgroup-name) |
622 |
|
(spam-mark-spam-as-expired-and-move-routine |
623 |
|
(gnus-parameter-spam-process-destination gnus-newsgroup-name))) |
624 |
|
|
625 |
|
;; now we redo spam-mark-spam-as-expired-and-move-routine to only |
626 |
|
;; expire spam, in case the above did not expire them |
627 |
|
(gnus-message 5 "Marking spam as expired without moving it") |
628 |
|
(spam-mark-spam-as-expired-and-move-routine nil) |
629 |
|
|
630 |
|
(when (or (spam-group-ham-contents-p gnus-newsgroup-name) |
631 |
|
(and (spam-group-spam-contents-p gnus-newsgroup-name) |
632 |
|
spam-process-ham-in-spam-groups) |
633 |
|
spam-process-ham-in-nonham-groups) |
634 |
|
;; find all the ham processors applicable to this group |
635 |
|
(dolist (processor-param spam-list-of-processors) |
636 |
|
(let ((processor (nth 0 processor-param)) |
637 |
|
(classification (nth 1 processor-param)) |
638 |
|
(check (nth 2 processor-param))) |
639 |
|
(when (and (eq 'ham classification) |
640 |
|
(spam-group-processor-p gnus-newsgroup-name processor)) |
641 |
|
(spam-register-routine classification check))))) |
642 |
|
|
643 |
|
(when (spam-group-ham-processor-copy-p gnus-newsgroup-name) |
644 |
|
(gnus-message 5 "Copying ham") |
645 |
|
(spam-ham-copy-routine |
646 |
|
(gnus-parameter-ham-process-destination gnus-newsgroup-name))) |
647 |
|
|
648 |
|
;; now move all ham articles out of spam groups |
649 |
|
(when (spam-group-spam-contents-p gnus-newsgroup-name) |
650 |
|
(gnus-message 5 "Moving ham messages from spam group") |
651 |
|
(spam-ham-move-routine |
652 |
|
(gnus-parameter-ham-process-destination gnus-newsgroup-name)))) |
653 |
|
|
654 |
|
(setq spam-old-ham-articles nil) |
655 |
|
(setq spam-old-spam-articles nil)) |
656 |
|
|
657 |
|
(defun spam-mark-junk-as-spam-routine () |
658 |
|
;; check the global list of group names spam-junk-mailgroups and the |
659 |
|
;; group parameters |
660 |
|
(when (spam-group-spam-contents-p gnus-newsgroup-name) |
661 |
|
(gnus-message 5 "Marking %s articles as spam" |
662 |
|
(if spam-mark-only-unseen-as-spam |
663 |
|
"unseen" |
664 |
|
"unread")) |
665 |
|
(let ((articles (if spam-mark-only-unseen-as-spam |
666 |
|
gnus-newsgroup-unseen |
667 |
|
gnus-newsgroup-unreads))) |
668 |
|
(dolist (article articles) |
669 |
|
(gnus-summary-mark-article article gnus-spam-mark))))) |
670 |
|
|
671 |
|
(defun spam-mark-spam-as-expired-and-move-routine (&rest groups) |
672 |
|
(if (and (car-safe groups) (listp (car-safe groups))) |
673 |
|
(apply 'spam-mark-spam-as-expired-and-move-routine (car groups)) |
674 |
|
(gnus-summary-kill-process-mark) |
675 |
|
(let ((articles gnus-newsgroup-articles) |
676 |
|
(backend-supports-deletions |
677 |
|
(gnus-check-backend-function |
678 |
|
'request-move-article gnus-newsgroup-name)) |
679 |
|
article tomove deletep) |
680 |
|
(dolist (article articles) |
681 |
|
(when (eq (gnus-summary-article-mark article) gnus-spam-mark) |
682 |
|
(gnus-summary-mark-article article gnus-expirable-mark) |
683 |
|
(push article tomove))) |
684 |
|
|
685 |
|
;; now do the actual copies |
686 |
|
(dolist (group groups) |
687 |
|
(when (and tomove |
688 |
|
(stringp group)) |
689 |
|
(dolist (article tomove) |
690 |
|
(gnus-summary-set-process-mark article)) |
691 |
|
(when tomove |
692 |
|
(if (or (not backend-supports-deletions) |
693 |
|
(> (length groups) 1)) |
694 |
|
(progn |
695 |
|
(gnus-summary-copy-article nil group) |
696 |
|
(setq deletep t)) |
697 |
|
(gnus-summary-move-article nil group))))) |
698 |
|
|
699 |
|
;; now delete the articles, if there was a copy done, and the |
700 |
|
;; backend allows it |
701 |
|
(when (and deletep backend-supports-deletions) |
702 |
|
(dolist (article tomove) |
703 |
|
(gnus-summary-set-process-mark article)) |
704 |
|
(when tomove |
705 |
|
(let ((gnus-novice-user nil)) ; don't ask me if I'm sure |
706 |
|
(gnus-summary-delete-article nil)))) |
707 |
|
|
708 |
|
(gnus-summary-yank-process-mark)))) |
709 |
|
|
710 |
|
(defun spam-ham-copy-or-move-routine (copy groups) |
711 |
|
(gnus-summary-kill-process-mark) |
712 |
|
(let ((todo (spam-list-articles gnus-newsgroup-articles 'ham)) |
713 |
|
(backend-supports-deletions |
714 |
|
(gnus-check-backend-function |
715 |
|
'request-move-article gnus-newsgroup-name)) |
716 |
|
(respool-method (gnus-find-method-for-group gnus-newsgroup-name)) |
717 |
|
article mark todo deletep respool) |
718 |
|
|
719 |
|
(when (member 'respool groups) |
720 |
|
(setq respool t) ; boolean for later |
721 |
|
(setq groups '("fake"))) ; when respooling, groups are dynamic so fake it |
722 |
|
|
723 |
|
;; now do the actual move |
724 |
|
(dolist (group groups) |
725 |
|
(when (and todo (stringp group)) |
726 |
|
(dolist (article todo) |
727 |
|
(when spam-mark-ham-unread-before-move-from-spam-group |
728 |
|
(gnus-summary-mark-article article gnus-unread-mark)) |
729 |
|
(gnus-summary-set-process-mark article)) |
730 |
|
|
731 |
|
(if respool ; respooling is with a "fake" group |
732 |
|
(let ((spam-split-disabled |
733 |
|
(or spam-split-disabled |
734 |
|
spam-disable-spam-split-during-ham-respool))) |
735 |
|
(gnus-summary-respool-article nil respool-method)) |
736 |
|
(if (or (not backend-supports-deletions) ; else, we are not respooling |
737 |
|
(> (length groups) 1)) |
738 |
|
(progn ; if copying, copy and set deletep |
739 |
|
(gnus-summary-copy-article nil group) |
740 |
|
(setq deletep t)) |
741 |
|
(gnus-summary-move-article nil group))))) ; else move articles |
742 |
|
|
743 |
|
;; now delete the articles, unless a) copy is t, and there was a copy done |
744 |
|
;; b) a move was done to a single group |
745 |
|
;; c) backend-supports-deletions is nil |
746 |
|
(unless copy |
747 |
|
(when (and deletep backend-supports-deletions) |
748 |
|
(dolist (article todo) |
749 |
|
(gnus-summary-set-process-mark article)) |
750 |
|
(when todo |
751 |
|
(let ((gnus-novice-user nil)) ; don't ask me if I'm sure |
752 |
|
(gnus-summary-delete-article nil)))))) |
753 |
|
|
754 |
|
(gnus-summary-yank-process-mark)) |
755 |
|
|
756 |
|
(defun spam-ham-copy-routine (&rest groups) |
757 |
|
(if (and (car-safe groups) (listp (car-safe groups))) |
758 |
|
(apply 'spam-ham-copy-routine (car groups)) |
759 |
|
(spam-ham-copy-or-move-routine t groups))) |
760 |
|
|
761 |
|
(defun spam-ham-move-routine (&rest groups) |
762 |
|
(if (and (car-safe groups) (listp (car-safe groups))) |
763 |
|
(apply 'spam-ham-move-routine (car groups)) |
764 |
|
(spam-ham-copy-or-move-routine nil groups))) |
765 |
|
|
766 |
|
(eval-and-compile |
767 |
|
(defalias 'spam-point-at-eol (if (fboundp 'point-at-eol) |
768 |
|
'point-at-eol |
769 |
|
'line-end-position))) |
770 |
|
|
771 |
|
(defun spam-get-article-as-string (article) |
772 |
|
(let ((article-buffer (spam-get-article-as-buffer article)) |
773 |
|
article-string) |
774 |
|
(when article-buffer |
775 |
|
(save-window-excursion |
776 |
|
(set-buffer article-buffer) |
777 |
|
(setq article-string (buffer-string)))) |
778 |
|
article-string)) |
779 |
|
|
780 |
|
(defun spam-get-article-as-buffer (article) |
781 |
|
(let ((article-buffer)) |
782 |
|
(when (numberp article) |
783 |
|
(save-window-excursion |
784 |
|
(gnus-summary-goto-subject article) |
785 |
|
(gnus-summary-show-article t) |
786 |
|
(setq article-buffer (get-buffer gnus-article-buffer)))) |
787 |
|
article-buffer)) |
788 |
|
|
789 |
|
;; disabled for now |
790 |
|
;; (defun spam-get-article-as-filename (article) |
791 |
|
;; (let ((article-filename)) |
792 |
|
;; (when (numberp article) |
793 |
|
;; (nnml-possibly-change-directory |
794 |
|
;; (gnus-group-real-name gnus-newsgroup-name)) |
795 |
|
;; (setq article-filename (expand-file-name |
796 |
|
;; (int-to-string article) nnml-current-directory))) |
797 |
|
;; (if (file-exists-p article-filename) |
798 |
|
;; article-filename |
799 |
|
;; nil))) |
800 |
|
|
801 |
|
(defun spam-fetch-field-from-fast (article) |
802 |
|
"Fetch the `from' field quickly, using the internal gnus-data-list function" |
803 |
|
(if (and (numberp article) |
804 |
|
(assoc article (gnus-data-list nil))) |
805 |
|
(mail-header-from |
806 |
|
(gnus-data-header (assoc article (gnus-data-list nil)))) |
807 |
|
nil)) |
808 |
|
|
809 |
|
(defun spam-fetch-field-subject-fast (article) |
810 |
|
"Fetch the `subject' field quickly, using the internal |
811 |
|
gnus-data-list function" |
812 |
|
(if (and (numberp article) |
813 |
|
(assoc article (gnus-data-list nil))) |
814 |
|
(mail-header-subject |
815 |
|
(gnus-data-header (assoc article (gnus-data-list nil)))) |
816 |
|
nil)) |
817 |
|
|
818 |
|
(defun spam-fetch-field-message-id-fast (article) |
819 |
|
"Fetch the `Message-ID' field quickly, using the internal |
820 |
|
gnus-data-list function" |
821 |
|
(if (and (numberp article) |
822 |
|
(assoc article (gnus-data-list nil))) |
823 |
|
(mail-header-message-id |
824 |
|
(gnus-data-header (assoc article (gnus-data-list nil)))) |
825 |
|
nil)) |
826 |
|
|
827 |
|
|
828 |
|
;;;; Spam determination. |
829 |
|
|
830 |
|
(defvar spam-list-of-checks |
831 |
|
'((spam-use-blacklist . spam-check-blacklist) |
832 |
|
(spam-use-regex-headers . spam-check-regex-headers) |
833 |
|
(spam-use-regex-body . spam-check-regex-body) |
834 |
|
(spam-use-whitelist . spam-check-whitelist) |
835 |
|
(spam-use-BBDB . spam-check-BBDB) |
836 |
|
(spam-use-ifile . spam-check-ifile) |
837 |
|
(spam-use-spamoracle . spam-check-spamoracle) |
838 |
|
(spam-use-stat . spam-check-stat) |
839 |
|
(spam-use-blackholes . spam-check-blackholes) |
840 |
|
(spam-use-hashcash . spam-check-hashcash) |
841 |
|
(spam-use-bogofilter-headers . spam-check-bogofilter-headers) |
842 |
|
(spam-use-bogofilter . spam-check-bogofilter)) |
843 |
|
"The spam-list-of-checks list contains pairs associating a |
844 |
|
parameter variable with a spam checking function. If the |
845 |
|
parameter variable is true, then the checking function is called, |
846 |
|
and its value decides what happens. Each individual check may |
847 |
|
return nil, t, or a mailgroup name. The value nil means that the |
848 |
|
check does not yield a decision, and so, that further checks are |
849 |
|
needed. The value t means that the message is definitely not |
850 |
|
spam, and that further spam checks should be inhibited. |
851 |
|
Otherwise, a mailgroup name or the symbol 'spam (depending on |
852 |
|
spam-split-symbolic-return) is returned where the mail should go, |
853 |
|
and further checks are also inhibited. The usual mailgroup name |
854 |
|
is the value of `spam-split-group', meaning that the message is |
855 |
|
definitely a spam.") |
856 |
|
|
857 |
|
(defvar spam-list-of-statistical-checks |
858 |
|
'(spam-use-ifile |
859 |
|
spam-use-regex-body |
860 |
|
spam-use-stat |
861 |
|
spam-use-bogofilter |
862 |
|
spam-use-spamoracle) |
863 |
|
"The spam-list-of-statistical-checks list contains all the mail |
864 |
|
splitters that need to have the full message body available.") |
865 |
|
|
866 |
|
;;;TODO: modify to invoke self with each check if invoked without specifics |
867 |
|
(defun spam-split (&rest specific-checks) |
868 |
|
"Split this message into the `spam' group if it is spam. |
869 |
|
This function can be used as an entry in the variable `nnmail-split-fancy', |
870 |
|
for example like this: (: spam-split). It can take checks as |
871 |
|
parameters. A string as a parameter will set the |
872 |
|
spam-split-group to that string. |
873 |
|
|
874 |
|
See the Info node `(gnus)Fancy Mail Splitting' for more details." |
875 |
|
(interactive) |
876 |
|
(setq spam-split-last-successful-check nil) |
877 |
|
(unless spam-split-disabled |
878 |
|
(let ((spam-split-group-choice spam-split-group)) |
879 |
|
(dolist (check specific-checks) |
880 |
|
(when (stringp check) |
881 |
|
(setq spam-split-group-choice check) |
882 |
|
(setq specific-checks (delq check specific-checks)))) |
883 |
|
|
884 |
|
(let ((spam-split-group spam-split-group-choice)) |
885 |
|
(save-excursion |
886 |
|
(save-restriction |
887 |
|
(dolist (check spam-list-of-statistical-checks) |
888 |
|
(when (and (symbolp check) (symbol-value check)) |
889 |
|
(widen) |
890 |
|
(gnus-message 8 "spam-split: widening the buffer (%s requires it)" |
891 |
|
(symbol-name check)) |
892 |
|
(return))) |
893 |
|
;; (progn (widen) (debug (buffer-string))) |
894 |
|
(let ((list-of-checks spam-list-of-checks) |
895 |
|
decision) |
896 |
|
(while (and list-of-checks (not decision)) |
897 |
|
(let ((pair (pop list-of-checks))) |
898 |
|
(when (and (symbol-value (car pair)) |
899 |
|
(or (null specific-checks) |
900 |
|
(memq (car pair) specific-checks))) |
901 |
|
(gnus-message 5 "spam-split: calling the %s function" |
902 |
|
(symbol-name (cdr pair))) |
903 |
|
(setq decision (funcall (cdr pair))) |
904 |
|
;; if we got a decision at all, save the current check |
905 |
|
(when decision |
906 |
|
(setq spam-split-last-successful-check (car pair))) |
907 |
|
|
908 |
|
(when (eq decision 'spam) |
909 |
|
(if spam-split-symbolic-return |
910 |
|
(setq decision spam-split-group) |
911 |
|
(gnus-error |
912 |
|
5 |
913 |
|
(format "spam-split got %s but %s is nil" |
914 |
|
(symbol-name decision) |
915 |
|
(symbol-name spam-split-symbolic-return)))))))) |
916 |
|
(if (eq decision t) |
917 |
|
(if spam-split-symbolic-return-positive 'ham nil) |
918 |
|
decision)))))))) |
919 |
|
|
920 |
|
(defun spam-find-spam () |
921 |
|
"This function will detect spam in the current newsgroup using spam-split." |
922 |
|
(interactive) |
923 |
|
|
924 |
|
(let* ((group gnus-newsgroup-name) |
925 |
|
(autodetect (gnus-parameter-spam-autodetect group)) |
926 |
|
(methods (gnus-parameter-spam-autodetect-methods group)) |
927 |
|
(first-method (nth 0 methods))) |
928 |
|
(when (and autodetect |
929 |
|
(not (equal first-method 'none))) |
930 |
|
(mapcar |
931 |
|
(lambda (article) |
932 |
|
(let ((id (spam-fetch-field-message-id-fast article)) |
933 |
|
(subject (spam-fetch-field-subject-fast article)) |
934 |
|
(sender (spam-fetch-field-from-fast article))) |
935 |
|
(unless (and spam-log-to-registry |
936 |
|
(spam-log-registered-p id 'incoming)) |
937 |
|
(let* ((spam-split-symbolic-return t) |
938 |
|
(spam-split-symbolic-return-positive t) |
939 |
|
(split-return |
940 |
|
(with-temp-buffer |
941 |
|
(gnus-request-article-this-buffer |
942 |
|
article |
943 |
|
group) |
944 |
|
(if (or (null first-method) |
945 |
|
(equal first-method 'default)) |
946 |
|
(spam-split) |
947 |
|
(apply 'spam-split methods))))) |
948 |
|
(if (equal split-return 'spam) |
949 |
|
(gnus-summary-mark-article article gnus-spam-mark)) |
950 |
|
|
951 |
|
(when (and split-return spam-log-to-registry) |
952 |
|
(when (zerop (gnus-registry-group-count id)) |
953 |
|
(gnus-registry-add-group |
954 |
|
id group subject sender)) |
955 |
|
|
956 |
|
(spam-log-processing-to-registry |
957 |
|
id |
958 |
|
'incoming |
959 |
|
split-return |
960 |
|
spam-split-last-successful-check |
961 |
|
group)))))) |
962 |
|
(if spam-autodetect-recheck-messages |
963 |
|
gnus-newsgroup-articles |
964 |
|
gnus-newsgroup-unseen))))) |
965 |
|
|
966 |
|
(defvar spam-registration-functions |
967 |
|
;; first the ham register, second the spam register function |
968 |
|
;; third the ham unregister, fourth the spam unregister function |
969 |
|
'((spam-use-blacklist nil |
970 |
|
spam-blacklist-register-routine |
971 |
|
nil |
972 |
|
spam-blacklist-unregister-routine) |
973 |
|
(spam-use-whitelist spam-whitelist-register-routine |
974 |
|
nil |
975 |
|
spam-whitelist-unregister-routine |
976 |
|
nil) |
977 |
|
(spam-use-BBDB spam-BBDB-register-routine |
978 |
|
nil |
979 |
|
spam-BBDB-unregister-routine |
980 |
|
nil) |
981 |
|
(spam-use-ifile spam-ifile-register-ham-routine |
982 |
|
spam-ifile-register-spam-routine |
983 |
|
spam-ifile-unregister-ham-routine |
984 |
|
spam-ifile-unregister-spam-routine) |
985 |
|
(spam-use-spamoracle spam-spamoracle-learn-ham |
986 |
|
spam-spamoracle-learn-spam |
987 |
|
spam-spamoracle-unlearn-ham |
988 |
|
spam-spamoracle-unlearn-spam) |
989 |
|
(spam-use-stat spam-stat-register-ham-routine |
990 |
|
spam-stat-register-spam-routine |
991 |
|
spam-stat-unregister-ham-routine |
992 |
|
spam-stat-unregister-spam-routine) |
993 |
|
;; note that spam-use-gmane is not a legitimate check |
994 |
|
(spam-use-gmane nil |
995 |
|
spam-report-gmane-register-routine |
996 |
|
;; does Gmane support unregistration? |
997 |
|
nil |
998 |
|
nil) |
999 |
|
(spam-use-bogofilter spam-bogofilter-register-ham-routine |
1000 |
|
spam-bogofilter-register-spam-routine |
1001 |
|
spam-bogofilter-unregister-ham-routine |
1002 |
|
spam-bogofilter-unregister-spam-routine)) |
1003 |
|
"The spam-registration-functions list contains pairs |
1004 |
|
associating a parameter variable with the ham and spam |
1005 |
|
registration functions, and the ham and spam unregistration |
1006 |
|
functions") |
1007 |
|
|
1008 |
|
(defun spam-classification-valid-p (classification) |
1009 |
|
(or (eq classification 'spam) |
1010 |
|
(eq classification 'ham))) |
1011 |
|
|
1012 |
|
(defun spam-process-type-valid-p (process-type) |
1013 |
|
(or (eq process-type 'incoming) |
1014 |
|
(eq process-type 'process))) |
1015 |
|
|
1016 |
|
(defun spam-registration-check-valid-p (check) |
1017 |
|
(assoc check spam-registration-functions)) |
1018 |
|
|
1019 |
|
(defun spam-unregistration-check-valid-p (check) |
1020 |
|
(assoc check spam-registration-functions)) |
1021 |
|
|
1022 |
|
(defun spam-registration-function (classification check) |
1023 |
|
(let ((flist (cdr-safe (assoc check spam-registration-functions)))) |
1024 |
|
(if (eq classification 'spam) |
1025 |
|
(nth 1 flist) |
1026 |
|
(nth 0 flist)))) |
1027 |
|
|
1028 |
|
(defun spam-unregistration-function (classification check) |
1029 |
|
(let ((flist (cdr-safe (assoc check spam-registration-functions)))) |
1030 |
|
(if (eq classification 'spam) |
1031 |
|
(nth 3 flist) |
1032 |
|
(nth 2 flist)))) |
1033 |
|
|
1034 |
|
(defun spam-list-articles (articles classification) |
1035 |
|
(let ((mark-check (if (eq classification 'spam) |
1036 |
|
'spam-group-spam-mark-p |
1037 |
|
'spam-group-ham-mark-p)) |
1038 |
|
list mark-cache-yes mark-cache-no) |
1039 |
|
(dolist (article articles) |
1040 |
|
(let ((mark (gnus-summary-article-mark article))) |
1041 |
|
(unless (memq mark mark-cache-no) |
1042 |
|
(if (memq mark mark-cache-yes) |
1043 |
|
(push article list) |
1044 |
|
;; else, we have to actually check the mark |
1045 |
|
(if (funcall mark-check |
1046 |
|
gnus-newsgroup-name |
1047 |
|
mark) |
1048 |
|
(progn |
1049 |
|
(push article list) |
1050 |
|
(push mark mark-cache-yes)) |
1051 |
|
(push mark mark-cache-no)))))) |
1052 |
|
list)) |
1053 |
|
|
1054 |
|
(defun spam-register-routine (classification |
1055 |
|
check |
1056 |
|
&optional unregister |
1057 |
|
specific-articles) |
1058 |
|
(when (and (spam-classification-valid-p classification) |
1059 |
|
(spam-registration-check-valid-p check)) |
1060 |
|
(let* ((register-function |
1061 |
|
(spam-registration-function classification check)) |
1062 |
|
(unregister-function |
1063 |
|
(spam-unregistration-function classification check)) |
1064 |
|
(run-function (if unregister |
1065 |
|
unregister-function |
1066 |
|
register-function)) |
1067 |
|
(log-function (if unregister |
1068 |
|
'spam-log-undo-registration |
1069 |
|
'spam-log-processing-to-registry)) |
1070 |
|
article articles) |
1071 |
|
|
1072 |
|
(when run-function |
1073 |
|
;; make list of articles, using specific-articles if given |
1074 |
|
(setq articles (or specific-articles |
1075 |
|
(spam-list-articles |
1076 |
|
gnus-newsgroup-articles |
1077 |
|
classification))) |
1078 |
|
;; process them |
1079 |
|
(gnus-message 5 "%s %d %s articles with classification %s, check %s" |
1080 |
|
(if unregister "Unregistering" "Registering") |
1081 |
|
(length articles) |
1082 |
|
(if specific-articles "specific" "") |
1083 |
|
(symbol-name classification) |
1084 |
|
(symbol-name check)) |
1085 |
|
(funcall run-function articles) |
1086 |
|
;; now log all the registrations (or undo them, depending on unregister) |
1087 |
|
(dolist (article articles) |
1088 |
|
(funcall log-function |
1089 |
|
(spam-fetch-field-message-id-fast article) |
1090 |
|
'process |
1091 |
|
classification |
1092 |
|
check |
1093 |
|
gnus-newsgroup-name)))))) |
1094 |
|
|
1095 |
|
;;; log a ham- or spam-processor invocation to the registry |
1096 |
|
(defun spam-log-processing-to-registry (id type classification check group) |
1097 |
|
(when spam-log-to-registry |
1098 |
|
(if (and (stringp id) |
1099 |
|
(stringp group) |
1100 |
|
(spam-process-type-valid-p type) |
1101 |
|
(spam-classification-valid-p classification) |
1102 |
|
(spam-registration-check-valid-p check)) |
1103 |
|
(let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) |
1104 |
|
(cell (list classification check group))) |
1105 |
|
(push cell cell-list) |
1106 |
|
(gnus-registry-store-extra-entry |
1107 |
|
id |
1108 |
|
type |
1109 |
|
cell-list)) |
1110 |
|
|
1111 |
|
(gnus-message 5 (format "%s called with bad ID, type, classification, check, or group" |
1112 |
|
"spam-log-processing-to-registry"))))) |
1113 |
|
|
1114 |
|
;;; check if a ham- or spam-processor registration has been done |
1115 |
|
(defun spam-log-registered-p (id type) |
1116 |
|
(when spam-log-to-registry |
1117 |
|
(if (and (stringp id) |
1118 |
|
(spam-process-type-valid-p type)) |
1119 |
|
(cdr-safe (gnus-registry-fetch-extra id type)) |
1120 |
|
(progn |
1121 |
|
(gnus-message 5 (format "%s called with bad ID, type, classification, or check" |
1122 |
|
"spam-log-registered-p")) |
1123 |
|
nil)))) |
1124 |
|
|
1125 |
|
;;; check if a ham- or spam-processor registration needs to be undone |
1126 |
|
(defun spam-log-unregistration-needed-p (id type classification check) |
1127 |
|
(when spam-log-to-registry |
1128 |
|
(if (and (stringp id) |
1129 |
|
(spam-process-type-valid-p type) |
1130 |
|
(spam-classification-valid-p classification) |
1131 |
|
(spam-registration-check-valid-p check)) |
1132 |
|
(let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) |
1133 |
|
found) |
1134 |
|
(dolist (cell cell-list) |
1135 |
|
(unless found |
1136 |
|
(when (and (eq classification (nth 0 cell)) |
1137 |
|
(eq check (nth 1 cell))) |
1138 |
|
(setq found t)))) |
1139 |
|
found) |
1140 |
|
(progn |
1141 |
|
(gnus-message 5 (format "%s called with bad ID, type, classification, or check" |
1142 |
|
"spam-log-unregistration-needed-p")) |
1143 |
|
nil)))) |
1144 |
|
|
1145 |
|
|
1146 |
|
;;; undo a ham- or spam-processor registration (the group is not used) |
1147 |
|
(defun spam-log-undo-registration (id type classification check &optional group) |
1148 |
|
(when (and spam-log-to-registry |
1149 |
|
(spam-log-unregistration-needed-p id type classification check)) |
1150 |
|
(if (and (stringp id) |
1151 |
|
(spam-process-type-valid-p type) |
1152 |
|
(spam-classification-valid-p classification) |
1153 |
|
(spam-registration-check-valid-p check)) |
1154 |
|
(let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) |
1155 |
|
new-cell-list found) |
1156 |
|
(dolist (cell cell-list) |
1157 |
|
(unless (and (eq classification (nth 0 cell)) |
1158 |
|
(eq check (nth 1 cell))) |
1159 |
|
(push cell new-cell-list))) |
1160 |
|
(gnus-registry-store-extra-entry |
1161 |
|
id |
1162 |
|
type |
1163 |
|
new-cell-list)) |
1164 |
|
(progn |
1165 |
|
(gnus-message 5 (format "%s called with bad ID, type, check, or group" |
1166 |
|
"spam-log-undo-registration")) |
1167 |
|
nil)))) |
1168 |
|
|
1169 |
|
;;; set up IMAP widening if it's necessary |
1170 |
|
(defun spam-setup-widening () |
1171 |
|
(dolist (check spam-list-of-statistical-checks) |
1172 |
|
(when (symbol-value check) |
1173 |
|
(setq nnimap-split-download-body-default t)))) |
1174 |
|
|
1175 |
|
|
1176 |
|
;;;; Regex body |
1177 |
|
|
1178 |
|
(defun spam-check-regex-body () |
1179 |
|
(let ((spam-regex-headers-ham spam-regex-body-ham) |
1180 |
|
(spam-regex-headers-spam spam-regex-body-spam)) |
1181 |
|
(spam-check-regex-headers t))) |
1182 |
|
|
1183 |
|
|
1184 |
|
;;;; Regex headers |
1185 |
|
|
1186 |
|
(defun spam-check-regex-headers (&optional body) |
1187 |
|
(let ((type (if body "body" "header")) |
1188 |
|
(spam-split-group (if spam-split-symbolic-return |
1189 |
|
'spam |
1190 |
|
spam-split-group)) |
1191 |
|
ret found) |
1192 |
|
(dolist (h-regex spam-regex-headers-ham) |
1193 |
|
(unless found |
1194 |
|
(goto-char (point-min)) |
1195 |
|
(when (re-search-forward h-regex nil t) |
1196 |
|
(message "Ham regex %s search positive." type) |
1197 |
|
(setq found t)))) |
1198 |
|
(dolist (s-regex spam-regex-headers-spam) |
1199 |
|
(unless found |
1200 |
|
(goto-char (point-min)) |
1201 |
|
(when (re-search-forward s-regex nil t) |
1202 |
|
(message "Spam regex %s search positive." type) |
1203 |
|
(setq found t) |
1204 |
|
(setq ret spam-split-group)))) |
1205 |
|
ret)) |
1206 |
|
|
1207 |
|
|
1208 |
|
;;;; Blackholes. |
1209 |
|
|
1210 |
|
(defun spam-reverse-ip-string (ip) |
1211 |
|
(when (stringp ip) |
1212 |
|
(mapconcat 'identity |
1213 |
|
(nreverse (split-string ip "\\.")) |
1214 |
|
"."))) |
1215 |
|
|
1216 |
|
(defun spam-check-blackholes () |
1217 |
|
"Check the Received headers for blackholed relays." |
1218 |
|
(let ((headers (nnmail-fetch-field "received")) |
1219 |
|
(spam-split-group (if spam-split-symbolic-return |
1220 |
|
'spam |
1221 |
|
spam-split-group)) |
1222 |
|
ips matches) |
1223 |
|
(when headers |
1224 |
|
(with-temp-buffer |
1225 |
|
(insert headers) |
1226 |
|
(goto-char (point-min)) |
1227 |
|
(gnus-message 5 "Checking headers for relay addresses") |
1228 |
|
(while (re-search-forward |
1229 |
|
"\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) |
1230 |
|
(gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) |
1231 |
|
(push (spam-reverse-ip-string (match-string 1)) |
1232 |
|
ips))) |
1233 |
|
(dolist (server spam-blackhole-servers) |
1234 |
|
(dolist (ip ips) |
1235 |
|
(unless (and spam-blackhole-good-server-regex |
1236 |
|
;; match the good-server-regex against the reversed (again) IP string |
1237 |
|
(string-match |
1238 |
|
spam-blackhole-good-server-regex |
1239 |
|
(spam-reverse-ip-string ip))) |
1240 |
|
(unless matches |
1241 |
|
(let ((query-string (concat ip "." server))) |
1242 |
|
(if spam-use-dig |
1243 |
|
(let ((query-result (query-dig query-string))) |
1244 |
|
(when query-result |
1245 |
|
(gnus-message 5 "(DIG): positive blackhole check '%s'" |
1246 |
|
query-result) |
1247 |
|
(push (list ip server query-result) |
1248 |
|
matches))) |
1249 |
|
;; else, if not using dig.el |
1250 |
|
(when (query-dns query-string) |
1251 |
|
(gnus-message 5 "positive blackhole check") |
1252 |
|
(push (list ip server (query-dns query-string 'TXT)) |
1253 |
|
matches))))))))) |
1254 |
|
(when matches |
1255 |
|
spam-split-group))) |
1256 |
|
|
1257 |
|
;;;; Hashcash. |
1258 |
|
|
1259 |
|
(condition-case nil |
1260 |
|
(progn |
1261 |
|
(require 'hashcash) |
1262 |
|
|
1263 |
|
(defun spam-check-hashcash () |
1264 |
|
"Check the headers for hashcash payments." |
1265 |
|
(mail-check-payment))) ;mail-check-payment returns a boolean |
1266 |
|
|
1267 |
|
(file-error (progn |
1268 |
|
(defalias 'mail-check-payment 'ignore) |
1269 |
|
(defalias 'spam-check-hashcash 'ignore)))) |
1270 |
|
|
1271 |
|
;;;; BBDB |
1272 |
|
|
1273 |
|
;;; original idea for spam-check-BBDB from Alexander Kotelnikov |
1274 |
|
;;; <sacha@giotto.sj.ru> |
1275 |
|
|
1276 |
|
;; all this is done inside a condition-case to trap errors |
1277 |
|
|
1278 |
|
(condition-case nil |
1279 |
|
(progn |
1280 |
|
(require 'bbdb) |
1281 |
|
(require 'bbdb-com) |
1282 |
|
|
1283 |
|
(defun spam-enter-ham-BBDB (addresses &optional remove) |
1284 |
|
"Enter an address into the BBDB; implies ham (non-spam) sender" |
1285 |
|
(dolist (from addresses) |
1286 |
|
(when (stringp from) |
1287 |
|
(let* ((parsed-address (gnus-extract-address-components from)) |
1288 |
|
(name (or (nth 0 parsed-address) "Ham Sender")) |
1289 |
|
(remove-function (if remove |
1290 |
|
'bbdb-delete-record-internal |
1291 |
|
'ignore)) |
1292 |
|
(net-address (nth 1 parsed-address)) |
1293 |
|
(record (and net-address |
1294 |
|
(bbdb-search-simple nil net-address)))) |
1295 |
|
(when net-address |
1296 |
|
(gnus-message 5 "%s address %s %s BBDB" |
1297 |
|
(if remove "Deleting" "Adding") |
1298 |
|
from |
1299 |
|
(if remove "from" "to")) |
1300 |
|
(if record |
1301 |
|
(funcall remove-function record) |
1302 |
|
(bbdb-create-internal name nil net-address nil nil |
1303 |
|
"ham sender added by spam.el"))))))) |
1304 |
|
|
1305 |
|
(defun spam-BBDB-register-routine (articles &optional unregister) |
1306 |
|
(let (addresses) |
1307 |
|
(dolist (article articles) |
1308 |
|
(when (stringp (spam-fetch-field-from-fast article)) |
1309 |
|
(push (spam-fetch-field-from-fast article) addresses))) |
1310 |
|
;; now do the register/unregister action |
1311 |
|
(spam-enter-ham-BBDB addresses unregister))) |
1312 |
|
|
1313 |
|
(defun spam-BBDB-unregister-routine (articles) |
1314 |
|
(spam-BBDB-register-routine articles t)) |
1315 |
|
|
1316 |
|
(defun spam-check-BBDB () |
1317 |
|
"Mail from people in the BBDB is classified as ham or non-spam" |
1318 |
|
(let ((who (nnmail-fetch-field "from")) |
1319 |
|
(spam-split-group (if spam-split-symbolic-return |
1320 |
|
'spam |
1321 |
|
spam-split-group))) |
1322 |
|
(when who |
1323 |
|
(setq who (nth 1 (gnus-extract-address-components who))) |
1324 |
|
(if (bbdb-search-simple nil who) |
1325 |
|
t |
1326 |
|
(if spam-use-BBDB-exclusive |
1327 |
|
spam-split-group |
1328 |
|
nil)))))) |
1329 |
|
|
1330 |
|
(file-error (progn |
1331 |
|
(defalias 'bbdb-search-simple 'ignore) |
1332 |
|
(defalias 'spam-check-BBDB 'ignore) |
1333 |
|
(defalias 'spam-BBDB-register-routine 'ignore) |
1334 |
|
(defalias 'spam-enter-ham-BBDB 'ignore) |
1335 |
|
(defalias 'bbdb-create-internal 'ignore) |
1336 |
|
(defalias 'bbdb-delete-record-internal 'ignore) |
1337 |
|
(defalias 'bbdb-records 'ignore)))) |
1338 |
|
|
1339 |
|
|
1340 |
|
;;;; ifile |
1341 |
|
|
1342 |
|
;;; check the ifile backend; return nil if the mail was NOT classified |
1343 |
|
;;; as spam |
1344 |
|
|
1345 |
|
(defun spam-get-ifile-database-parameter () |
1346 |
|
"Get the command-line parameter for ifile's database from |
1347 |
|
spam-ifile-database-path." |
1348 |
|
(if spam-ifile-database-path |
1349 |
|
(format "--db-file=%s" spam-ifile-database-path) |
1350 |
|
nil)) |
1351 |
|
|
1352 |
|
(defun spam-check-ifile () |
1353 |
|
"Check the ifile backend for the classification of this message." |
1354 |
|
(let ((article-buffer-name (buffer-name)) |
1355 |
|
(spam-split-group (if spam-split-symbolic-return |
1356 |
|
'spam |
1357 |
|
spam-split-group)) |
1358 |
|
category return) |
1359 |
|
(with-temp-buffer |
1360 |
|
(let ((temp-buffer-name (buffer-name)) |
1361 |
|
(db-param (spam-get-ifile-database-parameter))) |
1362 |
|
(save-excursion |
1363 |
|
(set-buffer article-buffer-name) |
1364 |
|
(apply 'call-process-region |
1365 |
|
(point-min) (point-max) spam-ifile-path |
1366 |
|
nil temp-buffer-name nil "-c" |
1367 |
|
(if db-param `(,db-param "-q") `("-q")))) |
1368 |
|
;; check the return now (we're back in the temp buffer) |
1369 |
|
(goto-char (point-min)) |
1370 |
|
(if (not (eobp)) |
1371 |
|
(setq category (buffer-substring (point) (spam-point-at-eol)))) |
1372 |
|
(when (not (zerop (length category))) ; we need a category here |
1373 |
|
(if spam-ifile-all-categories |
1374 |
|
(setq return category) |
1375 |
|
;; else, if spam-ifile-all-categories is not set... |
1376 |
|
(when (string-equal spam-ifile-spam-category category) |
1377 |
|
(setq return spam-split-group)))))) ; note return is nil otherwise |
1378 |
|
return)) |
1379 |
|
|
1380 |
|
(defun spam-ifile-register-with-ifile (articles category &optional unregister) |
1381 |
|
"Register an article, given as a string, with a category. |
1382 |
|
Uses `gnus-newsgroup-name' if category is nil (for ham registration)." |
1383 |
|
(let ((category (or category gnus-newsgroup-name)) |
1384 |
|
(add-or-delete-option (if unregister "-d" "-i")) |
1385 |
|
(db (spam-get-ifile-database-parameter)) |
1386 |
|
parameters) |
1387 |
|
(with-temp-buffer |
1388 |
|
(dolist (article articles) |
1389 |
|
(let ((article-string (spam-get-article-as-string article))) |
1390 |
|
(when (stringp article-string) |
1391 |
|
(insert article-string)))) |
1392 |
|
(apply 'call-process-region |
1393 |
|
(point-min) (point-max) spam-ifile-path |
1394 |
|
nil nil nil |
1395 |
|
add-or-delete-option category |
1396 |
|
(if db `(,db "-h") `("-h")))))) |
1397 |
|
|
1398 |
|
(defun spam-ifile-register-spam-routine (articles &optional unregister) |
1399 |
|
(spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister)) |
1400 |
|
|
1401 |
|
(defun spam-ifile-unregister-spam-routine (articles) |
1402 |
|
(spam-ifile-register-spam-routine articles t)) |
1403 |
|
|
1404 |
|
(defun spam-ifile-register-ham-routine (articles &optional unregister) |
1405 |
|
(spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister)) |
1406 |
|
|
1407 |
|
(defun spam-ifile-unregister-ham-routine (articles) |
1408 |
|
(spam-ifile-register-ham-routine articles t)) |
1409 |
|
|
1410 |
|
|
1411 |
|
;;;; spam-stat |
1412 |
|
|
1413 |
|
(condition-case nil |
1414 |
|
(progn |
1415 |
|
(let ((spam-stat-install-hooks nil)) |
1416 |
|
(require 'spam-stat)) |
1417 |
|
|
1418 |
|
(defun spam-check-stat () |
1419 |
|
"Check the spam-stat backend for the classification of this message" |
1420 |
|
(let ((spam-split-group (if spam-split-symbolic-return |
1421 |
|
'spam |
1422 |
|
spam-split-group)) |
1423 |
|
(spam-stat-split-fancy-spam-group spam-split-group) ; override |
1424 |
|
(spam-stat-buffer (buffer-name)) ; stat the current buffer |
1425 |
|
category return) |
1426 |
|
(spam-stat-split-fancy))) |
1427 |
|
|
1428 |
|
(defun spam-stat-register-spam-routine (articles &optional unregister) |
1429 |
|
(dolist (article articles) |
1430 |
|
(let ((article-string (spam-get-article-as-string article))) |
1431 |
|
(with-temp-buffer |
1432 |
|
(insert article-string) |
1433 |
|
(if unregister |
1434 |
|
(spam-stat-buffer-change-to-non-spam) |
1435 |
|
(spam-stat-buffer-is-spam)))))) |
1436 |
|
|
1437 |
|
(defun spam-stat-unregister-spam-routine (articles) |
1438 |
|
(spam-stat-register-spam-routine articles t)) |
1439 |
|
|
1440 |
|
(defun spam-stat-register-ham-routine (articles &optional unregister) |
1441 |
|
(dolist (article articles) |
1442 |
|
(let ((article-string (spam-get-article-as-string article))) |
1443 |
|
(with-temp-buffer |
1444 |
|
(insert article-string) |
1445 |
|
(if unregister |
1446 |
|
(spam-stat-buffer-change-to-spam) |
1447 |
|
(spam-stat-buffer-is-non-spam)))))) |
1448 |
|
|
1449 |
|
(defun spam-stat-unregister-ham-routine (articles) |
1450 |
|
(spam-stat-register-ham-routine articles t)) |
1451 |
|
|
1452 |
|
(defun spam-maybe-spam-stat-load () |
1453 |
|
(when spam-use-stat (spam-stat-load))) |
1454 |
|
|
1455 |
|
(defun spam-maybe-spam-stat-save () |
1456 |
|
(when spam-use-stat (spam-stat-save)))) |
1457 |
|
|
1458 |
|
(file-error (progn |
1459 |
|
(defalias 'spam-stat-load 'ignore) |
1460 |
|
(defalias 'spam-stat-save 'ignore) |
1461 |
|
(defalias 'spam-maybe-spam-stat-load 'ignore) |
1462 |
|
(defalias 'spam-maybe-spam-stat-save 'ignore) |
1463 |
|
(defalias 'spam-stat-register-ham-routine 'ignore) |
1464 |
|
(defalias 'spam-stat-unregister-ham-routine 'ignore) |
1465 |
|
(defalias 'spam-stat-register-spam-routine 'ignore) |
1466 |
|
(defalias 'spam-stat-unregister-spam-routine 'ignore) |
1467 |
|
(defalias 'spam-stat-buffer-is-spam 'ignore) |
1468 |
|
(defalias 'spam-stat-buffer-change-to-spam 'ignore) |
1469 |
|
(defalias 'spam-stat-buffer-is-non-spam 'ignore) |
1470 |
|
(defalias 'spam-stat-buffer-change-to-non-spam 'ignore) |
1471 |
|
(defalias 'spam-stat-split-fancy 'ignore) |
1472 |
|
(defalias 'spam-check-stat 'ignore)))) |
1473 |
|
|
1474 |
|
|
1475 |
|
|
1476 |
|
;;;; Blacklists and whitelists. |
1477 |
|
|
1478 |
|
(defvar spam-whitelist-cache nil) |
1479 |
|
(defvar spam-blacklist-cache nil) |
1480 |
|
|
1481 |
|
(defun spam-kill-whole-line () |
1482 |
|
(beginning-of-line) |
1483 |
|
(let ((kill-whole-line t)) |
1484 |
|
(kill-line))) |
1485 |
|
|
1486 |
|
;;; address can be a list, too |
1487 |
|
(defun spam-enter-whitelist (address &optional remove) |
1488 |
|
"Enter ADDRESS (list or single) into the whitelist. |
1489 |
|
With a non-nil REMOVE, remove them." |
1490 |
|
(interactive "sAddress: ") |
1491 |
|
(spam-enter-list address spam-whitelist remove) |
1492 |
|
(setq spam-whitelist-cache nil)) |
1493 |
|
|
1494 |
|
;;; address can be a list, too |
1495 |
|
(defun spam-enter-blacklist (address &optional remove) |
1496 |
|
"Enter ADDRESS (list or single) into the blacklist. |
1497 |
|
With a non-nil REMOVE, remove them." |
1498 |
|
(interactive "sAddress: ") |
1499 |
|
(spam-enter-list address spam-blacklist remove) |
1500 |
|
(setq spam-blacklist-cache nil)) |
1501 |
|
|
1502 |
|
(defun spam-enter-list (addresses file &optional remove) |
1503 |
|
"Enter ADDRESSES into the given FILE. |
1504 |
|
Either the whitelist or the blacklist files can be used. With |
1505 |
|
REMOVE not nil, remove the ADDRESSES." |
1506 |
|
(if (stringp addresses) |
1507 |
|
(spam-enter-list (list addresses) file remove) |
1508 |
|
;; else, we have a list of addresses here |
1509 |
|
(unless (file-exists-p (file-name-directory file)) |
1510 |
|
(make-directory (file-name-directory file) t)) |
1511 |
|
(save-excursion |
1512 |
|
(set-buffer |
1513 |
|
(find-file-noselect file)) |
1514 |
|
(dolist (a addresses) |
1515 |
|
(when (stringp a) |
1516 |
|
(goto-char (point-min)) |
1517 |
|
(if (re-search-forward (regexp-quote a) nil t) |
1518 |
|
;; found the address |
1519 |
|
(when remove |
1520 |
|
(spam-kill-whole-line)) |
1521 |
|
;; else, the address was not found |
1522 |
|
(unless remove |
1523 |
|
(goto-char (point-max)) |
1524 |
|
(unless (bobp) |
1525 |
|
(insert "\n")) |
1526 |
|
(insert a "\n"))))) |
1527 |
|
(save-buffer)))) |
1528 |
|
|
1529 |
|
;;; returns t if the sender is in the whitelist, nil or |
1530 |
|
;;; spam-split-group otherwise |
1531 |
|
(defun spam-check-whitelist () |
1532 |
|
;; FIXME! Should it detect when file timestamps change? |
1533 |
|
(let ((spam-split-group (if spam-split-symbolic-return |
1534 |
|
'spam |
1535 |
|
spam-split-group))) |
1536 |
|
(unless spam-whitelist-cache |
1537 |
|
(setq spam-whitelist-cache (spam-parse-list spam-whitelist))) |
1538 |
|
(if (spam-from-listed-p spam-whitelist-cache) |
1539 |
|
t |
1540 |
|
(if spam-use-whitelist-exclusive |
1541 |
|
spam-split-group |
1542 |
|
nil)))) |
1543 |
|
|
1544 |
|
(defun spam-check-blacklist () |
1545 |
|
;; FIXME! Should it detect when file timestamps change? |
1546 |
|
(let ((spam-split-group (if spam-split-symbolic-return |
1547 |
|
'spam |
1548 |
|
spam-split-group))) |
1549 |
|
(unless spam-blacklist-cache |
1550 |
|
(setq spam-blacklist-cache (spam-parse-list spam-blacklist))) |
1551 |
|
(and (spam-from-listed-p spam-blacklist-cache) spam-split-group))) |
1552 |
|
|
1553 |
|
(defun spam-parse-list (file) |
1554 |
|
(when (file-readable-p file) |
1555 |
|
(let (contents address) |
1556 |
|
(with-temp-buffer |
1557 |
|
(insert-file-contents file) |
1558 |
|
(while (not (eobp)) |
1559 |
|
(setq address (buffer-substring (point) (spam-point-at-eol))) |
1560 |
|
(forward-line 1) |
1561 |
|
;; insert the e-mail address if detected, otherwise the raw data |
1562 |
|
(unless (zerop (length address)) |
1563 |
|
(let ((pure-address (nth 1 (gnus-extract-address-components address)))) |
1564 |
|
(push (or pure-address address) contents))))) |
1565 |
|
(nreverse contents)))) |
1566 |
|
|
1567 |
|
(defun spam-from-listed-p (cache) |
1568 |
|
(let ((from (nnmail-fetch-field "from")) |
1569 |
|
found) |
1570 |
|
(while cache |
1571 |
|
(let ((address (pop cache))) |
1572 |
|
(unless (zerop (length address)) ; 0 for a nil address too |
1573 |
|
(setq address (regexp-quote address)) |
1574 |
|
;; fix regexp-quote's treatment of user-intended regexes |
1575 |
|
(while (string-match "\\\\\\*" address) |
1576 |
|
(setq address (replace-match ".*" t t address)))) |
1577 |
|
(when (and address (string-match address from)) |
1578 |
|
(setq found t |
1579 |
|
cache nil)))) |
1580 |
|
found)) |
1581 |
|
|
1582 |
|
(defun spam-filelist-register-routine (articles blacklist &optional unregister) |
1583 |
|
(let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) |
1584 |
|
(declassification (if blacklist 'ham 'spam)) |
1585 |
|
(enter-function |
1586 |
|
(if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) |
1587 |
|
(remove-function |
1588 |
|
(if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) |
1589 |
|
from addresses unregister-list) |
1590 |
|
(dolist (article articles) |
1591 |
|
(let ((from (spam-fetch-field-from-fast article)) |
1592 |
|
(id (spam-fetch-field-message-id-fast article)) |
1593 |
|
sender-ignored) |
1594 |
|
(when (stringp from) |
1595 |
|
(dolist (ignore-regex spam-blacklist-ignored-regexes) |
1596 |
|
(when (and (not sender-ignored) |
1597 |
|
(stringp ignore-regex) |
1598 |
|
(string-match ignore-regex from)) |
1599 |
|
(setq sender-ignored t))) |
1600 |
|
;; remember the messages we need to unregister, unless remove is set |
1601 |
|
(when (and |
1602 |
|
(null unregister) |
1603 |
|
(spam-log-unregistration-needed-p |
1604 |
|
id 'process declassification de-symbol)) |
1605 |
|
(push from unregister-list)) |
1606 |
|
(unless sender-ignored |
1607 |
|
(push from addresses))))) |
1608 |
|
|
1609 |
|
(if unregister |
1610 |
|
(funcall enter-function addresses t) ; unregister all these addresses |
1611 |
|
;; else, register normally and unregister what we need to |
1612 |
|
(funcall remove-function unregister-list t) |
1613 |
|
(dolist (article unregister-list) |
1614 |
|
(spam-log-undo-registration |
1615 |
|
(spam-fetch-field-message-id-fast article) |
1616 |
|
'process |
1617 |
|
declassification |
1618 |
|
de-symbol)) |
1619 |
|
(funcall enter-function addresses nil)))) |
1620 |
|
|
1621 |
|
(defun spam-blacklist-unregister-routine (articles) |
1622 |
|
(spam-blacklist-register-routine articles t)) |
1623 |
|
|
1624 |
|
(defun spam-blacklist-register-routine (articles &optional unregister) |
1625 |
|
(spam-filelist-register-routine articles t unregister)) |
1626 |
|
|
1627 |
|
(defun spam-whitelist-unregister-routine (articles) |
1628 |
|
(spam-whitelist-register-routine articles t)) |
1629 |
|
|
1630 |
|
(defun spam-whitelist-register-routine (articles &optional unregister) |
1631 |
|
(spam-filelist-register-routine articles nil unregister)) |
1632 |
|
|
1633 |
|
|
1634 |
|
;;;; Spam-report glue |
1635 |
|
(defun spam-report-gmane-register-routine (articles) |
1636 |
|
(when articles |
1637 |
|
(apply 'spam-report-gmane articles))) |
1638 |
|
|
1639 |
|
|
1640 |
|
;;;; Bogofilter |
1641 |
|
(defun spam-check-bogofilter-headers (&optional score) |
1642 |
|
(let ((header (nnmail-fetch-field spam-bogofilter-header)) |
1643 |
|
(spam-split-group (if spam-split-symbolic-return |
1644 |
|
'spam |
1645 |
|
spam-split-group))) |
1646 |
|
(when header ; return nil when no header |
1647 |
|
(if score ; scoring mode |
1648 |
|
(if (string-match "spamicity=\\([0-9.]+\\)" header) |
1649 |
|
(match-string 1 header) |
1650 |
|
"0") |
1651 |
|
;; spam detection mode |
1652 |
|
(when (string-match spam-bogofilter-bogosity-positive-spam-header |
1653 |
|
header) |
1654 |
|
spam-split-group))))) |
1655 |
|
|
1656 |
|
;; return something sensible if the score can't be determined |
1657 |
|
(defun spam-bogofilter-score () |
1658 |
|
"Get the Bogofilter spamicity score" |
1659 |
|
(interactive) |
1660 |
|
(save-window-excursion |
1661 |
|
(gnus-summary-show-article t) |
1662 |
|
(set-buffer gnus-article-buffer) |
1663 |
|
(let ((score (or (spam-check-bogofilter-headers t) |
1664 |
|
(spam-check-bogofilter t)))) |
1665 |
|
(message "Spamicity score %s" score) |
1666 |
|
(or score "0")) |
1667 |
|
(gnus-summary-show-article))) |
1668 |
|
|
1669 |
|
(defun spam-check-bogofilter (&optional score) |
1670 |
|
"Check the Bogofilter backend for the classification of this message" |
1671 |
|
(let ((article-buffer-name (buffer-name)) |
1672 |
|
(db spam-bogofilter-database-directory) |
1673 |
|
return) |
1674 |
|
(with-temp-buffer |
1675 |
|
(let ((temp-buffer-name (buffer-name))) |
1676 |
|
(save-excursion |
1677 |
|
(set-buffer article-buffer-name) |
1678 |
|
(apply 'call-process-region |
1679 |
|
(point-min) (point-max) |
1680 |
|
spam-bogofilter-path |
1681 |
|
nil temp-buffer-name nil |
1682 |
|
(if db `("-d" ,db "-v") `("-v")))) |
1683 |
|
(setq return (spam-check-bogofilter-headers score)))) |
1684 |
|
return)) |
1685 |
|
|
1686 |
|
(defun spam-bogofilter-register-with-bogofilter (articles |
1687 |
|
spam |
1688 |
|
&optional unregister) |
1689 |
|
"Register an article, given as a string, as spam or non-spam." |
1690 |
|
(dolist (article articles) |
1691 |
|
(let ((article-string (spam-get-article-as-string article)) |
1692 |
|
(db spam-bogofilter-database-directory) |
1693 |
|
(switch (if unregister |
1694 |
|
(if spam |
1695 |
|
spam-bogofilter-spam-strong-switch |
1696 |
|
spam-bogofilter-ham-strong-switch) |
1697 |
|
(if spam |
1698 |
|
spam-bogofilter-spam-switch |
1699 |
|
spam-bogofilter-ham-switch)))) |
1700 |
|
(when (stringp article-string) |
1701 |
|
(with-temp-buffer |
1702 |
|
(insert article-string) |
1703 |
|
|
1704 |
|
(apply 'call-process-region |
1705 |
|
(point-min) (point-max) |
1706 |
|
spam-bogofilter-path |
1707 |
|
nil nil nil switch |
1708 |
|
(if db `("-d" ,db "-v") `("-v")))))))) |
1709 |
|
|
1710 |
|
(defun spam-bogofilter-register-spam-routine (articles &optional unregister) |
1711 |
|
(spam-bogofilter-register-with-bogofilter articles t unregister)) |
1712 |
|
|
1713 |
|
(defun spam-bogofilter-unregister-spam-routine (articles) |
1714 |
|
(spam-bogofilter-register-spam-routine articles t)) |
1715 |
|
|
1716 |
|
(defun spam-bogofilter-register-ham-routine (articles &optional unregister) |
1717 |
|
(spam-bogofilter-register-with-bogofilter articles nil unregister)) |
1718 |
|
|
1719 |
|
(defun spam-bogofilter-unregister-ham-routine (articles) |
1720 |
|
(spam-bogofilter-register-ham-routine articles t)) |
1721 |
|
|
1722 |
|
|
1723 |
|
|
1724 |
|
;;;; spamoracle |
1725 |
|
(defun spam-check-spamoracle () |
1726 |
|
"Run spamoracle on an article to determine whether it's spam." |
1727 |
|
(let ((article-buffer-name (buffer-name)) |
1728 |
|
(spam-split-group (if spam-split-symbolic-return |
1729 |
|
'spam |
1730 |
|
spam-split-group))) |
1731 |
|
(with-temp-buffer |
1732 |
|
(let ((temp-buffer-name (buffer-name))) |
1733 |
|
(save-excursion |
1734 |
|
(set-buffer article-buffer-name) |
1735 |
|
(let ((status |
1736 |
|
(apply 'call-process-region |
1737 |
|
(point-min) (point-max) |
1738 |
|
spam-spamoracle-binary |
1739 |
|
nil temp-buffer-name nil |
1740 |
|
(if spam-spamoracle-database |
1741 |
|
`("-f" ,spam-spamoracle-database "mark") |
1742 |
|
'("mark"))))) |
1743 |
|
(if (eq 0 status) |
1744 |
|
(progn |
1745 |
|
(set-buffer temp-buffer-name) |
1746 |
|
(goto-char (point-min)) |
1747 |
|
(when (re-search-forward "^X-Spam: yes;" nil t) |
1748 |
|
spam-split-group)) |
1749 |
|
(error "Error running spamoracle" status)))))))) |
1750 |
|
|
1751 |
|
(defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) |
1752 |
|
"Run spamoracle in training mode." |
1753 |
|
(with-temp-buffer |
1754 |
|
(let ((temp-buffer-name (buffer-name))) |
1755 |
|
(save-excursion |
1756 |
|
(goto-char (point-min)) |
1757 |
|
(dolist (article articles) |
1758 |
|
(insert (spam-get-article-as-string article))) |
1759 |
|
(let* ((arg (if (spam-xor unregister article-is-spam-p) |
1760 |
|
"-spam" |
1761 |
|
"-good")) |
1762 |
|
(status |
1763 |
|
(apply 'call-process-region |
1764 |
|
(point-min) (point-max) |
1765 |
|
spam-spamoracle-binary |
1766 |
|
nil temp-buffer-name nil |
1767 |
|
(if spam-spamoracle-database |
1768 |
|
`("-f" ,spam-spamoracle-database |
1769 |
|
"add" ,arg) |
1770 |
|
`("add" ,arg))))) |
1771 |
|
(when (not (eq 0 status)) |
1772 |
|
(error "Error running spamoracle" status))))))) |
1773 |
|
|
1774 |
|
(defun spam-spamoracle-learn-ham (articles &optional unregister) |
1775 |
|
(spam-spamoracle-learn articles nil unregister)) |
1776 |
|
|
1777 |
|
(defun spam-spamoracle-unlearn-ham (articles &optional unregister) |
1778 |
|
(spam-spamoracle-learn-ham articles t)) |
1779 |
|
|
1780 |
|
(defun spam-spamoracle-learn-spam (articles &optional unregister) |
1781 |
|
(spam-spamoracle-learn articles t unregister)) |
1782 |
|
|
1783 |
|
(defun spam-spamoracle-unlearn-spam (articles &optional unregister) |
1784 |
|
(spam-spamoracle-learn-spam articles t)) |
1785 |
|
|
1786 |
|
|
1787 |
|
;;;; Hooks |
1788 |
|
|
1789 |
|
;;;###autoload |
1790 |
|
(defun spam-initialize () |
1791 |
|
"Install the spam.el hooks and do other initialization" |
1792 |
|
(interactive) |
1793 |
|
(setq spam-install-hooks t) |
1794 |
|
;; TODO: How do we redo this every time spam-face is customized? |
1795 |
|
(push '((eq mark gnus-spam-mark) . spam-face) |
1796 |
|
gnus-summary-highlight) |
1797 |
|
;; Add hooks for loading and saving the spam stats |
1798 |
|
(add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) |
1799 |
|
(add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) |
1800 |
|
(add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) |
1801 |
|
(add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) |
1802 |
|
(add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) |
1803 |
|
(add-hook 'gnus-get-new-news-hook 'spam-setup-widening) |
1804 |
|
(add-hook 'gnus-summary-prepare-hook 'spam-find-spam)) |
1805 |
|
|
1806 |
|
(defun spam-unload-hook () |
1807 |
|
"Uninstall the spam.el hooks" |
1808 |
|
(interactive) |
1809 |
|
(remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) |
1810 |
|
(remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) |
1811 |
|
(remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) |
1812 |
|
(remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) |
1813 |
|
(remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) |
1814 |
|
(remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) |
1815 |
|
(remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) |
1816 |
|
|
1817 |
|
(when spam-install-hooks |
1818 |
|
(spam-initialize)) |
1819 |
|
|
1820 |
|
(provide 'spam) |
1821 |
|
|
1822 |
|
;;; spam.el ends here. |
1823 |
|
|
1824 |
|
(provide 'spam) |
1825 |
|
|
1826 |
|
;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f |
1827 |
|
;;; spam.el ends here |