X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fspam.el;h=7ba3503cd73260ecb57a37269d22f6d19fd6261f;hp=e6a54f877684ffebb968f08e5850a1d4da1c862c;hb=13064ac85b6eb8614b74dec7439bab1483abec2d;hpb=68d5210988cb08ab2d3c83c87b7faacb5de80a94 diff --git a/lisp/spam.el b/lisp/spam.el index e6a54f877..4d4c9f098 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -1,5 +1,5 @@ ;;; spam.el --- Identifying spam -;; Copyright (C) 2002 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: network @@ -30,294 +30,2004 @@ ;;; The integration with Gnus is not yet complete. See various `FIXME' ;;; comments, below, for supplementary explanations or discussions. -;;; Code: - -(require 'gnus-sum) - -;; FIXME! We should not require `dns' nor `message' until we actually -;; need them. Best would be to declare needed functions as auto-loadable. -(require 'dns) -(require 'message) - -(autoload 'bbdb-records "bbdb-com") - -;; Attempt to load BBDB macros -(eval-when-compile - (condition-case nil - (require 'bbdb-com) - (file-error (defalias 'bbdb-search 'ignore)))) +;;; Several TODO items are marked as such -;; autoload executable-find -(autoload 'executable-find "executable") +;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting, +;; remote processing, training through files -;; autoload ifile-spam-filter -(autoload 'ifile-spam-filter "ifile-gnus") - -;;; Main parameters. - -(defvar spam-use-blacklist t - "True if the blacklist should be used.") - -(defvar spam-use-whitelist t - "True if the whitelist should be used.") - -(defvar spam-use-blackholes nil - ;; FIXME! Turned off for now. The DNS routines are said to be flaky. - "True if blackholes should be used.") +;;; Code: -(defvar spam-use-bogofilter t - "True if bogofilter should be used.") +(eval-when-compile (require 'cl)) -(defvar spam-use-bbdb t - "True if BBDB should be used.") +(require 'gnus-sum) -(defvar spam-use-bbdb t - "True if ifile should be used.") +(require 'gnus-uu) ; because of key prefix issues +;;; for the definitions of group content classification and spam processors +(require 'gnus) +(require 'message) ;for the message-fetch-field functions -(defvar spam-split-group "spam" - "Usual group name where spam should be split.") +;; for nnimap-split-download-body-default +(eval-when-compile (require 'nnimap)) -(defvar spam-junk-mailgroups - ;; FIXME! The mailgroup list evidently depends on other choices made by the - ;; user, so the built-in default below is not likely to be appropriate. - (cons spam-split-group '("mail.junk" "poste.pourriel")) - "Mailgroups which are dedicated by splitting to receive various junk. -All unmarked article in such group receive the spam mark on group entry.") +;; autoload query-dig +(eval-and-compile + (autoload 'query-dig "dig")) -;; FIXME! For `spam-ham-marks' and `spam-spam-marks', I wonder if it would -;; not be easier for the user to just accept a string of mark letters, instead -;; of a list of Gnus variable names. In such case, the stunt of deferred -;; evaluation would not be useful anymore. Lars?? :-) +;; autoload spam-report +(eval-and-compile + (autoload 'spam-report-gmane "spam-report") + (autoload 'spam-report-resend "spam-report")) -;; FIXME! It is rather questionable to see `K', `X' and `Y' as indicating -;; positive ham. It much depends on how and why people use kill files, score -;; files, and the kill command. Maybe it would be better, by default, to not -;; process a message neither as ham nor spam, that is, just ignore it for -;; learning purposes, when we are not sure of how the user sees it. -;; But `r' and `R' should undoubtedly be seen as ham. +;; autoload gnus-registry +(eval-and-compile + (autoload 'gnus-registry-group-count "gnus-registry") + (autoload 'gnus-registry-add-group "gnus-registry") + (autoload 'gnus-registry-store-extra-entry "gnus-registry") + (autoload 'gnus-registry-fetch-extra "gnus-registry")) -;; FIXME! Some might consider overkill to define a list of spam marks. On -;; the other hand, who knows, some users might for example like that -;; explicitly `E'xpired articles be processed as positive spam. +;; autoload query-dns +(eval-and-compile + (autoload 'query-dns "dns")) -(defvar spam-ham-marks - (list gnus-del-mark gnus-read-mark gnus-killed-mark - gnus-kill-file-mark gnus-low-score-mark) - "Marks considered as being ham (positively not spam). -Such articles will be transmitted to `bogofilter -n' on group exit.") +;;; Main parameters. -(defvar spam-spam-marks - (list gnus-spam-mark) - "Marks considered as being spam (positively spam). -Such articles will be transmitted to `bogofilter -s' on group exit.") +(defgroup spam nil + "Spam configuration.") + +(defcustom spam-directory (nnheader-concat gnus-directory "spam/") + "Directory for spam whitelists and blacklists." + :type 'directory + :group 'spam) + +(defcustom spam-move-spam-nonspam-groups-only t + "Whether spam should be moved in non-spam groups only. +When t, only ham and unclassified groups will have their spam moved +to the spam-process-destination. When nil, spam will also be moved from +spam groups." + :type 'boolean + :group 'spam) + +(defcustom spam-process-ham-in-nonham-groups nil + "Whether ham should be processed in non-ham groups." + :type 'boolean + :group 'spam) + +(defcustom spam-log-to-registry nil + "Whether spam/ham processing should be logged in the registry." + :type 'boolean + :group 'spam) + +(defcustom spam-split-symbolic-return nil + "Whether `spam-split' should work with symbols or group names." + :type 'boolean + :group 'spam) + +(defcustom spam-split-symbolic-return-positive nil + "Whether `spam-split' should ALWAYS work with symbols or group names. +Do not set this if you use `spam-split' in a fancy split + method." + :type 'boolean + :group 'spam) + +(defcustom spam-process-ham-in-spam-groups nil + "Whether ham should be processed in spam groups." + :type 'boolean + :group 'spam) + +(defcustom spam-mark-only-unseen-as-spam t + "Whether only unseen articles should be marked as spam in spam groups. +When nil, all unread articles in a spam group are marked as +spam. Set this if you want to leave an article unread in a spam group +without losing it to the automatic spam-marking process." + :type 'boolean + :group 'spam) + +(defcustom spam-mark-ham-unread-before-move-from-spam-group nil + "Whether ham should be marked unread before it's moved. +The article is moved out of a spam group according to ham-process-destination. +This variable is an official entry in the international Longest Variable Name +Competition." + :type 'boolean + :group 'spam) + +(defcustom spam-disable-spam-split-during-ham-respool nil + "Whether `spam-split' should be ignored while resplitting ham. +This is useful to prevent ham from ending up in the same spam +group after the resplit. Don't set this to t if you have `spam-split' as the +last rule in your split configuration." + :type 'boolean + :group 'spam) + +(defcustom spam-autodetect-recheck-messages nil + "Should spam.el recheck all meessages when autodetecting? +Normally this is nil, so only unseen messages will be checked." + :type 'boolean + :group 'spam) + +(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory) + "The location of the whitelist. +The file format is one regular expression per line. +The regular expression is matched against the address." + :type 'file + :group 'spam) -;; FIXME! Ideally, the remainder of this page should be fully integrated -;; within `gnus-sum.el'. +(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory) + "The location of the blacklist. +The file format is one regular expression per line. +The regular expression is matched against the address." + :type 'file + :group 'spam) + +(defcustom spam-use-dig t + "Whether `query-dig' should be used instead of `query-dns'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-gmane-xref nil + "Whether the Gmane spam xref should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-blacklist nil + "Whether the blacklist should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-blacklist-ignored-regexes nil + "Regular expressions that the blacklist should ignore." + :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting")) + :group 'spam) + +(defcustom spam-use-whitelist nil + "Whether the whitelist should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-whitelist-exclusive nil + "Whether whitelist-exclusive should be used by `spam-split'. +Exclusive whitelisting means that all messages from senders not in the whitelist +are considered spam." + :type 'boolean + :group 'spam) + +(defcustom spam-use-blackholes nil + "Whether blackholes should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-hashcash nil + "Whether hashcash payments should be detected by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-regex-headers nil + "Whether a header regular expression match should be used by `spam-split'. +Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-regex-body nil + "Whether a body regular expression match should be used by `spam-split'. +Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-bogofilter-headers nil + "Whether bogofilter headers should be used by `spam-split'. +Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them." + :type 'boolean + :group 'spam) + +(defcustom spam-use-bogofilter nil + "Whether bogofilter should be invoked by `spam-split'. +Enable this if you want Gnus to invoke Bogofilter on new messages." + :type 'boolean + :group 'spam) + +(defcustom spam-use-bsfilter-headers nil + "Whether bsfilter headers should be used by `spam-split'. +Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them." + :type 'boolean + :group 'spam) + +(defcustom spam-use-bsfilter nil + "Whether bsfilter should be invoked by `spam-split'. +Enable this if you want Gnus to invoke Bsfilter on new messages." + :type 'boolean + :group 'spam) + +(defcustom spam-use-BBDB nil + "Whether BBDB should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-BBDB-exclusive nil + "Whether BBDB-exclusive should be used by `spam-split'. +Exclusive BBDB means that all messages from senders not in the BBDB are +considered spam." + :type 'boolean + :group 'spam) + +(defcustom spam-use-ifile nil + "Whether ifile should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-stat nil + "Whether `spam-stat' should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-spamoracle nil + "Whether spamoracle should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-spamassassin nil + "Whether spamassassin should be invoked by `spam-split'. +Enable this if you want Gnus to invoke SpamAssassin on new messages." + :type 'boolean + :group 'spam) + +(defcustom spam-use-spamassassin-headers nil + "Whether spamassassin headers should be checked by `spam-split'. +Enable this if you pre-process messages with SpamAssassin BEFORE Gnus sees +them." + :type 'boolean + :group 'spam) + +(defcustom spam-use-crm114 nil + "Whether the CRM114 Mailfilter should be used by `spam-split'." + :type 'boolean + :group 'spam) + +(defcustom spam-install-hooks (or + spam-use-dig + spam-use-gmane-xref + spam-use-blacklist + spam-use-whitelist + spam-use-whitelist-exclusive + spam-use-blackholes + spam-use-hashcash + spam-use-regex-headers + spam-use-regex-body + spam-use-bogofilter + spam-use-bogofilter-headers + spam-use-spamassassin + spam-use-spamassassin-headers + spam-use-bsfilter + spam-use-bsfilter-headers + spam-use-BBDB + spam-use-BBDB-exclusive + spam-use-ifile + spam-use-stat + spam-use-spamoracle + spam-use-crm114) + "Whether the spam hooks should be installed. +Default to t if one of the spam-use-* variables is set." + :group 'spam + :type 'boolean) + +(defcustom spam-split-group "spam" + "Group name where incoming spam should be put by `spam-split'." + :type 'string + :group 'spam) + +;;; TODO: deprecate this variable, it's confusing since it's a list of strings, +;;; not regular expressions +(defcustom spam-junk-mailgroups (cons + spam-split-group + '("mail.junk" "poste.pourriel")) + "Mailgroups with spam contents. +All unmarked article in such group receive the spam mark on group entry." + :type '(repeat (string :tag "Group")) + :group 'spam) + + +(defcustom spam-gmane-xref-spam-group "gmane.spam.detected" + "The group where spam xrefs can be found on Gmane. +Only meaningful if you enable `spam-use-gmane-xref'." + :type 'string + :group 'spam) + +(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" + "dev.null.dk" "relays.visi.com") + "List of blackhole servers. +Only meaningful if you enable `spam-use-blackholes'." + :type '(repeat (string :tag "Server")) + :group 'spam) + +(defcustom spam-blackhole-good-server-regex nil + "String matching IP addresses that should not be checked in the blackholes. +Only meaningful if you enable `spam-use-blackholes'." + :type '(radio (const nil) + (regexp :format "%t: %v\n" :size 0)) + :group 'spam) + +(defcustom spam-face 'gnus-splash-face + "Face for spam-marked articles." + :type 'face + :group 'spam) + +(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES") + "Regular expression for positive header spam matches. +Only meaningful if you enable `spam-use-regex-headers'." + :type '(repeat (regexp :tag "Regular expression to match spam header")) + :group 'spam) + +(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO") + "Regular expression for positive header ham matches. +Only meaningful if you enable `spam-use-regex-headers'." + :type '(repeat (regexp :tag "Regular expression to match ham header")) + :group 'spam) + +(defcustom spam-regex-body-spam '() + "Regular expression for positive body spam matches. +Only meaningful if you enable `spam-use-regex-body'." + :type '(repeat (regexp :tag "Regular expression to match spam body")) + :group 'spam) + +(defcustom spam-regex-body-ham '() + "Regular expression for positive body ham matches. +Only meaningful if you enable `spam-use-regex-body'." + :type '(repeat (regexp :tag "Regular expression to match ham body")) + :group 'spam) + +(defgroup spam-ifile nil + "Spam ifile configuration." + :group 'spam) + +(defcustom spam-ifile-path (executable-find "ifile") + "File path of the ifile executable program." + :type '(choice (file :tag "Location of ifile") + (const :tag "ifile is not installed")) + :group 'spam-ifile) + +(defcustom spam-ifile-database-path nil + "File path of the ifile database." + :type '(choice (file :tag "Location of the ifile database") + (const :tag "Use the default")) + :group 'spam-ifile) + +(defcustom spam-ifile-spam-category "spam" + "Name of the spam ifile category." + :type 'string + :group 'spam-ifile) + +(defcustom spam-ifile-ham-category nil + "Name of the ham ifile category. +If nil, the current group name will be used." + :type '(choice (string :tag "Use a fixed category") + (const :tag "Use the current group name")) + :group 'spam-ifile) + +(defcustom spam-ifile-all-categories nil + "Whether the ifile check will return all categories, or just spam. +Set this to t if you want to use the `spam-split' invocation of ifile as +your main source of newsgroup names." + :type 'boolean + :group 'spam-ifile) + +(defgroup spam-bogofilter nil + "Spam bogofilter configuration." + :group 'spam) + +(defcustom spam-bogofilter-path (executable-find "bogofilter") + "File path of the Bogofilter executable program." + :type '(choice (file :tag "Location of bogofilter") + (const :tag "Bogofilter is not installed")) + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-header "X-Bogosity" + "The header that Bogofilter inserts in messages." + :type 'string + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-spam-switch "-s" + "The switch that Bogofilter uses to register spam messages." + :type 'string + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-ham-switch "-n" + "The switch that Bogofilter uses to register ham messages." + :type 'string + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-spam-strong-switch "-S" + "The switch that Bogofilter uses to unregister ham messages." + :type 'string + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-ham-strong-switch "-N" + "The switch that Bogofilter uses to unregister spam messages." + :type 'string + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)" + "The regex on `spam-bogofilter-header' for positive spam identification." + :type 'regexp + :group 'spam-bogofilter) + +(defcustom spam-bogofilter-database-directory nil + "Directory path of the Bogofilter databases." + :type '(choice (directory + :tag "Location of the Bogofilter database directory") + (const :tag "Use the default")) + :group 'spam-bogofilter) + +(defgroup spam-bsfilter nil + "Spam bsfilter configuration." + :group 'spam) + +(defcustom spam-bsfilter-path (executable-find "bsfilter") + "File path of the Bsfilter executable program." + :type '(choice (file :tag "Location of bsfilter") + (const :tag "Bsfilter is not installed")) + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-header "X-Spam-Flag" + "The header inserted by Bsfilter to flag spam." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-probability-header "X-Spam-Probability" + "The header that Bsfilter inserts in messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-spam-switch "--add-spam" + "The switch that Bsfilter uses to register spam messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-ham-switch "--add-ham" + "The switch that Bsfilter uses to register ham messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-spam-strong-switch "--sub-spam" + "The switch that Bsfilter uses to unregister ham messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-ham-strong-switch "--sub-clean" + "The switch that Bsfilter uses to unregister spam messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-database-directory nil + "Directory path of the Bsfilter databases." + :type '(choice (directory + :tag "Location of the Bsfilter database directory") + (const :tag "Use the default")) + :group 'spam-bsfilter) + +(defgroup spam-spamoracle nil + "Spam spamoracle configuration." + :group 'spam) + +(defcustom spam-spamoracle-database nil + "Location of spamoracle database file. +When nil, use the default spamoracle database." + :type '(choice (directory :tag "Location of spamoracle database file.") + (const :tag "Use the default")) + :group 'spam-spamoracle) + +(defcustom spam-spamoracle-binary (executable-find "spamoracle") + "Location of the spamoracle binary." + :type '(choice (directory :tag "Location of the spamoracle binary") + (const :tag "Use the default")) + :group 'spam-spamoracle) + +(defgroup spam-spamassassin nil + "Spam SpamAssassin configuration." + :group 'spam) + +(defcustom spam-spamassassin-path (executable-find "spamassassin") + "File path of the spamassassin executable program. +Hint: set this to \"spamc\" if you have spamd running. See the spamc and +spamd man pages for more information on these programs." + :type '(choice (file :tag "Location of spamc") + (const :tag "spamassassin is not installed")) + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-arguments () + "Arguments to pass to the spamassassin executable. +This must be a list. For example, `(\"-C\" \"configfile\")'." + :type '(restricted-sexp :match-alternatives (listp)) + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-spam-flag-header "X-Spam-Flag" + "The header inserted by SpamAssassin to flag spam." + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-positive-spam-flag-header "YES" + "The regex on `spam-spamassassin-spam-flag-header' for positive spam +identification" + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-spamassassin-spam-status-header "X-Spam-Status" + "The header inserted by SpamAssassin, giving extended scoring information" + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-path (executable-find "sa-learn") + "File path of the sa-learn executable program." + :type '(choice (file :tag "Location of spamassassin") + (const :tag "spamassassin is not installed")) + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-rebuild t + "Whether sa-learn should rebuild the database every time it is called +Enable this if you want sa-learn to rebuild the database automatically. Doing +this will slightly increase the running time of the spam registration process. +If you choose not to do this, you will have to run \"sa-learn --rebuild\" in +order for SpamAssassin to recognize the new registered spam." + :type 'boolean + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-spam-switch "--spam" + "The switch that sa-learn uses to register spam messages" + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-ham-switch "--ham" + "The switch that sa-learn uses to register ham messages" + :type 'string + :group 'spam-spamassassin) + +(defcustom spam-sa-learn-unregister-switch "--forget" + "The switch that sa-learn uses to unregister messages messages" + :type 'string + :group 'spam-spamassassin) + +(defgroup spam-crm114 nil + "Spam CRM114 Mailfilter configuration." + :group 'spam) + +(defcustom spam-crm114-program (executable-find "mailfilter.crm") + "File path of the CRM114 Mailfilter executable program." + :type '(choice (file :tag "Location of CRM114 Mailfilter") + (const :tag "CRM114 Mailfilter is not installed")) + :group 'spam-crm114) + +(defcustom spam-crm114-header "X-CRM114-Status" + "The header that CRM114 Mailfilter inserts in messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-spam-switch "--learnspam" + "The switch that CRM114 Mailfilter uses to register spam messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-ham-switch "--learnnonspam" + "The switch that CRM114 Mailfilter uses to register ham messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-spam-strong-switch "--UNKNOWN" + "The switch that CRM114 Mailfilter uses to unregister ham messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-ham-strong-switch "--UNKNOWN" + "The switch that CRM114 Mailfilter uses to unregister spam messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-positive-spam-header "^SPAM" + "The regex on `spam-crm114-header' for positive spam identification." + :type 'regexp + :group 'spam-crm114) + +(defcustom spam-crm114-database-directory nil + "Directory path of the CRM114 Mailfilter databases." + :type '(choice (directory + :tag "Location of the CRM114 Mailfilter database directory") + (const :tag "Use the default")) + :group 'spam-crm114) ;;; Key bindings for spam control. -;; FIXME! The justification for `M-d' is that this is what Paul Graham -;; suggests in his original article, and what Eric Raymond's patch for Mutt -;; uses. But more importantly, that binding was still free in Summary mode! - -;; FIXME! Lars has not blessed the following key bindings yet. It looks -;; convenient that the score analysis command uses a sequence ending with the -;; letter `t', so it nicely parallels `B t' or `V t'. `M-d' is a kind of -;; "alternate" `d', it is also the sequence suggested in Paul Graham article, -;; and also in Eric Raymond's patch for Mutt. `S x' might be the more -;; official key binding for `M-d'. - (gnus-define-keys gnus-summary-mode-map - "St" spam-bogofilter-score + "St" spam-generic-score "Sx" gnus-summary-mark-as-spam + "Mst" spam-generic-score + "Msx" gnus-summary-mark-as-spam "\M-d" gnus-summary-mark-as-spam) -;;; How to highlight a spam summary line. - -;; FIXME! Of course, `gnus-splash-face' has another purpose. Maybe a -;; special face should be created, named and used instead, for spam lines. - -(push '((eq mark gnus-spam-mark) . gnus-splash-face) - gnus-summary-highlight) - -;;; Hooks dispatching. A bit raw for now. +(defvar spam-cache-lookups t + "Whether spam.el will try to cache lookups using `spam-caches'.") + +(defvar spam-caches (make-hash-table + :size 10 + :test 'equal) + "Cache of spam detection entries.") + +(defvar spam-old-ham-articles nil + "List of old ham articles, generated when a group is entered.") + +(defvar spam-old-spam-articles nil + "List of old spam articles, generated when a group is entered.") + +(defvar spam-split-disabled nil + "If non-nil, `spam-split' is disabled, and always returns nil.") + +(defvar spam-split-last-successful-check nil + "Internal variable. +`spam-split' will set this to nil or a spam-use-XYZ check if it +finds ham or spam.") + +;; convenience functions +(defun spam-clear-cache (symbol) + "Clear the spam-caches entry for a check." + (remhash symbol spam-caches)) + +(defun spam-xor (a b) + "Logical A xor B." + (and (or a b) (not (and a b)))) + +(defun spam-group-ham-mark-p (group mark &optional spam) + "Checks if MARK is considered a ham mark in GROUP." + (when (stringp group) + (let* ((marks (spam-group-ham-marks group spam)) + (marks (if (symbolp mark) + marks + (mapcar 'symbol-value marks)))) + (memq mark marks)))) + +(defun spam-group-spam-mark-p (group mark) + "Checks if MARK is considered a spam mark in GROUP." + (spam-group-ham-mark-p group mark t)) + +(defun spam-group-ham-marks (group &optional spam) + "In GROUP, get all the ham marks." + (when (stringp group) + (let* ((marks (if spam + (gnus-parameter-spam-marks group) + (gnus-parameter-ham-marks group))) + (marks (car marks)) + (marks (if (listp (car marks)) (car marks) marks))) + marks))) + +(defun spam-group-spam-marks (group) + "In GROUP, get all the spam marks." + (spam-group-ham-marks group t)) + +(defun spam-group-spam-contents-p (group) + "Is GROUP a spam group?" + (if (stringp group) + (or (member group spam-junk-mailgroups) + (memq 'gnus-group-spam-classification-spam + (gnus-parameter-spam-contents group))) + nil)) + +(defun spam-group-ham-contents-p (group) + "Is GROUP a ham group?" + (if (stringp group) + (memq 'gnus-group-spam-classification-ham + (gnus-parameter-spam-contents group)) + nil)) + +(defvar spam-list-of-processors + ;; note the nil processors are not defined in gnus.el + '((nil spam spam-use-gmane) + (nil spam spam-use-resend) + (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) + (gnus-group-spam-exit-processor-bsfilter spam spam-use-bsfilter) + (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) + (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) + (gnus-group-spam-exit-processor-stat spam spam-use-stat) + (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) + (nil spam spam-use-crm114) + (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin) + (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) + (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) + (gnus-group-ham-exit-processor-bsfilter ham spam-use-bsfilter) + (gnus-group-ham-exit-processor-stat ham spam-use-stat) + (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) + (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) + (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) + (gnus-group-ham-exit-processor-spamassassin ham spam-use-spamassassin) + (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle) + (nil ham spam-use-crm114)) + "The `spam-list-of-processors' list. +This list contains pairs associating the obsolete ham/spam exit +processor variables with a classification and a spam-use-* +variable. When the processor variable is nil, just the +classification and spam-use-* check variable are used.") + +(defun spam-group-processor-p (group check &optional classification) + "Checks if GROUP has a CHECK with CLASSIFICATION registered. +Also accepts the obsolete processors, which can be found in +gnus.el and in spam-list-of-processors." + (if (and (stringp group) + (symbolp check)) + (let ((old-style (assq check spam-list-of-processors)) + (parameters (nth 0 (gnus-parameter-spam-process group))) + found) + (if old-style ; old-style processor + (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style)) + ;; now search for the parameter + (dolist (parameter parameters) + (when (and (null found) + (listp parameter) + (eq classification (nth 0 parameter)) + (eq check (nth 1 parameter))) + (setq found t))) + found)) + nil)) + +(defun spam-report-articles-gmane (n) + "Report the current message as spam via Gmane. +Respects the process/prefix convention." + (interactive "P") + (dolist (article (gnus-summary-work-articles n)) + (gnus-summary-remove-process-mark article) + (spam-report-gmane article))) + +(defun spam-report-articles-resend (n) + "Report the current message as spam by resending it. +Respects the process/prefix convention. Also see +`spam-report-resend-to'." + (interactive "P") + (let ((spam-report-resend-to + (gnus-parameter-spam-resend-to gnus-newsgroup-name)) + (articles (gnus-summary-work-articles n))) + (spam-report-resend articles) + (dolist (article articles) + (gnus-summary-remove-process-mark article)))) + +(defun spam-necessary-extra-headers () + "Return the extra headers spam.el thinks are necessary." + (let (list) + (when (or spam-use-spamassassin + spam-use-spamassassin-headers + spam-use-regex-headers) + (push 'X-Spam-Status list)) + list)) + +(defun spam-user-format-function-S (headers) + (when headers + (spam-summary-score headers))) + +(defun spam-article-sort-by-spam-status (h1 h2) + "Sort articles by score." + (let (result) + (dolist (header (spam-necessary-extra-headers)) + (let ((s1 (spam-summary-score h1 header)) + (s2 (spam-summary-score h2 header))) + (unless (= s1 s2) + (setq result (< s1 s2)) + (return)))) + result)) + +(defun spam-extra-header-to-number (header headers) + "Transform an extra header to a number." + (if (gnus-extra-header header headers) + (cond + ((eq header 'X-Spam-Status) + (string-to-number (gnus-replace-in-string + (gnus-extra-header header headers) + ".*hits=" ""))) + ;; for CRM checking, it's probably faster to just do the string match + ((and spam-use-crm114 (string-match "( pR: \\([0-9.-]+\\)" header)) + (match-string 1 header)) + (t nil)) + nil)) + +(defun spam-summary-score (headers &optional specific-header) + "Score an article for the summary buffer, as fast as possible. +With SPECIFIC-HEADER, returns only that header's score. +Will not return a nil score." + (let (score) + (dolist (header + (if specific-header + (list specific-header) + (spam-necessary-extra-headers))) + (setq score + (spam-extra-header-to-number header headers)) + (when score + (return))) + (or score 0))) + +(defun spam-generic-score (&optional recheck) + "Invoke whatever scoring method we can." + (interactive "P") + (cond + ((or spam-use-spamassassin spam-use-spamassassin-headers) + (spam-spamassassin-score recheck)) + ((or spam-use-bsfilter spam-use-bsfilter-headers) + (spam-bsfilter-score recheck)) + (spam-use-crm114 + (spam-crm114-score)) + (t (spam-bogofilter-score recheck)))) + +;;; Summary entry and exit processing. (defun spam-summary-prepare () + (setq spam-old-ham-articles + (spam-list-articles gnus-newsgroup-articles 'ham)) + (setq spam-old-spam-articles + (spam-list-articles gnus-newsgroup-articles 'spam)) (spam-mark-junk-as-spam-routine)) +;; The spam processors are invoked for any group, spam or ham or neither (defun spam-summary-prepare-exit () - (spam-bogofilter-register-routine)) - -(add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) -(add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (unless gnus-group-is-exiting-without-update-p + (gnus-message 6 "Exiting summary buffer and applying spam rules") + + ;; first of all, unregister any articles that are no longer ham or spam + ;; we have to iterate over the processors, or else we'll be too slow + (dolist (classification '(spam ham)) + (let* ((old-articles (if (eq classification 'spam) + spam-old-spam-articles + spam-old-ham-articles)) + (new-articles (spam-list-articles + gnus-newsgroup-articles + classification)) + (changed-articles (spam-set-difference new-articles old-articles))) + ;; now that we have the changed articles, we go through the processors + (dolist (processor-param spam-list-of-processors) + (let ((processor (nth 0 processor-param)) + (processor-classification (nth 1 processor-param)) + (check (nth 2 processor-param)) + unregister-list) + (dolist (article changed-articles) + (let ((id (spam-fetch-field-message-id-fast article))) + (when (spam-log-unregistration-needed-p + id 'process classification check) + (push article unregister-list)))) + ;; call spam-register-routine with specific articles to unregister, + ;; when there are articles to unregister and the check is enabled + (when (and unregister-list (symbol-value check)) + (spam-register-routine + classification check t unregister-list)))))) + + ;; find all the spam processors applicable to this group + (dolist (processor-param spam-list-of-processors) + (let ((processor (nth 0 processor-param)) + (classification (nth 1 processor-param)) + (check (nth 2 processor-param))) + (when (and (eq 'spam classification) + (spam-group-processor-p gnus-newsgroup-name check classification)) + (spam-register-routine classification check)))) + + (unless (and spam-move-spam-nonspam-groups-only + (spam-group-spam-contents-p gnus-newsgroup-name)) + (let* ((group (gnus-parameter-spam-process-destination + gnus-newsgroup-name)) + (num (spam-mark-spam-as-expired-and-move-routine group))) + (when (> num 0) + (gnus-message 6 + "%d spam messages are marked as expired and moved it to %s" + num group)))) + + ;; now we redo spam-mark-spam-as-expired-and-move-routine to only + ;; expire spam, in case the above did not expire them + (let ((num (spam-mark-spam-as-expired-and-move-routine nil))) + (when (> num 0) + (gnus-message 6 + "%d spam messages are markd as expired without moving it" + num))) + + (when (or (spam-group-ham-contents-p gnus-newsgroup-name) + (and (spam-group-spam-contents-p gnus-newsgroup-name) + spam-process-ham-in-spam-groups) + spam-process-ham-in-nonham-groups) + ;; find all the ham processors applicable to this group + (dolist (processor-param spam-list-of-processors) + (let ((processor (nth 0 processor-param)) + (classification (nth 1 processor-param)) + (check (nth 2 processor-param))) + (when (and (eq 'ham classification) + (spam-group-processor-p gnus-newsgroup-name check classification)) + (spam-register-routine classification check))))) + + (when (spam-group-processor-p gnus-newsgroup-name 'ham 'spam-use-ham-copy) + (let ((num + (spam-ham-copy-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) + (when (> num 0) + (gnus-message 6 "%d ham messages are copied" num)))) + + ;; now move all ham articles out of spam groups + (when (spam-group-spam-contents-p gnus-newsgroup-name) + (let ((num + (spam-ham-move-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) + (when (> num 0) + (gnus-message 6 "%d ham messages are moved from spam group" num))))) + + (setq spam-old-ham-articles nil) + (setq spam-old-spam-articles nil)) + +(defun spam-set-difference (list1 list2) + "Return a set difference of LIST1 and LIST2. +When either list is nil, the other is returned." + (if (and list1 list2) + ;; we have two non-nil lists + (progn + (dolist (item (append list1 list2)) + (when (and (memq item list1) (memq item list2)) + (setq list1 (delq item list1)) + (setq list2 (delq item list2)))) + (append list1 list2)) + ;; if either of the lists was nil, return the other one + (if list1 list1 list2))) (defun spam-mark-junk-as-spam-routine () - (when (member gnus-newsgroup-name spam-junk-mailgroups) + ;; check the global list of group names spam-junk-mailgroups and the + ;; group parameters + (when (spam-group-spam-contents-p gnus-newsgroup-name) + (gnus-message 6 "Marking %s articles as spam" + (if spam-mark-only-unseen-as-spam + "unseen" + "unread")) + (let ((articles (if spam-mark-only-unseen-as-spam + gnus-newsgroup-unseen + gnus-newsgroup-unreads))) + (dolist (article articles) + (gnus-summary-mark-article article gnus-spam-mark))))) + +(defun spam-mark-spam-as-expired-and-move-routine (&rest groups) + (if (and (car-safe groups) (listp (car-safe groups))) + (apply 'spam-mark-spam-as-expired-and-move-routine (car groups)) + (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article) - (while articles - (setq article (pop articles)) - (when (eq (gnus-summary-article-mark article) gnus-unread-mark) - (gnus-summary-mark-article article gnus-spam-mark)))))) + (backend-supports-deletions + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)) + article tomove deletep) + (dolist (article articles) + (when (eq (gnus-summary-article-mark article) gnus-spam-mark) + (gnus-summary-mark-article article gnus-expirable-mark) + (push article tomove))) + + ;; now do the actual copies + (dolist (group groups) + (when (and tomove + (stringp group)) + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (when tomove + (if (or (not backend-supports-deletions) + (> (length groups) 1)) + (progn + (gnus-summary-copy-article nil group) + (setq deletep t)) + (gnus-summary-move-article nil group))))) + + ;; now delete the articles, if there was a copy done, and the + ;; backend allows it + (when (and deletep backend-supports-deletions) + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (when tomove + (let ((gnus-novice-user nil)) ; don't ask me if I'm sure + (gnus-summary-delete-article nil)))) + + (gnus-summary-yank-process-mark) + (length tomove)))) + +(defun spam-ham-copy-or-move-routine (copy groups) + (gnus-summary-kill-process-mark) + (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham)) + (backend-supports-deletions + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)) + (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) + article mark todo deletep respool) + + (when (member 'respool groups) + (setq respool t) ; boolean for later + (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it + + ;; now do the actual move + (dolist (group groups) + (when (and todo (stringp group)) + (dolist (article todo) + (when spam-mark-ham-unread-before-move-from-spam-group + (gnus-summary-mark-article article gnus-unread-mark)) + (gnus-summary-set-process-mark article)) + + (if respool ; respooling is with a "fake" group + (let ((spam-split-disabled + (or spam-split-disabled + spam-disable-spam-split-during-ham-respool))) + (gnus-summary-respool-article nil respool-method)) + (if (or (not backend-supports-deletions) ; else, we are not respooling + (> (length groups) 1)) + (progn ; if copying, copy and set deletep + (gnus-summary-copy-article nil group) + (setq deletep t)) + (gnus-summary-move-article nil group))))) ; else move articles + + ;; now delete the articles, unless a) copy is t, and there was a copy done + ;; b) a move was done to a single group + ;; c) backend-supports-deletions is nil + (unless copy + (when (and deletep backend-supports-deletions) + (dolist (article todo) + (gnus-summary-set-process-mark article)) + (when todo + (let ((gnus-novice-user nil)) ; don't ask me if I'm sure + (gnus-summary-delete-article nil))))) + + (gnus-summary-yank-process-mark) + (length todo))) + +(defun spam-ham-copy-routine (&rest groups) + (if (and (car-safe groups) (listp (car-safe groups))) + (apply 'spam-ham-copy-routine (car groups)) + (spam-ham-copy-or-move-routine t groups))) + +(defun spam-ham-move-routine (&rest groups) + (if (and (car-safe groups) (listp (car-safe groups))) + (apply 'spam-ham-move-routine (car groups)) + (spam-ham-copy-or-move-routine nil groups))) + +(defun spam-get-article-as-string (article) + (when (numberp article) + (with-temp-buffer + (gnus-request-article-this-buffer + article + gnus-newsgroup-name) + (buffer-string)))) + +;; disabled for now +;; (defun spam-get-article-as-filename (article) +;; (let ((article-filename)) +;; (when (numberp article) +;; (nnml-possibly-change-directory +;; (gnus-group-real-name gnus-newsgroup-name)) +;; (setq article-filename (expand-file-name +;; (int-to-string article) nnml-current-directory))) +;; (if (file-exists-p article-filename) +;; article-filename +;; nil))) + +(defun spam-fetch-field-fast (article field &optional prepared-data-header) + "Fetch a field quickly, using the internal gnus-data-list function" + (when (numberp article) + (let* ((data-header (or prepared-data-header + (spam-fetch-article-header article)))) + (if (arrayp data-header) + (cond + ((equal field 'from) + (mail-header-from data-header)) + ((equal field 'message-id) + (mail-header-message-id data-header)) + ((equal field 'subject) + (mail-header-subject data-header)) + ((equal field 'references) + (mail-header-references data-header)) + ((equal field 'date) + (mail-header-date data-header)) + ((equal field 'xref) + (mail-header-xref data-header)) + ((equal field 'extra) + (mail-header-extra data-header)) + (t + nil)) + (gnus-message 6 "Article %d has a nil data header" article))))) + +(defun spam-fetch-field-from-fast (article &optional prepared-data-header) + (spam-fetch-field-fast article 'from prepared-data-header)) + +(defun spam-fetch-field-subject-fast (article &optional prepared-data-header) + (spam-fetch-field-fast article 'subject prepared-data-header)) + +(defun spam-fetch-field-message-id-fast (article &optional prepared-data-header) + (spam-fetch-field-fast article 'message-id prepared-data-header)) + +(defun spam-generate-fake-headers (article) + (let ((dh (spam-fetch-article-header article))) + (if dh + (concat + (format + (concat "From: %s\nSubject: %s\nMessage-ID: %s\n" + "Date: %s\nReferences: %s\nXref: %s\n") + (spam-fetch-field-fast article 'from dh) + (spam-fetch-field-fast article 'subject dh) + (spam-fetch-field-fast article 'message-id dh) + (spam-fetch-field-fast article 'date dh) + (spam-fetch-field-fast article 'references dh) + (spam-fetch-field-fast article 'xref dh)) + (when (spam-fetch-field-fast article 'extra dh) + (format "%s\n" (spam-fetch-field-fast article 'extra dh)))) + (gnus-message + 5 + "spam-generate-fake-headers: article %d didn't have a valid header" + article)))) + +(defun spam-fetch-article-header (article) + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-read-header article) + (nth 3 (assq article gnus-newsgroup-data)))) + ;;;; Spam determination. - (defvar spam-list-of-checks - '((spam-use-blacklist . spam-check-blacklist) - (spam-use-whitelist . spam-check-whitelist) - (spam-use-bbdb . spam-check-bbdb) - (spam-use-ifile . spam-check-ifile) - (spam-use-blackholes . spam-check-blackholes) - (spam-use-bogofilter . spam-check-bogofilter)) -"The spam-list-of-checks list contains pairs associating a parameter -variable with a spam checking function. If the parameter variable is -true, then the checking function is called, and its value decides what -happens. Each individual check may return `nil', `t', or a mailgroup -name. The value `nil' means that the check does not yield a decision, -and so, that further checks are needed. The value `t' means that the -message is definitely not spam, and that further spam checks should be -inhibited. Otherwise, a mailgroup name is returned where the mail -should go, and further checks are also inhibited. The usual mailgroup -name is the value of `spam-split-group', meaning that the message is + '((spam-use-blacklist . spam-check-blacklist) + (spam-use-regex-headers . spam-check-regex-headers) + (spam-use-gmane-xref . spam-check-gmane-xref) + (spam-use-regex-body . spam-check-regex-body) + (spam-use-whitelist . spam-check-whitelist) + (spam-use-BBDB . spam-check-BBDB) + (spam-use-BBDB-exclusive . spam-check-BBDB) + (spam-use-ifile . spam-check-ifile) + (spam-use-spamoracle . spam-check-spamoracle) + (spam-use-stat . spam-check-stat) + (spam-use-blackholes . spam-check-blackholes) + (spam-use-hashcash . spam-check-hashcash) + (spam-use-spamassassin-headers . spam-check-spamassassin-headers) + (spam-use-spamassassin . spam-check-spamassassin) + (spam-use-bogofilter-headers . spam-check-bogofilter-headers) + (spam-use-bogofilter . spam-check-bogofilter) + (spam-use-bsfilter-headers . spam-check-bsfilter-headers) + (spam-use-bsfilter . spam-check-bsfilter) + (spam-use-crm114 . spam-check-crm114)) + "The spam-list-of-checks list contains pairs associating a +parameter variable with a spam checking function. If the +parameter variable is true, then the checking function is called, +and its value decides what happens. Each individual check may +return nil, t, or a mailgroup name. The value nil means that the +check does not yield a decision, and so, that further checks are +needed. The value t means that the message is definitely not +spam, and that further spam checks should be inhibited. +Otherwise, a mailgroup name or the symbol 'spam (depending on +spam-split-symbolic-return) is returned where the mail should go, +and further checks are also inhibited. The usual mailgroup name +is the value of `spam-split-group', meaning that the message is definitely a spam.") -(defun spam-split () +(defvar spam-list-of-statistical-checks + '(spam-use-ifile + spam-use-regex-body + spam-use-stat + spam-use-bogofilter + spam-use-bsfilter + spam-use-blackholes + spam-use-spamassassin + spam-use-spamoracle + spam-use-crm114) + "The spam-list-of-statistical-checks list contains all the mail +splitters that need to have the full message body available. +Note that you should fetch extra headers if you don't like this, +e.g. fetch the 'Received' header for spam-use-blackholes.") + +(defun spam-split (&rest specific-checks) "Split this message into the `spam' group if it is spam. -This function can be used as an entry in `nnmail-split-fancy', for -example like this: (: spam-split) +This function can be used as an entry in the variable `nnmail-split-fancy', +for example like this: (: spam-split). It can take checks as +parameters. A string as a parameter will set the +spam-split-group to that string. See the Info node `(gnus)Fancy Mail Splitting' for more details." (interactive) + (setq spam-split-last-successful-check nil) + (unless spam-split-disabled + (let ((spam-split-group-choice spam-split-group)) + (dolist (check specific-checks) + (when (stringp check) + (setq spam-split-group-choice check) + (setq specific-checks (delq check specific-checks)))) + + (let ((spam-split-group spam-split-group-choice)) + (save-excursion + (save-restriction + (dolist (check spam-list-of-statistical-checks) + (when (and (symbolp check) + (or (symbol-value check) + (memq check specific-checks))) + (widen) + (gnus-message 8 "spam-split: widening the buffer (%s requires it)" + (symbol-name check)) + (return))) + ;; (progn (widen) (debug (buffer-string))) + (let ((list-of-checks spam-list-of-checks) + decision) + (while (and list-of-checks (not decision)) + (let ((pair (pop list-of-checks))) + (when (or + ;; either, given specific checks, this is one of them + (and specific-checks (memq (car pair) specific-checks)) + ;; or, given no specific checks, spam-use-CHECK is set + (and (null specific-checks) (symbol-value (car pair)))) + (gnus-message 6 "spam-split: calling the %s function" + (symbol-name (cdr pair))) + (setq decision (funcall (cdr pair))) + ;; if we got a decision at all, save the current check + (when decision + (setq spam-split-last-successful-check (car pair))) + + (when (eq decision 'spam) + (unless spam-split-symbolic-return + (gnus-error + 5 + (format "spam-split got %s but %s is nil" + (symbol-name decision) + (symbol-name spam-split-symbolic-return)))))))) + (if (eq decision t) + (if spam-split-symbolic-return-positive 'ham nil) + decision)))))))) + +(defun spam-find-spam () + "This function will detect spam in the current newsgroup using spam-split." + (interactive) - (let ((list-of-checks spam-list-of-checks) + (let* ((group gnus-newsgroup-name) + (autodetect (gnus-parameter-spam-autodetect group)) + (methods (gnus-parameter-spam-autodetect-methods group)) + (first-method (nth 0 methods)) + (articles (if spam-autodetect-recheck-messages + gnus-newsgroup-articles + gnus-newsgroup-unseen)) + article-cannot-be-faked) + + (dolist (check spam-list-of-statistical-checks) + (when (and (symbolp check) + (memq check methods)) + (setq article-cannot-be-faked t) + (return))) + + (when (memq 'default methods) + (setq article-cannot-be-faked t)) + + (when (and autodetect + (not (equal first-method 'none))) + (mapcar + (lambda (article) + (let ((id (spam-fetch-field-message-id-fast article)) + (subject (spam-fetch-field-subject-fast article)) + (sender (spam-fetch-field-from-fast article)) + registry-lookup) + + (unless id + (gnus-message 6 "Article %d has no message ID!" article)) + + (when (and id spam-log-to-registry) + (setq registry-lookup (spam-log-registration-type id 'incoming)) + (when registry-lookup + (gnus-message + 9 + "spam-find-spam: message %s was already registered incoming" + id))) + + (let* ((spam-split-symbolic-return t) + (spam-split-symbolic-return-positive t) + (fake-headers (spam-generate-fake-headers article)) + (split-return + (or registry-lookup + (with-temp-buffer + (if article-cannot-be-faked + (gnus-request-article-this-buffer + article + group) + ;; else, we fake the article + (when fake-headers (insert fake-headers))) + (if (or (null first-method) + (equal first-method 'default)) + (spam-split) + (apply 'spam-split methods)))))) + (if (equal split-return 'spam) + (gnus-summary-mark-article article gnus-spam-mark)) + + (when (and id split-return spam-log-to-registry) + (when (zerop (gnus-registry-group-count id)) + (gnus-registry-add-group + id group subject sender)) + + (unless registry-lookup + (spam-log-processing-to-registry + id + 'incoming + split-return + spam-split-last-successful-check + group)))))) + articles)))) + +(defvar spam-registration-functions + ;; first the ham register, second the spam register function + ;; third the ham unregister, fourth the spam unregister function + '((spam-use-blacklist nil + spam-blacklist-register-routine + nil + spam-blacklist-unregister-routine) + (spam-use-whitelist spam-whitelist-register-routine + nil + spam-whitelist-unregister-routine + nil) + (spam-use-ham-copy nil + nil + nil + nil) + (spam-use-BBDB spam-BBDB-register-routine + nil + spam-BBDB-unregister-routine + nil) + (spam-use-ifile spam-ifile-register-ham-routine + spam-ifile-register-spam-routine + spam-ifile-unregister-ham-routine + spam-ifile-unregister-spam-routine) + (spam-use-spamoracle spam-spamoracle-learn-ham + spam-spamoracle-learn-spam + spam-spamoracle-unlearn-ham + spam-spamoracle-unlearn-spam) + (spam-use-stat spam-stat-register-ham-routine + spam-stat-register-spam-routine + spam-stat-unregister-ham-routine + spam-stat-unregister-spam-routine) + ;; note that spam-use-gmane and spam-use-resend are not legitimate checks + (spam-use-gmane nil + spam-report-gmane-register-routine + ;; does Gmane support unregistration? + nil + nil) + (spam-use-resend nil + spam-report-resend-register-routine + nil + nil) + (spam-use-spamassassin spam-spamassassin-register-ham-routine + spam-spamassassin-register-spam-routine + spam-spamassassin-unregister-ham-routine + spam-spamassassin-unregister-spam-routine) + (spam-use-bogofilter spam-bogofilter-register-ham-routine + spam-bogofilter-register-spam-routine + spam-bogofilter-unregister-ham-routine + spam-bogofilter-unregister-spam-routine) + (spam-use-bsfilter spam-bsfilter-register-ham-routine + spam-bsfilter-register-spam-routine + spam-bsfilter-unregister-ham-routine + spam-bsfilter-unregister-spam-routine) + (spam-use-crm114 spam-crm114-register-ham-routine + spam-crm114-register-spam-routine + ;; does CRM114 Mailfilter support unregistration? + nil + nil)) + "The spam-registration-functions list contains pairs +associating a parameter variable with the ham and spam +registration functions, and the ham and spam unregistration +functions") + +(defun spam-classification-valid-p (classification) + (or (eq classification 'spam) + (eq classification 'ham))) + +(defun spam-process-type-valid-p (process-type) + (or (eq process-type 'incoming) + (eq process-type 'process))) + +(defun spam-registration-check-valid-p (check) + (assoc check spam-registration-functions)) + +(defun spam-unregistration-check-valid-p (check) + (assoc check spam-registration-functions)) + +(defun spam-registration-function (classification check) + (let ((flist (cdr-safe (assoc check spam-registration-functions)))) + (if (eq classification 'spam) + (nth 1 flist) + (nth 0 flist)))) + +(defun spam-unregistration-function (classification check) + (let ((flist (cdr-safe (assoc check spam-registration-functions)))) + (if (eq classification 'spam) + (nth 3 flist) + (nth 2 flist)))) + +(defun spam-list-articles (articles classification) + (let ((mark-check (if (eq classification 'spam) + 'spam-group-spam-mark-p + 'spam-group-ham-mark-p)) + alist mark-cache-yes mark-cache-no) + (dolist (article articles) + (let ((mark (gnus-summary-article-mark article))) + (unless (or (memq mark mark-cache-yes) + (memq mark mark-cache-no)) + (if (funcall mark-check + gnus-newsgroup-name + mark) + (push mark mark-cache-yes) + (push mark mark-cache-no))) + (when (memq mark mark-cache-yes) + (push article alist)))) + alist)) + +(defun spam-register-routine (classification + check + &optional unregister + specific-articles) + (when (and (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let* ((register-function + (spam-registration-function classification check)) + (unregister-function + (spam-unregistration-function classification check)) + (run-function (if unregister + unregister-function + register-function)) + (log-function (if unregister + 'spam-log-undo-registration + 'spam-log-processing-to-registry)) + article articles) + + (when run-function + ;; make list of articles, using specific-articles if given + (setq articles (or specific-articles + (spam-list-articles + gnus-newsgroup-articles + classification))) + ;; process them + (gnus-message 5 "%s %d %s articles as %s using backend %s" + (if unregister "Unregistering" "Registering") + (length articles) + (if specific-articles "specific" "") + (symbol-name classification) + (symbol-name check)) + (funcall run-function articles) + ;; now log all the registrations (or undo them, depending on unregister) + (dolist (article articles) + (funcall log-function + (spam-fetch-field-message-id-fast article) + 'process + classification + check + gnus-newsgroup-name)))))) + +;;; log a ham- or spam-processor invocation to the registry +(defun spam-log-processing-to-registry (id type classification check group) + (when spam-log-to-registry + (if (and (stringp id) + (stringp group) + (spam-process-type-valid-p type) + (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + (cell (list classification check group))) + (push cell cell-list) + (gnus-registry-store-extra-entry + id + type + cell-list)) + + (gnus-message + 5 + (format "%s call with bad ID, type, classification, spam-check, or group" + "spam-log-processing-to-registry"))))) + +;;; check if a ham- or spam-processor registration has been done +(defun spam-log-registered-p (id type) + (when spam-log-to-registry + (if (and (stringp id) + (spam-process-type-valid-p type)) + (cdr-safe (gnus-registry-fetch-extra id type)) + (progn + (gnus-message + 5 + (format "%s called with bad ID, type, classification, or spam-check" + "spam-log-registered-p")) + nil)))) + +;;; check what a ham- or spam-processor registration says +;;; returns nil if conflicting registrations are found +(defun spam-log-registration-type (id type) + (let ((count 0) decision) - (while (and list-of-checks (not decision)) - (let ((pair (pop list-of-checks))) - (when (eval (car pair)) - (setq decision (apply (cdr pair)))))) - (if (eq decision t) + (dolist (reg (spam-log-registered-p id type)) + (let ((classification (nth 0 reg))) + (when (spam-classification-valid-p classification) + (when (and decision + (not (eq classification decision))) + (setq count (+ 1 count))) + (setq decision classification)))) + (if (< 0 count) nil decision))) + + +;;; check if a ham- or spam-processor registration needs to be undone +(defun spam-log-unregistration-needed-p (id type classification check) + (when spam-log-to-registry + (if (and (stringp id) + (spam-process-type-valid-p type) + (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + found) + (dolist (cell cell-list) + (unless found + (when (and (eq classification (nth 0 cell)) + (eq check (nth 1 cell))) + (setq found t)))) + found) + (progn + (gnus-message + 5 + (format "%s called with bad ID, type, classification, or spam-check" + "spam-log-unregistration-needed-p")) + nil)))) + + +;;; undo a ham- or spam-processor registration (the group is not used) +(defun spam-log-undo-registration (id type classification check &optional group) + (when (and spam-log-to-registry + (spam-log-unregistration-needed-p id type classification check)) + (if (and (stringp id) + (spam-process-type-valid-p type) + (spam-classification-valid-p classification) + (spam-registration-check-valid-p check)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + new-cell-list found) + (dolist (cell cell-list) + (unless (and (eq classification (nth 0 cell)) + (eq check (nth 1 cell))) + (push cell new-cell-list))) + (gnus-registry-store-extra-entry + id + type + new-cell-list)) + (progn + (gnus-message 6 (format "%s call with bad ID, type, spam-check, or group" + "spam-log-undo-registration")) + nil)))) + +;;; set up IMAP widening if it's necessary +(defun spam-setup-widening () + (dolist (check spam-list-of-statistical-checks) + (when (symbol-value check) + (setq nnimap-split-download-body-default t)))) + + +;;;; Gmane xrefs +(defun spam-check-gmane-xref () + (let ((header (or + (message-fetch-field "Xref") + (message-fetch-field "Newsgroups"))) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (when (string-match spam-gmane-xref-spam-group + header) + spam-split-group)))) + + +;;;; Regex body + +(defun spam-check-regex-body () + (let ((spam-regex-headers-ham spam-regex-body-ham) + (spam-regex-headers-spam spam-regex-body-spam)) + (spam-check-regex-headers t))) + + +;;;; Regex headers + +(defun spam-check-regex-headers (&optional body) + (let ((type (if body "body" "header")) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) + ret found) + (dolist (h-regex spam-regex-headers-ham) + (unless found + (goto-char (point-min)) + (when (re-search-forward h-regex nil t) + (message "Ham regex %s search positive." type) + (setq found t)))) + (dolist (s-regex spam-regex-headers-spam) + (unless found + (goto-char (point-min)) + (when (re-search-forward s-regex nil t) + (message "Spam regex %s search positive." type) + (setq found t) + (setq ret spam-split-group)))) + ret)) + ;;;; Blackholes. -(defvar spam-blackhole-servers '("bl.spamcop.net" - "relays.ordb.org" - "dev.null.dk" - "relays.visi.com" - "rbl.maps.vix.com") - "List of blackhole servers.") +(defun spam-reverse-ip-string (ip) + (when (stringp ip) + (mapconcat 'identity + (nreverse (split-string ip "\\.")) + "."))) (defun spam-check-blackholes () - "Check the Receieved headers for blackholed relays." + "Check the Received headers for blackholed relays." (let ((headers (message-fetch-field "received")) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) ips matches) (when headers (with-temp-buffer (insert headers) (goto-char (point-min)) + (gnus-message 6 "Checking headers for relay addresses") (while (re-search-forward - "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t) - (message "Blackhole search found host IP %s." (match-string 1)) - (push (mapconcat 'identity - (nreverse (split-string (match-string 1) "\\.")) - ".") + "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) + (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) + (push (spam-reverse-ip-string (match-string 1)) ips))) (dolist (server spam-blackhole-servers) (dolist (ip ips) - (when (query-dns (concat ip "." server)) - (push (list ip server (query-dns (concat ip "." server) 'TXT)) - matches))))) + (unless (and spam-blackhole-good-server-regex + ;; match the good-server-regex against the reversed (again) IP string + (string-match + spam-blackhole-good-server-regex + (spam-reverse-ip-string ip))) + (unless matches + (let ((query-string (concat ip "." server))) + (if spam-use-dig + (let ((query-result (query-dig query-string))) + (when query-result + (gnus-message 6 "(DIG): positive blackhole check '%s'" + query-result) + (push (list ip server query-result) + matches))) + ;; else, if not using dig.el + (when (query-dns query-string) + (gnus-message 6 "positive blackhole check") + (push (list ip server (query-dns query-string 'TXT)) + matches))))))))) (when matches spam-split-group))) -;;;; Blacklists and whitelists. +;;;; Hashcash. -(defvar spam-directory "~/News/spam/" - "When spam files are kept.") - -(defvar spam-whitelist (expand-file-name "whitelist" spam-directory) - "The location of the whitelist. -The file format is one regular expression per line. -The regular expression is matched against the address.") - -(defvar spam-blacklist (expand-file-name "blacklist" spam-directory) - "The location of the blacklist. -The file format is one regular expression per line. -The regular expression is matched against the address.") +(condition-case nil + (progn + (require 'hashcash) -(defvar spam-whitelist-cache nil) -(defvar spam-blacklist-cache nil) + (defun spam-check-hashcash () + "Check the headers for hashcash payments." + (mail-check-payment))) ;mail-check-payment returns a boolean -(defun spam-enter-whitelist (address) - "Enter ADDRESS into the whitelist." - (interactive "sAddress: ") - (spam-enter-list address spam-whitelist) - (setq spam-whitelist-cache nil)) + (file-error (progn + (defalias 'mail-check-payment 'ignore) + (defalias 'spam-check-hashcash 'ignore)))) + +;;;; BBDB -(defun spam-enter-blacklist (address) - "Enter ADDRESS into the blacklist." - (interactive "sAddress: ") - (spam-enter-list address spam-blacklist) - (setq spam-blacklist-cache nil)) +;;; original idea for spam-check-BBDB from Alexander Kotelnikov +;;; -(defun spam-enter-list (address file) - "Enter ADDRESS into the given FILE, either the whitelist or the blacklist." - (unless (file-exists-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (save-excursion - (set-buffer - (find-file-noselect file)) - (goto-char (point-max)) - (unless (bobp) - (insert "\n")) - (insert address "\n") - (save-buffer))) - -;;; returns nil if the sender is in the whitelist, spam-split-group otherwise -(defun spam-check-whitelist () - ;; FIXME! Should it detect when file timestamps change? - (unless spam-whitelist-cache - (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) - (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group)) +;; all this is done inside a condition-case to trap errors -;;; original idea from Alexander Kotelnikov (condition-case nil (progn + (require 'bbdb) (require 'bbdb-com) - (defun spam-check-bbdb () - "We want messages from people who are in the BBDB not to be split to spam" - (let ((who (message-fetch-field "from"))) + + ;; when the BBDB changes, we want to clear out our cache + (defun spam-clear-cache-BBDB (&rest immaterial) + (spam-clear-cache 'spam-use-BBDB)) + + (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB) + + (defun spam-enter-ham-BBDB (addresses &optional remove) + "Enter an address into the BBDB; implies ham (non-spam) sender" + (dolist (from addresses) + (when (stringp from) + (let* ((parsed-address (gnus-extract-address-components from)) + (name (or (nth 0 parsed-address) "Ham Sender")) + (remove-function (if remove + 'bbdb-delete-record-internal + 'ignore)) + (net-address (nth 1 parsed-address)) + (record (and net-address + (bbdb-search-simple nil net-address)))) + (when net-address + (gnus-message 6 "%s address %s %s BBDB" + (if remove "Deleting" "Adding") + from + (if remove "from" "to")) + (if record + (funcall remove-function record) + (bbdb-create-internal name nil net-address nil nil + "ham sender added by spam.el"))))))) + + (defun spam-BBDB-register-routine (articles &optional unregister) + (let (addresses) + (dolist (article articles) + (when (stringp (spam-fetch-field-from-fast article)) + (push (spam-fetch-field-from-fast article) addresses))) + ;; now do the register/unregister action + (spam-enter-ham-BBDB addresses unregister))) + + (defun spam-BBDB-unregister-routine (articles) + (spam-BBDB-register-routine articles t)) + + (defun spam-check-BBDB () + "Mail from people in the BBDB is classified as ham or non-spam" + (let ((who (message-fetch-field "from")) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) + bbdb-cache bbdb-hashtable) + (when spam-cache-lookups + (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches)) + (unless bbdb-cache + (setq bbdb-cache + ;; this is the expanded (bbdb-hashtable) macro + ;; without the debugging support + (with-current-buffer (bbdb-buffer) + (save-excursion + (save-window-excursion + (bbdb-records nil t) + bbdb-hashtable)))) + (puthash 'spam-use-BBDB bbdb-cache spam-caches))) (when who - (setq who (regexp-quote (cadr (gnus-extract-address-components who)))) - (if (bbdb-search (bbdb-records) nil nil who) nil spam-split-group))))) - (file-error (setq spam-list-of-checks - (delete (assoc 'spam-use-bbdb spam-list-of-checks) - spam-list-of-checks)))) + (setq who (nth 1 (gnus-extract-address-components who))) + (if + (if spam-cache-lookups + (symbol-value + (intern-soft who bbdb-cache)) + (bbdb-search-simple nil who)) + t + (if spam-use-BBDB-exclusive + spam-split-group + nil)))))) + + (file-error (progn + (defalias 'bbdb-search-simple 'ignore) + (defalias 'bbdb-records 'ignore) + (defalias 'bbdb-buffer 'ignore) + (defalias 'spam-check-BBDB 'ignore) + (defalias 'spam-BBDB-register-routine 'ignore) + (defalias 'spam-enter-ham-BBDB 'ignore) + (defalias 'bbdb-create-internal 'ignore) + (defalias 'bbdb-delete-record-internal 'ignore) + (defalias 'bbdb-records 'ignore)))) + + +;;;; ifile + +;;; check the ifile backend; return nil if the mail was NOT classified +;;; as spam + +(defun spam-get-ifile-database-parameter () + "Get the command-line parameter for ifile's database from + spam-ifile-database-path." + (if spam-ifile-database-path + (format "--db-file=%s" spam-ifile-database-path) + nil)) + +(defun spam-check-ifile () + "Check the ifile backend for the classification of this message." + (let ((article-buffer-name (buffer-name)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) + category return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name)) + (db-param (spam-get-ifile-database-parameter))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) spam-ifile-path + nil temp-buffer-name nil "-c" + (if db-param `(,db-param "-q") `("-q")))) + ;; check the return now (we're back in the temp buffer) + (goto-char (point-min)) + (if (not (eobp)) + (setq category (buffer-substring (point) (point-at-eol)))) + (when (not (zerop (length category))) ; we need a category here + (if spam-ifile-all-categories + (setq return category) + ;; else, if spam-ifile-all-categories is not set... + (when (string-equal spam-ifile-spam-category category) + (setq return spam-split-group)))))) ; note return is nil otherwise + return)) + +(defun spam-ifile-register-with-ifile (articles category &optional unregister) + "Register an article, given as a string, with a category. +Uses `gnus-newsgroup-name' if category is nil (for ham registration)." + (let ((category (or category gnus-newsgroup-name)) + (add-or-delete-option (if unregister "-d" "-i")) + (db (spam-get-ifile-database-parameter)) + parameters) + (with-temp-buffer + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (when (stringp article-string) + (insert article-string)))) + (apply 'call-process-region + (point-min) (point-max) spam-ifile-path + nil nil nil + add-or-delete-option category + (if db `(,db "-h") `("-h")))))) + +(defun spam-ifile-register-spam-routine (articles &optional unregister) + (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister)) + +(defun spam-ifile-unregister-spam-routine (articles) + (spam-ifile-register-spam-routine articles t)) + +(defun spam-ifile-register-ham-routine (articles &optional unregister) + (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister)) + +(defun spam-ifile-unregister-ham-routine (articles) + (spam-ifile-register-ham-routine articles t)) + + +;;;; spam-stat -;;; check the ifile backend; return nil if the mail was NOT classified as spam (condition-case nil (progn - (require 'ifile-gnus) - ;;; - (defun spam-check-ifile () - (let ((ifile-primary-spam-group spam-split-group)) - (ifile-spam-filter nil)))) - (file-error (setq spam-list-of-checks - (delete (assoc 'spam-use-ifile spam-list-of-checks) - spam-list-of-checks)))) + (let ((spam-stat-install-hooks nil)) + (require 'spam-stat)) + + (defun spam-check-stat () + "Check the spam-stat backend for the classification of this message" + (let ((spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group)) + (spam-stat-split-fancy-spam-group spam-split-group) ; override + (spam-stat-buffer (buffer-name)) ; stat the current buffer + category return) + (spam-stat-split-fancy))) + + (defun spam-stat-register-spam-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-non-spam) + (spam-stat-buffer-is-spam)))))) + + (defun spam-stat-unregister-spam-routine (articles) + (spam-stat-register-spam-routine articles t)) + + (defun spam-stat-register-ham-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-spam) + (spam-stat-buffer-is-non-spam)))))) + + (defun spam-stat-unregister-ham-routine (articles) + (spam-stat-register-ham-routine articles t)) + + (defun spam-maybe-spam-stat-load () + (when spam-use-stat (spam-stat-load))) + + (defun spam-maybe-spam-stat-save () + (when spam-use-stat (spam-stat-save)))) + + (file-error (progn + (defalias 'spam-stat-load 'ignore) + (defalias 'spam-stat-save 'ignore) + (defalias 'spam-maybe-spam-stat-load 'ignore) + (defalias 'spam-maybe-spam-stat-save 'ignore) + (defalias 'spam-stat-register-ham-routine 'ignore) + (defalias 'spam-stat-unregister-ham-routine 'ignore) + (defalias 'spam-stat-register-spam-routine 'ignore) + (defalias 'spam-stat-unregister-spam-routine 'ignore) + (defalias 'spam-stat-buffer-is-spam 'ignore) + (defalias 'spam-stat-buffer-change-to-spam 'ignore) + (defalias 'spam-stat-buffer-is-non-spam 'ignore) + (defalias 'spam-stat-buffer-change-to-non-spam 'ignore) + (defalias 'spam-stat-split-fancy 'ignore) + (defalias 'spam-check-stat 'ignore)))) -(defun spam-check-blacklist () + + +;;;; Blacklists and whitelists. + +(defvar spam-whitelist-cache nil) +(defvar spam-blacklist-cache nil) + +(defun spam-kill-whole-line () + (beginning-of-line) + (let ((kill-whole-line t)) + (kill-line))) + +;;; address can be a list, too +(defun spam-enter-whitelist (address &optional remove) + "Enter ADDRESS (list or single) into the whitelist. +With a non-nil REMOVE, remove them." + (interactive "sAddress: ") + (spam-enter-list address spam-whitelist remove) + (setq spam-whitelist-cache nil) + (spam-clear-cache 'spam-use-whitelist)) + +;;; address can be a list, too +(defun spam-enter-blacklist (address &optional remove) + "Enter ADDRESS (list or single) into the blacklist. +With a non-nil REMOVE, remove them." + (interactive "sAddress: ") + (spam-enter-list address spam-blacklist remove) + (setq spam-blacklist-cache nil) + (spam-clear-cache 'spam-use-whitelist)) + +(defun spam-enter-list (addresses file &optional remove) + "Enter ADDRESSES into the given FILE. +Either the whitelist or the blacklist files can be used. With +REMOVE not nil, remove the ADDRESSES." + (if (stringp addresses) + (spam-enter-list (list addresses) file remove) + ;; else, we have a list of addresses here + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (save-excursion + (set-buffer + (find-file-noselect file)) + (dolist (a addresses) + (when (stringp a) + (goto-char (point-min)) + (if (re-search-forward (regexp-quote a) nil t) + ;; found the address + (when remove + (spam-kill-whole-line)) + ;; else, the address was not found + (unless remove + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert a "\n"))))) + (save-buffer)))) + +(defun spam-filelist-build-cache (type) + (let ((cache (if (eq type 'spam-use-blacklist) + spam-blacklist-cache + spam-whitelist-cache)) + parsed-cache) + (unless (gethash type spam-caches) + (while cache + (let ((address (pop cache))) + (unless (zerop (length address)) ; 0 for a nil address too + (setq address (regexp-quote address)) + ;; fix regexp-quote's treatment of user-intended regexes + (while (string-match "\\\\\\*" address) + (setq address (replace-match ".*" t t address)))) + (push address parsed-cache))) + (puthash type parsed-cache spam-caches)))) + +(defun spam-filelist-check-cache (type from) + (when (stringp from) + (spam-filelist-build-cache type) + (let (found) + (dolist (address (gethash type spam-caches)) + (when (and address (string-match address from)) + (setq found t) + (return))) + found))) + +;;; returns t if the sender is in the whitelist, nil or +;;; spam-split-group otherwise +(defun spam-check-whitelist () ;; FIXME! Should it detect when file timestamps change? - (unless spam-blacklist-cache - (setq spam-blacklist-cache (spam-parse-list spam-blacklist))) - (and (spam-from-listed-p spam-blacklist-cache) spam-split-group)) + (let ((spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (unless spam-whitelist-cache + (setq spam-whitelist-cache (spam-parse-list spam-whitelist))) + (if (spam-from-listed-p 'spam-use-whitelist) + t + (if spam-use-whitelist-exclusive + spam-split-group + nil)))) -(eval-and-compile - (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position))) +(defun spam-check-blacklist () + ;; FIXME! Should it detect when file timestamps change? + (let ((spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (unless spam-blacklist-cache + (setq spam-blacklist-cache (spam-parse-list spam-blacklist))) + (and (spam-from-listed-p 'spam-use-blacklist) spam-split-group))) (defun spam-parse-list (file) (when (file-readable-p file) @@ -325,250 +2035,537 @@ The regular expression is matched against the address.") (with-temp-buffer (insert-file-contents file) (while (not (eobp)) - (setq address (buffer-substring (point) (spam-point-at-eol))) + (setq address (buffer-substring (point) (point-at-eol))) (forward-line 1) + ;; insert the e-mail address if detected, otherwise the raw data (unless (zerop (length address)) - (setq address (regexp-quote address)) - (while (string-match "\\\\\\*" address) - (setq address (replace-match ".*" t t address))) - (push address contents)))) + (let ((pure-address (nth 1 (gnus-extract-address-components address)))) + (push (or pure-address address) contents))))) (nreverse contents)))) -(defun spam-from-listed-p (cache) +(defun spam-from-listed-p (type) (let ((from (message-fetch-field "from")) found) - (while cache - (when (string-match (pop cache) from) - (setq found t - cache nil))) - found)) + (spam-filelist-check-cache type from))) + +(defun spam-filelist-register-routine (articles blacklist &optional unregister) + (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist)) + (declassification (if blacklist 'ham 'spam)) + (enter-function + (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) + (remove-function + (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) + from addresses unregister-list article-unregister-list) + (dolist (article articles) + (let ((from (spam-fetch-field-from-fast article)) + (id (spam-fetch-field-message-id-fast article)) + sender-ignored) + (when (stringp from) + (dolist (ignore-regex spam-blacklist-ignored-regexes) + (when (and (not sender-ignored) + (stringp ignore-regex) + (string-match ignore-regex from)) + (setq sender-ignored t))) + ;; remember the messages we need to unregister, unless remove is set + (when (and + (null unregister) + (spam-log-unregistration-needed-p + id 'process declassification de-symbol)) + (push article article-unregister-list) + (push from unregister-list)) + (unless sender-ignored + (push from addresses))))) + + (if unregister + (funcall enter-function addresses t) ; unregister all these addresses + ;; else, register normally and unregister what we need to + (funcall remove-function unregister-list t) + (dolist (article article-unregister-list) + (spam-log-undo-registration + (spam-fetch-field-message-id-fast article) + 'process + declassification + de-symbol)) + (funcall enter-function addresses nil)))) + +(defun spam-blacklist-unregister-routine (articles) + (spam-blacklist-register-routine articles t)) + +(defun spam-blacklist-register-routine (articles &optional unregister) + (spam-filelist-register-routine articles t unregister)) + +(defun spam-whitelist-unregister-routine (articles) + (spam-whitelist-register-routine articles t)) + +(defun spam-whitelist-register-routine (articles &optional unregister) + (spam-filelist-register-routine articles nil unregister)) + -;;;; Training via Bogofilter. Last updated 2002-09-02. - -;;; See Paul Graham article, at `http://www.paulgraham.com/spam.html'. - -;;; This page is for those wanting to control spam with the help of Eric -;;; Raymond's speedy Bogofilter, see http://www.tuxedo.org/~esr/bogofilter. -;;; This has been tested with a locally patched copy of version 0.4. - -;;; Make sure Bogofilter is installed. Bogofilter internally uses Judy fast -;;; associative arrays, so you need to install Judy first, and Bogofilter -;;; next. Fetch both distributions by visiting the following links and -;;; downloading the latest version of each: -;;; -;;; http://sourceforge.net/projects/judy/ -;;; http://www.tuxedo.org/~esr/bogofilter/ -;;; -;;; Unpack the Judy distribution and enter its main directory. Then do: -;;; -;;; ./configure -;;; make -;;; make install -;;; -;;; You will likely need to become super-user for the last step. Then, unpack -;;; the Bogofilter distribution and enter its main directory: -;;; -;;; make -;;; make install -;;; -;;; Here as well, you need to become super-user for the last step. Now, -;;; initialises your word lists by doing, under your own identity: -;;; -;;; mkdir ~/.bogofilter -;;; touch ~/.bogofilter/badlist -;;; touch ~/.bogofilter/goodlist -;;; -;;; These two files are text files you may edit, but you normally don't! - -;;; The `M-d' command gets added to Gnus summary mode, marking current article -;;; as spam, showing it with the `H' mark. Whenever you see a spam article, -;;; make sure to mark its summary line with `M-d' before leaving the group. -;;; Some groups, as per variable `spam-junk-mailgroups' below, receive articles -;;; from Gnus splitting on clues added by spam recognisers, so for these -;;; groups, we tack an `H' mark at group entry for all summary lines which -;;; would otherwise have no other mark. Make sure to _remove_ `H' marks for -;;; any article which is _not_ genuine spam, before leaving such groups: you -;;; may use `M-u' to "unread" the article, or `d' for declaring it read the -;;; non-spam way. When you leave a group, all `H' marked articles, saved or -;;; unsaved, are sent to Bogofilter which will study them as spam samples. - -;;; Messages may also be deleted in various other ways, and unless -;;; `spam-ham-marks-form' gets overridden below, marks `R' and `r' for default -;;; read or explicit delete, marks `X' and 'K' for automatic or explicit -;;; kills, as well as mark `Y' for low scores, are all considered to be -;;; associated with articles which are not spam. This assumption might be -;;; false, in particular if you use kill files or score files as means for -;;; detecting genuine spam, you should then adjust `spam-ham-marks-form'. When -;;; you leave a group, all _unsaved_ articles bearing any the above marks are -;;; sent to Bogofilter which will study these as not-spam samples. If you -;;; explicit kill a lot, you might sometimes end up with articles marked `K' -;;; which you never saw, and which might accidentally contain spam. Best is -;;; to make sure that real spam is marked with `H', and nothing else. - -;;; All other marks do not contribute to Bogofilter pre-conditioning. In -;;; particular, ticked, dormant or souped articles are likely to contribute -;;; later, when they will get deleted for real, so there is no need to use -;;; them prematurely. Explicitly expired articles do not contribute, command -;;; `E' is a way to get rid of an article without Bogofilter ever seeing it. - -;;; In a word, with a minimum of care for associating the `H' mark for spam -;;; articles only, Bogofilter training all gets fairly automatic. You should -;;; do this until you get a few hundreds of articles in each category, spam -;;; or not. The shell command `head -1 ~/.bogofilter/*' shows both article -;;; counts. The command `S S' in summary mode, either for debugging or for -;;; curiosity, triggers Bogofilter into displaying in another buffer the -;;; "spamicity" score of the current article (between 0.0 and 1.0), together -;;; with the article words which most significantly contribute to the score. - -;;; The real way for using Bogofilter, however, is to have some use tool like -;;; `procmail' for invoking it on message reception, then adding some -;;; recognisable header in case of detected spam. Gnus splitting rules might -;;; later trip on these added headers and react by sorting such articles into -;;; specific junk folders as per `spam-junk-mailgroups'. Here is a possible -;;; `.procmailrc' contents (still untested -- please tell me how it goes): -;;; -;;; :0HBf: -;;; * ? bogofilter -;;; | formail -bfI "X-Spam-Status: Yes" - -(defvar spam-output-buffer-name "*Bogofilter Output*" - "Name of buffer when displaying `bogofilter -v' output.") - -(defvar spam-spaminfo-header-regexp - ;; FIXME! In the following regexp, we should explain which tool produces - ;; which kind of header. I do not even remember them all by now. X-Junk - ;; (and previously X-NoSpam) are produced by the `NoSpam' tool, which has - ;; never been published, so it might not be reasonable leaving it in the - ;; list. - "^X-\\(jf\\|Junk\\|NoSpam\\|Spam\\|SB\\)[^:]*:" - "Regexp for spam markups in headers. -Markup from spam recognisers, as well as `Xref', are to be removed from -articles before they get registered by Bogofilter.") - -(defvar spam-bogofilter-path (executable-find "bogofilter") - "File path of the Bogofilter executable program. -Force this variable to nil if you want to inhibit the functionality.") - -(defun spam-check-bogofilter () - ;; Dynamic spam check. I do not know how to check the exit status, - ;; so instead, read `bogofilter -v' output. - (when (and spam-use-bogofilter spam-bogofilter-path) - (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number))) - (when (save-excursion - (set-buffer spam-output-buffer-name) - (goto-char (point-min)) - (re-search-forward "Spamicity: \\(0\\.9\\|1\\.0\\)" nil t)) - spam-split-group))) +;;;; Spam-report glue +(defun spam-report-gmane-register-routine (articles) + (when articles + (apply 'spam-report-gmane articles))) + +(defun spam-report-resend-register-routine (articles) + (let ((spam-report-resend-to (gnus-parameter-spam-resend-to gnus-newsgroup-name))) + (spam-report-resend articles))) + + +;;;; Bogofilter +(defun spam-check-bogofilter-headers (&optional score) + (let ((header (message-fetch-field spam-bogofilter-header)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (if score ; scoring mode + (if (string-match "spamicity=\\([0-9.]+\\)" header) + (match-string 1 header) + "0") + ;; spam detection mode + (when (string-match spam-bogofilter-bogosity-positive-spam-header + header) + spam-split-group))))) + +;; return something sensible if the score can't be determined +(defun spam-bogofilter-score (&optional recheck) + "Get the Bogofilter spamicity score" + (interactive "P") + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (unless recheck + (spam-check-bogofilter-headers t)) + (spam-check-bogofilter t)))) + (gnus-summary-show-article) + (message "Spamicity score %s" score) + (or score "0")))) + +(defun spam-check-bogofilter (&optional score) + "Check the Bogofilter backend for the classification of this message" + (let ((article-buffer-name (buffer-name)) + (db spam-bogofilter-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-bogofilter-path + nil temp-buffer-name nil + (if db `("-d" ,db "-v") `("-v")))) + (setq return (spam-check-bogofilter-headers score)))) + return)) + +(defun spam-bogofilter-register-with-bogofilter (articles + spam + &optional unregister) + "Register an article, given as a string, as spam or non-spam." + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (db spam-bogofilter-database-directory) + (switch (if unregister + (if spam + spam-bogofilter-spam-strong-switch + spam-bogofilter-ham-strong-switch) + (if spam + spam-bogofilter-spam-switch + spam-bogofilter-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + + (apply 'call-process-region + (point-min) (point-max) + spam-bogofilter-path + nil nil nil switch + (if db `("-d" ,db "-v") `("-v")))))))) + +(defun spam-bogofilter-register-spam-routine (articles &optional unregister) + (spam-bogofilter-register-with-bogofilter articles t unregister)) + +(defun spam-bogofilter-unregister-spam-routine (articles) + (spam-bogofilter-register-spam-routine articles t)) + +(defun spam-bogofilter-register-ham-routine (articles &optional unregister) + (spam-bogofilter-register-with-bogofilter articles nil unregister)) + +(defun spam-bogofilter-unregister-ham-routine (articles) + (spam-bogofilter-register-ham-routine articles t)) + + + +;;;; spamoracle +(defun spam-check-spamoracle () + "Run spamoracle on an article to determine whether it's spam." + (let ((article-buffer-name (buffer-name)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (let ((status + (apply 'call-process-region + (point-min) (point-max) + spam-spamoracle-binary + nil temp-buffer-name nil + (if spam-spamoracle-database + `("-f" ,spam-spamoracle-database "mark") + '("mark"))))) + (if (eq 0 status) + (progn + (set-buffer temp-buffer-name) + (goto-char (point-min)) + (when (re-search-forward "^X-Spam: yes;" nil t) + spam-split-group)) + (error "Error running spamoracle: %s" status)))))))) + +(defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) + "Run spamoracle in training mode." + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (goto-char (point-min)) + (dolist (article articles) + (insert (spam-get-article-as-string article))) + (let* ((arg (if (spam-xor unregister article-is-spam-p) + "-spam" + "-good")) + (status + (apply 'call-process-region + (point-min) (point-max) + spam-spamoracle-binary + nil temp-buffer-name nil + (if spam-spamoracle-database + `("-f" ,spam-spamoracle-database + "add" ,arg) + `("add" ,arg))))) + (unless (eq 0 status) + (error "Error running spamoracle: %s" status))))))) + +(defun spam-spamoracle-learn-ham (articles &optional unregister) + (spam-spamoracle-learn articles nil unregister)) + +(defun spam-spamoracle-unlearn-ham (articles &optional unregister) + (spam-spamoracle-learn-ham articles t)) + +(defun spam-spamoracle-learn-spam (articles &optional unregister) + (spam-spamoracle-learn articles t unregister)) + +(defun spam-spamoracle-unlearn-spam (articles &optional unregister) + (spam-spamoracle-learn-spam articles t)) -(defun spam-bogofilter-score () - "Use `bogofilter -v' on the current article. -This yields the 15 most discriminant words for this article and the -spamicity coefficient of each, and the overall article spamicity." + +;;;; SpamAssassin +;;; based mostly on the bogofilter code +(defun spam-check-spamassassin-headers (&optional score) + "Check the SpamAssassin headers for the classification of this message." + (if score ; scoring mode + (let ((header (message-fetch-field spam-spamassassin-spam-status-header))) + (when header + (if (string-match "hits=\\(-?[0-9.]+\\)" header) + (match-string 1 header) + "0"))) + ;; spam detection mode + (let ((header (message-fetch-field spam-spamassassin-spam-flag-header)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (when (string-match spam-spamassassin-positive-spam-flag-header + header) + spam-split-group))))) + +(defun spam-check-spamassassin (&optional score) + "Check the SpamAssassin backend for the classification of this message." + (let ((article-buffer-name (buffer-name))) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) spam-spamassassin-path + nil temp-buffer-name nil spam-spamassassin-arguments)) + ;; check the return now (we're back in the temp buffer) + (goto-char (point-min)) + (spam-check-spamassassin-headers score))))) + +;; return something sensible if the score can't be determined +(defun spam-spamassassin-score (&optional recheck) + "Get the SpamAssassin score" + (interactive "P") + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (unless recheck + (spam-check-spamassassin-headers t)) + (spam-check-spamassassin t)))) + (gnus-summary-show-article) + (message "SpamAssassin score %s" score) + (or score "0")))) + +(defun spam-spamassassin-register-with-sa-learn (articles spam + &optional unregister) + "Register articles with spamassassin's sa-learn as spam or non-spam." + (if articles + (let ((action (if unregister spam-sa-learn-unregister-switch + (if spam spam-sa-learn-spam-switch + spam-sa-learn-ham-switch))) + (summary-buffer-name (buffer-name))) + (with-temp-buffer + ;; group the articles into mbox format + (dolist (article articles) + (let (article-string) + (save-excursion + (set-buffer summary-buffer-name) + (setq article-string (spam-get-article-as-string article))) + (when (stringp article-string) + (insert "From \n") ; mbox separator (sa-learn only checks the + ; first five chars, so we can get away with + ; a bogus line)) + (insert article-string) + (insert "\n")))) + ;; call sa-learn on all messages at the same time + (apply 'call-process-region + (point-min) (point-max) + spam-sa-learn-path + nil nil nil "--mbox" + (if spam-sa-learn-rebuild + (list action) + `("--no-rebuild" ,action))))))) + +(defun spam-spamassassin-register-spam-routine (articles &optional unregister) + (spam-spamassassin-register-with-sa-learn articles t unregister)) + +(defun spam-spamassassin-register-ham-routine (articles &optional unregister) + (spam-spamassassin-register-with-sa-learn articles nil unregister)) + +(defun spam-spamassassin-unregister-spam-routine (articles) + (spam-spamassassin-register-with-sa-learn articles t t)) + +(defun spam-spamassassin-unregister-ham-routine (articles) + (spam-spamassassin-register-with-sa-learn articles nil t)) + + +;;;; Bsfilter +;;; based mostly on the bogofilter code +(defun spam-check-bsfilter-headers (&optional score) + (if score + (or (nnmail-fetch-field spam-bsfilter-probability-header) + "0") + (let ((header (nnmail-fetch-field spam-bsfilter-header)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (when (string-match "YES" header) + spam-split-group))))) + +;; return something sensible if the score can't be determined +(defun spam-bsfilter-score (&optional recheck) + "Get the Bsfilter spamicity score" + (interactive "P") + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (unless recheck + (spam-check-bsfilter-headers t)) + (spam-check-bsfilter t)))) + (gnus-summary-show-article) + (message "Spamicity score %s" score) + (or score "0")))) + +(defun spam-check-bsfilter (&optional score) + "Check the Bsfilter backend for the classification of this message" + (let ((article-buffer-name (buffer-name)) + (dir spam-bsfilter-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-bsfilter-path + nil temp-buffer-name nil + "--pipe" + "--insert-flag" + "--insert-probability" + (when dir + (list "--homedir" dir)))) + (setq return (spam-check-bsfilter-headers score)))) + return)) + +(defun spam-bsfilter-register-with-bsfilter (articles + spam + &optional unregister) + "Register an article, given as a string, as spam or non-spam." + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (switch (if unregister + (if spam + spam-bsfilter-spam-strong-switch + spam-bsfilter-ham-strong-switch) + (if spam + spam-bsfilter-spam-switch + spam-bsfilter-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + (apply 'call-process-region + (point-min) (point-max) + spam-bsfilter-path + nil nil nil switch + "--update" + (when spam-bsfilter-database-directory + (list "--homedir" + spam-bsfilter-database-directory)))))))) + +(defun spam-bsfilter-register-spam-routine (articles &optional unregister) + (spam-bsfilter-register-with-bsfilter articles t unregister)) + +(defun spam-bsfilter-unregister-spam-routine (articles) + (spam-bsfilter-register-spam-routine articles t)) + +(defun spam-bsfilter-register-ham-routine (articles &optional unregister) + (spam-bsfilter-register-with-bsfilter articles nil unregister)) + +(defun spam-bsfilter-unregister-ham-routine (articles) + (spam-bsfilter-register-ham-routine articles t)) + + +;;;; CRM114 Mailfilter +(defun spam-check-crm114-headers (&optional score) + (let ((header (message-fetch-field spam-crm114-header)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (if score ; scoring mode + (if (string-match "( pR: \\([0-9.-]+\\)" header) + (match-string 1 header) + "0") + ;; spam detection mode + (when (string-match spam-crm114-positive-spam-header + header) + spam-split-group))))) + +;; return something sensible if the score can't be determined +(defun spam-crm114-score () + "Get the CRM114 Mailfilter pR" (interactive) - (when (and spam-use-bogofilter spam-bogofilter-path) - (spam-bogofilter-articles nil "-v" (list (gnus-summary-article-number))) - (save-excursion - (set-buffer spam-output-buffer-name) - (unless (= (point-min) (point-max)) - (display-message-or-buffer (current-buffer) - spam-output-buffer-name))))) + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (spam-check-crm114-headers t) + (spam-check-crm114 t)))) + (gnus-summary-show-article) + (message "pR: %s" score) + (or score "0")))) + +(defun spam-check-crm114 (&optional score) + "Check the CRM114 Mailfilter backend for the classification of this message" + (let ((article-buffer-name (buffer-name)) + (db spam-crm114-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-crm114-program + nil temp-buffer-name nil + (when db (list (concat "--fileprefix=" db))))) + (setq return (spam-check-crm114-headers score)))) + return)) + +(defun spam-crm114-register-with-crm114 (articles + spam + &optional unregister) + "Register an article, given as a string, as spam or non-spam." + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (db spam-crm114-database-directory) + (switch (if unregister + (if spam + spam-crm114-spam-strong-switch + spam-crm114-ham-strong-switch) + (if spam + spam-crm114-spam-switch + spam-crm114-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + + (apply 'call-process-region + (point-min) (point-max) + spam-crm114-program + nil nil nil + (when db (list switch (concat "--fileprefix=" db))))))))) + +(defun spam-crm114-register-spam-routine (articles &optional unregister) + (spam-crm114-register-with-crm114 articles t unregister)) + +(defun spam-crm114-unregister-spam-routine (articles) + (spam-crm114-register-spam-routine articles t)) + +(defun spam-crm114-register-ham-routine (articles &optional unregister) + (spam-crm114-register-with-crm114 articles nil unregister)) + +(defun spam-crm114-unregister-ham-routine (articles) + (spam-crm114-register-ham-routine articles t)) -(defun spam-bogofilter-register-routine () - (when (and spam-use-bogofilter spam-bogofilter-path) - (let ((articles gnus-newsgroup-articles) - article mark ham-articles spam-articles) - (while articles - (setq article (pop articles) - mark (gnus-summary-article-mark article)) - (cond ((memq mark spam-spam-marks) (push article spam-articles)) - ((memq article gnus-newsgroup-saved)) - ((memq mark spam-ham-marks) (push article ham-articles)))) - (when ham-articles - (spam-bogofilter-articles "ham" "-n" ham-articles)) - (when spam-articles - (spam-bogofilter-articles "SPAM" "-s" spam-articles))))) - -(defvar spam-bogofilter-initial-timeout 40 - "Timeout in seconds for the initial reply from the `bogofilter' program.") - -(defvar spam-bogofilter-subsequent-timeout 15 - "Timeout in seconds for any subsequent reply from the `bogofilter' program.") - -(defun spam-bogofilter-articles (type option articles) - (let ((output-buffer (get-buffer-create spam-output-buffer-name)) - (article-copy (get-buffer-create " *Bogofilter Article Copy*")) - (remove-regexp (concat spam-spaminfo-header-regexp "\\|Xref:")) - (counter 0) - prefix process article) - (when type - (setq prefix (format "Studying %d articles as %s..." (length articles) - type)) - (message "%s" prefix)) - (save-excursion (set-buffer output-buffer) (erase-buffer)) - (setq process (start-process "bogofilter" output-buffer - spam-bogofilter-path "-F" option)) - (process-kill-without-query process t) - (unwind-protect - (save-window-excursion - (while articles - (setq counter (1+ counter)) - (when prefix - (message "%s %d" prefix counter)) - (setq article (pop articles)) - (gnus-summary-goto-subject article) - (gnus-summary-select-article) - (gnus-eval-in-buffer-window article-copy - (insert-buffer-substring gnus-original-article-buffer) - ;; Remove spam classification redundant headers: they may induce - ;; unwanted biases in later analysis. - (goto-char (point-min)) - (while (not (or (eobp) (= (following-char) ?\n))) - (if (looking-at remove-regexp) - (delete-region (point) - (save-excursion (forward-line 1) (point))) - (forward-line 1))) - (goto-char (point-min)) - ;; Bogofilter really wants From envelopes for counting articles. - ;; Fake one at the beginning, make sure there will be no other. - (if (looking-at "From ") - (forward-line 1) - (insert "From nobody " (current-time-string) "\n")) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert ">"))) - (process-send-region process (point-min) (point-max)) - (erase-buffer)))) - ;; Sending the EOF is unwind-protected. This is to prevent lost copies - ;; of `bogofilter', hung on reading their standard input, in case the - ;; whole registering process gets interrupted by the user. - (process-send-eof process)) - (kill-buffer article-copy) - ;; Receive process output. It sadly seems that we still have to protect - ;; ourselves against hung `bogofilter' processes. - (let ((status (process-status process)) - (timeout (* 1000 spam-bogofilter-initial-timeout)) - (quanta 200)) ; also counted in milliseconds - (while (and (not (eq status 'exit)) (> timeout 0)) - ;; `accept-process-output' timeout is counted in microseconds. - (setq timeout (if (accept-process-output process 0 (* 1000 quanta)) - (* 1000 spam-bogofilter-subsequent-timeout) - (- timeout quanta)) - status (process-status process))) - (if (eq status 'exit) - (when prefix - (message "%s done!" prefix)) - ;; Sigh! The process did time out... Become brutal! - (interrupt-process process) - (message "%s %d INTERRUPTED! (Article %d, status %s)" - (or prefix "Bogofilter process...") - counter article status) - ;; Give some time for user to read. Sitting redisplays but gives up - ;; if input is pending. Sleeping does not give up, but it does not - ;; redisplay either. Mix both: let's redisplay and not give up. - (sit-for 1) - (sleep-for 3))))) + +;;;; Hooks + +;;;###autoload +(defun spam-initialize (&rest symbols) + "Install the spam.el hooks and do other initialization. +When SYMBOLS is given, set those variables to t. This is so you +can call spam-initialize before you set spam-use-* variables on +explicitly, and matters only if you need the extra headers +installed through spam-necessary-extra-headers." + (interactive) + + (dolist (var symbols) + (set var t)) + + (dolist (header (spam-necessary-extra-headers)) + (add-to-list 'nnmail-extra-headers header) + (add-to-list 'gnus-extra-headers header)) + + (setq spam-install-hooks t) + ;; TODO: How do we redo this every time spam-face is customized? + (push '((eq mark gnus-spam-mark) . spam-face) + gnus-summary-highlight) + ;; Add hooks for loading and saving the spam stats + (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) + (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) + (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) + (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) + (add-hook 'gnus-get-new-news-hook 'spam-setup-widening) + (add-hook 'gnus-summary-prepared-hook 'spam-find-spam)) + +(defun spam-unload-hook () + "Uninstall the spam.el hooks" + (interactive) + (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) + (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) + (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) + (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) + (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) + (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) + +(when spam-install-hooks + (spam-initialize)) (provide 'spam) -;;; spam.el ends here. +;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f +;;; spam.el ends here