1 ;;; spam.el --- Identifying spam
2 ;; Copyright (C) 2002 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
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)
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.
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.
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.
30 ;;; The integration with Gnus is not yet complete. See various `FIXME'
31 ;;; comments, below, for supplementary explanations or discussions.
33 ;;; Several TODO items are marked as such
41 (require 'gnus-uu) ; because of key prefix issues
42 (require 'gnus) ; for the definitions of group content classification and spam processors
43 (require 'message) ;for the message-fetch-field functions
47 (autoload 'query-dig "dig"))
51 (autoload 'query-dns "dns"))
56 "Spam configuration.")
58 (defcustom spam-directory "~/News/spam/"
59 "Directory for spam whitelists and blacklists."
63 (defcustom spam-move-spam-nonspam-groups-only t
64 "Whether spam should be moved in non-spam groups only.
65 When nil, only ham and unclassified groups will have their spam moved
66 to the spam-process-destination. When t, spam will also be moved from
71 (defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
72 "The location of the whitelist.
73 The file format is one regular expression per line.
74 The regular expression is matched against the address."
78 (defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
79 "The location of the blacklist.
80 The file format is one regular expression per line.
81 The regular expression is matched against the address."
85 (defcustom spam-use-dig t
86 "Whether query-dig should be used instead of query-dns."
90 (defcustom spam-use-blacklist nil
91 "Whether the blacklist should be used by spam-split."
95 (defcustom spam-use-whitelist nil
96 "Whether the whitelist should be used by spam-split."
100 (defcustom spam-use-blackholes nil
101 "Whether blackholes should be used by spam-split."
105 (defcustom spam-use-bogofilter-headers nil
106 "Whether bogofilter headers should be used by spam-split.
107 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
111 (defcustom spam-use-bogofilter nil
112 "Whether bogofilter should be invoked by spam-split.
113 Enable this if you want Gnus to invoke Bogofilter on new messages."
117 (defcustom spam-use-BBDB nil
118 "Whether BBDB should be used by spam-split."
122 (defcustom spam-use-ifile nil
123 "Whether ifile should be used by spam-split."
127 (defcustom spam-use-stat nil
128 "Whether spam-stat should be used by spam-split."
132 (defcustom spam-split-group "spam"
133 "Group name where incoming spam should be put by spam-split."
137 (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
138 "Mailgroups with spam contents.
139 All unmarked article in such group receive the spam mark on group entry."
140 :type '(repeat (string :tag "Group"))
143 (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
144 "dev.null.dk" "relays.visi.com")
145 "List of blackhole servers."
146 :type '(repeat (string :tag "Server"))
149 (defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark
150 'gnus-killed-mark 'gnus-kill-file-mark
151 'gnus-low-score-mark)
152 "Marks considered as being ham (positively not spam).
153 Such articles will be processed as ham (non-spam) on group exit."
155 (variable-item gnus-del-mark)
156 (variable-item gnus-read-mark)
157 (variable-item gnus-killed-mark)
158 (variable-item gnus-kill-file-mark)
159 (variable-item gnus-low-score-mark))
162 (defcustom spam-spam-marks (list 'gnus-spam-mark)
163 "Marks considered as being spam (positively spam).
164 Such articles will be transmitted to `bogofilter -s' on group exit."
166 (variable-item gnus-spam-mark)
167 (variable-item gnus-killed-mark)
168 (variable-item gnus-kill-file-mark)
169 (variable-item gnus-low-score-mark))
172 (defcustom spam-face 'gnus-splash-face
173 "Face for spam-marked articles"
177 (defgroup spam-ifile nil
178 "Spam ifile configuration."
181 (defcustom spam-ifile-path (exec-installed-p "ifile")
182 "File path of the ifile executable program."
183 :type '(choice (file :tag "Location of ifile")
184 (const :tag "ifile is not installed"))
187 (defcustom spam-ifile-database-path nil
188 "File path of the ifile database."
189 :type '(choice (file :tag "Location of the ifile database")
190 (const :tag "Use the default"))
193 (defcustom spam-ifile-spam-category "spam"
194 "Name of the spam ifile category."
198 (defcustom spam-ifile-all-categories nil
199 "Whether the ifile check will return all categories, or just spam.
200 Set this to t if you want to use the spam-split invocation of ifile as
201 your main source of newsgroup names."
205 (defgroup spam-bogofilter nil
206 "Spam bogofilter configuration."
209 (defcustom spam-bogofilter-path (exec-installed-p "bogofilter")
210 "File path of the Bogofilter executable program."
211 :type '(choice (file :tag "Location of bogofilter")
212 (const :tag "Bogofilter is not installed"))
213 :group 'spam-bogofilter)
215 (defcustom spam-bogofilter-header "X-Bogosity"
216 "The header that Bogofilter inserts in messages."
218 :group 'spam-bogofilter)
220 (defcustom spam-bogofilter-database-directory nil
221 "Directory path of the Bogofilter databases."
222 :type '(choice (directory :tag "Location of the Bogofilter database directory")
223 (const :tag "Use the default"))
226 ;;; Key bindings for spam control.
228 (gnus-define-keys gnus-summary-mode-map
229 "St" spam-bogofilter-score
230 "Sx" gnus-summary-mark-as-spam
231 "Mst" spam-bogofilter-score
232 "Msx" gnus-summary-mark-as-spam
233 "\M-d" gnus-summary-mark-as-spam)
235 ;;; How to highlight a spam summary line.
237 ;; TODO: How do we redo this every time spam-face is customized?
239 (push '((eq mark gnus-spam-mark) . spam-face)
240 gnus-summary-highlight)
242 ;; convenience functions
243 (defun spam-group-spam-contents-p (group)
245 (or (member group spam-junk-mailgroups)
246 (memq 'gnus-group-spam-classification-spam
247 (gnus-parameter-spam-contents group)))
250 (defun spam-group-ham-contents-p (group)
252 (memq 'gnus-group-spam-classification-ham
253 (gnus-parameter-spam-contents group))
256 (defun spam-group-processor-p (group processor)
257 (if (and (stringp group)
259 (member processor (car (gnus-parameter-spam-process group)))
262 (defun spam-group-spam-processor-bogofilter-p (group)
263 (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
265 (defun spam-group-spam-processor-blacklist-p (group)
266 (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
268 (defun spam-group-spam-processor-ifile-p (group)
269 (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
271 (defun spam-group-ham-processor-ifile-p (group)
272 (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
274 (defun spam-group-ham-processor-bogofilter-p (group)
275 (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
277 (defun spam-group-spam-processor-stat-p (group)
278 (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
280 (defun spam-group-ham-processor-stat-p (group)
281 (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
283 (defun spam-group-ham-processor-whitelist-p (group)
284 (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
286 (defun spam-group-ham-processor-BBDB-p (group)
287 (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
289 ;;; Summary entry and exit processing.
291 (defun spam-summary-prepare ()
292 (spam-mark-junk-as-spam-routine))
294 (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
296 (defun spam-summary-prepare-exit ()
297 ;; The spam processors are invoked for any group, spam or ham or neither
298 (when (and spam-bogofilter-path
299 (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
300 (spam-bogofilter-register-spam-routine))
302 (when (and spam-ifile-path
303 (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
304 (spam-ifile-register-spam-routine))
306 (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
307 (spam-stat-register-spam-routine))
309 (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
310 (spam-blacklist-register-routine))
312 (if spam-move-spam-nonspam-groups-only
313 (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
314 (spam-mark-spam-as-expired-and-move-routine
315 (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
316 (spam-mark-spam-as-expired-and-move-routine
317 (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
319 ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
320 ;; expire spam, in case the above did not expire them
321 (spam-mark-spam-as-expired-and-move-routine nil)
323 (when (spam-group-ham-contents-p gnus-newsgroup-name)
324 (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
325 (spam-whitelist-register-routine))
326 (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
327 (spam-ifile-register-ham-routine))
328 (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
329 (spam-bogofilter-register-ham-routine))
330 (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
331 (spam-stat-register-ham-routine))
332 (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
333 (spam-BBDB-register-routine)))
335 ;; now move all ham articles out of spam groups
336 (when (spam-group-spam-contents-p gnus-newsgroup-name)
337 (spam-ham-move-routine
338 (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
340 (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
342 (defun spam-mark-junk-as-spam-routine ()
343 ;; check the global list of group names spam-junk-mailgroups and the
345 (when (spam-group-spam-contents-p gnus-newsgroup-name)
346 (let ((articles gnus-newsgroup-articles)
349 (setq article (pop articles))
350 (when (eq (gnus-summary-article-mark article) gnus-unread-mark)
351 (gnus-summary-mark-article article gnus-spam-mark))))))
353 (defun spam-mark-spam-as-expired-and-move-routine (&optional group)
354 (let ((articles gnus-newsgroup-articles)
357 (setq article (pop articles))
358 (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
359 (gnus-summary-mark-article article gnus-expirable-mark)
360 (when (stringp group)
361 (let ((gnus-current-article article))
362 (gnus-summary-move-article nil group)))))))
364 (defun spam-ham-move-routine (&optional group)
365 (let ((articles gnus-newsgroup-articles)
366 article ham-mark-values mark)
367 (dolist (mark spam-ham-marks)
368 (push (symbol-value mark) ham-mark-values))
371 (setq article (pop articles))
372 (when (and (memq mark ham-mark-values)
374 (let ((gnus-current-article article))
375 (gnus-summary-move-article nil group))))))
377 (defun spam-generic-register-routine (spam-func ham-func)
378 (let ((articles gnus-newsgroup-articles)
379 article mark ham-articles spam-articles spam-mark-values
382 ;; marks are stored as symbolic values, so we have to dereference
383 ;; them for memq to work. we wouldn't have to do this if
384 ;; gnus-summary-article-mark returned a symbol.
385 (dolist (mark spam-ham-marks)
386 (push (symbol-value mark) ham-mark-values))
388 (dolist (mark spam-spam-marks)
389 (push (symbol-value mark) spam-mark-values))
392 (setq article (pop articles)
393 mark (gnus-summary-article-mark article))
394 (cond ((memq mark spam-mark-values) (push article spam-articles))
395 ((memq article gnus-newsgroup-saved))
396 ((memq mark ham-mark-values) (push article ham-articles))))
397 (when (and ham-articles ham-func)
398 (mapc ham-func ham-articles)) ; we use mapc because unlike
399 ; mapcar it discards the
401 (when (and spam-articles spam-func)
402 (mapc spam-func spam-articles)))) ; we use mapc because unlike
403 ; mapcar it discards the
407 (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
409 'line-end-position)))
411 (defun spam-get-article-as-string (article)
412 (let ((article-buffer (spam-get-article-as-buffer article))
415 (save-window-excursion
416 (set-buffer article-buffer)
417 (setq article-string (buffer-string))))
420 (defun spam-get-article-as-buffer (article)
421 (let ((article-buffer))
422 (when (numberp article)
423 (save-window-excursion
424 (gnus-summary-goto-subject article)
425 (gnus-summary-show-article t)
426 (setq article-buffer (get-buffer gnus-article-buffer))))
429 (defun spam-get-article-as-filename (article)
430 (let ((article-filename))
431 (when (numberp article)
432 (nnml-possibly-change-directory (gnus-group-real-name gnus-newsgroup-name))
433 (setq article-filename (expand-file-name (int-to-string article) nnml-current-directory)))
434 (if (file-exists-p article-filename)
438 (defun spam-fetch-field-from-fast (article)
439 "Fetch the `from' field quickly, using the internal gnus-data-list function"
440 (if (and (numberp article)
441 (assoc article (gnus-data-list nil)))
442 (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
445 (defun spam-fetch-field-subject-fast (article)
446 "Fetch the `subject' field quickly, using the internal gnus-data-list function"
447 (if (and (numberp article)
448 (assoc article (gnus-data-list nil)))
449 (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
453 ;;;; Spam determination.
455 (defvar spam-list-of-checks
456 '((spam-use-blacklist . spam-check-blacklist)
457 (spam-use-whitelist . spam-check-whitelist)
458 (spam-use-BBDB . spam-check-BBDB)
459 (spam-use-ifile . spam-check-ifile)
460 (spam-use-stat . spam-check-stat)
461 (spam-use-blackholes . spam-check-blackholes)
462 (spam-use-bogofilter-headers . spam-check-bogofilter-headers)
463 (spam-use-bogofilter . spam-check-bogofilter))
464 "The spam-list-of-checks list contains pairs associating a parameter
465 variable with a spam checking function. If the parameter variable is
466 true, then the checking function is called, and its value decides what
467 happens. Each individual check may return `nil', `t', or a mailgroup
468 name. The value `nil' means that the check does not yield a decision,
469 and so, that further checks are needed. The value `t' means that the
470 message is definitely not spam, and that further spam checks should be
471 inhibited. Otherwise, a mailgroup name is returned where the mail
472 should go, and further checks are also inhibited. The usual mailgroup
473 name is the value of `spam-split-group', meaning that the message is
477 "Split this message into the `spam' group if it is spam.
478 This function can be used as an entry in `nnmail-split-fancy', for
479 example like this: (: spam-split)
481 See the Info node `(gnus)Fancy Mail Splitting' for more details."
484 ;; load the spam-stat tables if needed
485 (when spam-use-stat (spam-stat-load))
487 (let ((list-of-checks spam-list-of-checks)
489 (while (and list-of-checks (not decision))
490 (let ((pair (pop list-of-checks)))
491 (when (symbol-value (car pair))
492 (setq decision (funcall (cdr pair))))))
499 (defun spam-check-blackholes ()
500 "Check the Received headers for blackholed relays."
501 (let ((headers (message-fetch-field "received"))
506 (goto-char (point-min))
507 (while (re-search-forward
508 "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t)
509 (message "Blackhole search found host IP %s." (match-string 1))
510 (push (mapconcat 'identity
511 (nreverse (split-string (match-string 1) "\\."))
514 (dolist (server spam-blackhole-servers)
516 (let ((query-string (concat ip "." server)))
518 (let ((query-result (query-dig query-string)))
520 (message "spam: positive blackhole check '%s'" query-result)
521 (push (list ip server query-result)
523 ;; else, if not using dig.el
524 (when (query-dns query-string)
525 (push (list ip server (query-dns query-string 'TXT))
532 ;;; original idea for spam-check-BBDB from Alexander Kotelnikov
533 ;;; <sacha@giotto.sj.ru>
535 ;; all this is done inside a condition-case to trap errors
542 (defun spam-enter-ham-BBDB (from)
543 "Enter an address into the BBDB; implies ham (non-spam) sender"
545 (let* ((parsed-address (gnus-extract-address-components from))
546 (name (or (car parsed-address) "Ham Sender"))
547 (net-address (car (cdr parsed-address))))
548 (message "Adding address %s to BBDB" from)
549 (when (and net-address
550 (not (bbdb-search-simple nil net-address)))
551 (bbdb-create-internal name nil net-address nil nil
552 "ham sender added by spam.el")))))
554 (defun spam-BBDB-register-routine ()
555 (spam-generic-register-routine
560 (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
562 (defun spam-check-BBDB ()
563 "Mail from people in the BBDB is never considered spam"
564 (let ((who (message-fetch-field "from")))
566 (setq who (regexp-quote (cadr
567 (gnus-extract-address-components who))))
568 (if (bbdb-search-simple nil who)
569 nil spam-split-group)))))
572 (defalias 'bbdb-search-simple 'ignore)
573 (defalias 'spam-check-BBDB 'ignore)
574 (defalias 'spam-BBDB-register-routine 'ignore)
575 (defalias 'spam-enter-ham-BBDB 'ignore)
576 (defalias 'bbdb-create-internal 'ignore)
577 (defalias 'bbdb-records 'ignore))))
582 ;;; check the ifile backend; return nil if the mail was NOT classified
585 (defun spam-get-ifile-database-parameter ()
586 "Get the command-line parameter for ifile's database from spam-ifile-database-path."
587 (if spam-ifile-database-path
588 (format "--db-file=%s" spam-ifile-database-path)
591 (defun spam-check-ifile ()
592 "Check the ifile backend for the classification of this message"
593 (let ((article-buffer-name (buffer-name))
596 (let ((temp-buffer-name (buffer-name))
597 (db-param (spam-get-ifile-database-parameter)))
599 (set-buffer article-buffer-name)
601 (call-process-region (point-min) (point-max) spam-ifile-path
602 nil temp-buffer-name nil "-q" "-c" db-param)
603 (call-process-region (point-min) (point-max) spam-ifile-path
604 nil temp-buffer-name nil "-q" "-c")))
605 (goto-char (point-min))
607 (setq category (buffer-substring (point) (spam-point-at-eol))))
608 (when (not (zerop (length category))) ; we need a category here
609 (if spam-ifile-all-categories
610 (setq return category)
611 ;; else, if spam-ifile-all-categories is not set...
612 (when (string-equal spam-ifile-spam-category category)
613 (setq return spam-split-group))))))
616 (defun spam-ifile-register-with-ifile (article-string category)
617 "Register an article, given as a string, with a category.
618 Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
619 (when (stringp article-string)
620 (let ((category (or category gnus-newsgroup-name))
621 (db-param (spam-get-ifile-database-parameter)))
623 (insert-string article-string)
625 (call-process-region (point-min) (point-max) spam-ifile-path
627 "-h" "-i" category db-param)
628 (call-process-region (point-min) (point-max) spam-ifile-path
630 "-h" "-i" category))))))
632 (defun spam-ifile-register-spam-routine ()
633 (spam-generic-register-routine
635 (spam-ifile-register-with-ifile
636 (spam-get-article-as-string article) spam-ifile-spam-category))
639 (defun spam-ifile-register-ham-routine ()
640 (spam-generic-register-routine
643 (spam-ifile-register-with-ifile
644 (spam-get-article-as-string article) nil))))
651 (let ((spam-stat-install-hooks nil))
652 (require 'spam-stat))
654 (defun spam-check-stat ()
655 "Check the spam-stat backend for the classification of this message"
656 (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override
657 (spam-stat-buffer (buffer-name)) ; stat the current buffer
659 (spam-stat-split-fancy)))
661 (defun spam-stat-register-spam-routine ()
662 (spam-generic-register-routine
664 (let ((article-string (spam-get-article-as-string article)))
666 (insert-string article-string)
667 (spam-stat-buffer-is-spam))))
671 (defun spam-stat-register-ham-routine ()
672 (spam-generic-register-routine
675 (let ((article-string (spam-get-article-as-string article)))
677 (insert-string article-string)
678 (spam-stat-buffer-is-non-spam)))))
682 (defalias 'spam-stat-register-ham-routine 'ignore)
683 (defalias 'spam-stat-register-spam-routine 'ignore)
684 (defalias 'spam-stat-buffer-is-spam 'ignore)
685 (defalias 'spam-stat-buffer-is-non-spam 'ignore)
686 (defalias 'spam-stat-split-fancy 'ignore)
687 (defalias 'spam-stat-load 'ignore)
688 (defalias 'spam-stat-save 'ignore)
689 (defalias 'spam-check-stat 'ignore))))
693 ;;;; Blacklists and whitelists.
695 (defvar spam-whitelist-cache nil)
696 (defvar spam-blacklist-cache nil)
698 (defun spam-enter-whitelist (address)
699 "Enter ADDRESS into the whitelist."
700 (interactive "sAddress: ")
701 (spam-enter-list address spam-whitelist)
702 (setq spam-whitelist-cache nil))
704 (defun spam-enter-blacklist (address)
705 "Enter ADDRESS into the blacklist."
706 (interactive "sAddress: ")
707 (spam-enter-list address spam-blacklist)
708 (setq spam-blacklist-cache nil))
710 (defun spam-enter-list (address file)
711 "Enter ADDRESS into the given FILE, either the whitelist or the blacklist."
712 (unless (file-exists-p (file-name-directory file))
713 (make-directory (file-name-directory file) t))
716 (find-file-noselect file))
717 (goto-char (point-max))
720 (insert address "\n")
723 ;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
724 (defun spam-check-whitelist ()
725 ;; FIXME! Should it detect when file timestamps change?
726 (unless spam-whitelist-cache
727 (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
728 (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
730 (defun spam-check-blacklist ()
731 ;; FIXME! Should it detect when file timestamps change?
732 (unless spam-blacklist-cache
733 (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
734 (and (spam-from-listed-p spam-blacklist-cache) spam-split-group))
736 (defun spam-parse-list (file)
737 (when (file-readable-p file)
738 (let (contents address)
740 (insert-file-contents file)
742 (setq address (buffer-substring (point) (spam-point-at-eol)))
744 (unless (zerop (length address))
745 (setq address (regexp-quote address))
746 (while (string-match "\\\\\\*" address)
747 (setq address (replace-match ".*" t t address)))
748 (push address contents))))
749 (nreverse contents))))
751 (defun spam-from-listed-p (cache)
752 (let ((from (message-fetch-field "from"))
755 (when (string-match (pop cache) from)
760 (defun spam-blacklist-register-routine ()
761 (spam-generic-register-routine
764 (let ((from (spam-fetch-field-from-fast article)))
766 (spam-enter-blacklist from))))
770 (defun spam-whitelist-register-routine ()
771 (spam-generic-register-routine
776 (let ((from (spam-fetch-field-from-fast article)))
778 (spam-enter-whitelist from))))))
783 (defun spam-check-bogofilter-headers (&optional score)
784 (let ((header (message-fetch-field spam-bogofilter-header)))
786 (string-match "^Yes" header))
788 (when (string-match "spamicity=\\([0-9.]+\\)" header)
789 (match-string 1 header))
793 ;; return something sensible if the score can't be determined
794 (defun spam-bogofilter-score ()
795 "Get the Bogofilter spamicity score"
797 (save-window-excursion
798 (gnus-summary-show-article t)
799 (set-buffer gnus-article-buffer)
800 (let ((score (spam-check-bogofilter t)))
801 (message "Spamicity score %s" score)
804 (defun spam-check-bogofilter (&optional score)
805 "Check the Bogofilter backend for the classification of this message"
806 (let ((article-buffer-name (buffer-name))
809 (let ((temp-buffer-name (buffer-name)))
811 (set-buffer article-buffer-name)
812 (if spam-bogofilter-database-directory
813 (call-process-region (point-min) (point-max)
815 nil temp-buffer-name nil "-v"
816 "-d" spam-bogofilter-database-directory)
817 (call-process-region (point-min) (point-max) spam-bogofilter-path
818 nil temp-buffer-name nil "-v")))
819 (setq return (spam-check-bogofilter-headers score))))
822 (defun spam-bogofilter-register-with-bogofilter (article-string spam)
823 "Register an article, given as a string, as spam or non-spam."
824 (when (stringp article-string)
825 (let ((switch (if spam "-s" "-n")))
827 (insert-string article-string)
828 (if spam-bogofilter-database-directory
829 (call-process-region (point-min) (point-max)
831 nil nil nil "-v" switch
832 "-d" spam-bogofilter-database-directory)
833 (call-process-region (point-min) (point-max) spam-bogofilter-path
834 nil nil nil "-v" switch))))))
836 (defun spam-bogofilter-register-spam-routine ()
837 (spam-generic-register-routine
839 (spam-bogofilter-register-with-bogofilter
840 (spam-get-article-as-string article) t))
843 (defun spam-bogofilter-register-ham-routine ()
844 (spam-generic-register-routine
847 (spam-bogofilter-register-with-bogofilter
848 (spam-get-article-as-string article) nil))))
852 ;;; spam.el ends here.