* spam.el mega patch
@ 2003-11-23 6:04 Ted Zlatanov
2003-11-23 13:38 ` Ted Zlatanov
0 siblings, 1 reply; 6+ messages in thread
From: Ted Zlatanov @ 2003-11-23 6:04 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 1689 bytes --]
I would really appreciate it if anyone looked over the attached
patch, which adds some significant fixes to spam.el, namely:
- unregistering of articles (when they've already been registered
with a particular spam/ham processor)
- unregistering of articles when they change from spam to ham or vice
versa during the usage of a group summary buffer (so if you mark a
spam message as ham or vice versa, it will be unregistered from its
original registration) - I think I've got the algorithm right but
any opinions are welcome
- consistent registration of articles with all the spam-use-* backends
- mass registration/unregistration, meaning that when possible a
batch of articles will be sent to a ham/spam processor. For tools
like bogofilter the speed benefit should be huge, because the
program will be invoked only once. This will allow mass training
and remote training eventually.
- the code is simpler, because now it's based on a few lookup tables
instead of hand-coding all the processors. Also, I have learned to
abuse funcall, apply, and the ` form sometimes.
- gnus.el customizations now accept compound (list) names for
spam/ham processors - the best way to explain it is to look at the
gnus.el changes; the old spam/ham processors are still usable but
marked obsolete
The fixes affect almost every part of spam.el so please look at the
patch and let me know if you see anything wrong. I'll be using the
code in my own setup, but of course any testing you can do is much
appreciated. I don't think the code will be bug-free because of the
scope of the fixes, that's why I'm leaving it for review before I
make a CVS commit.
Thanks
Ted
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: spam-mega.patch --]
[-- Type: text/x-patch, Size: 52382 bytes --]
Index: spam.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/spam.el,v
retrieving revision 6.133
diff -u -r6.133 spam.el
--- spam.el 20 Nov 2003 14:52:28 -0000 6.133
+++ spam.el 23 Nov 2003 05:59:15 -0000
@@ -1,3 +1,11 @@
+;;; TODO:
+
+;; spam-stat-register-ham-routine
+;; spam-stat-register-spam-routine
+;; spam-stat-unregister-ham-routine
+;; spam-stat-unregister-spam-routine
+
+
;;; spam.el --- Identifying spam
;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
@@ -39,8 +47,9 @@
(require 'gnus-sum)
(require 'gnus-uu) ; because of key prefix issues
-(require 'gnus) ; for the definitions of group content classification and spam processors
-(require 'message) ;for the message-fetch-field functions
+;;; for the definitions of group content classification and spam processors
+(require 'gnus)
+(require 'message) ;for the message-fetch-field functions
;; for nnimap-split-download-body-default
(eval-when-compile (require 'nnimap))
@@ -239,8 +248,11 @@
: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"))
+;;; 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"))
@@ -308,7 +320,7 @@
"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"))
+ (const :tag "Use the current group name"))
:group 'spam-ifile)
(defcustom spam-ifile-all-categories nil
@@ -343,6 +355,16 @@
: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
@@ -350,7 +372,8 @@
(defcustom spam-bogofilter-database-directory nil
"Directory path of the Bogofilter databases."
- :type '(choice (directory :tag "Location of the Bogofilter database directory")
+ :type '(choice (directory
+ :tag "Location of the Bogofilter database directory")
(const :tag "Use the default"))
:group 'spam-ifile)
@@ -380,7 +403,17 @@
"Msx" gnus-summary-mark-as-spam
"\M-d" gnus-summary-mark-as-spam)
+(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.")
+
+
;; convenience functions
+(defun spam-xor (a b) ; logical exclusive or
+ (and (or a b) (not (and a b))))
+
(defun spam-group-ham-mark-p (group mark &optional spam)
(when (stringp group)
(let* ((marks (spam-group-ham-marks group spam))
@@ -395,8 +428,8 @@
(defun spam-group-ham-marks (group &optional spam)
(when (stringp group)
(let* ((marks (if spam
- (gnus-parameter-spam-marks group)
- (gnus-parameter-ham-marks group)))
+ (gnus-parameter-spam-marks group)
+ (gnus-parameter-ham-marks group)))
(marks (car marks))
(marks (if (listp (car marks)) (car marks) marks)))
marks)))
@@ -417,12 +450,46 @@
(gnus-parameter-spam-contents group))
nil))
+(defvar spam-list-of-processors
+ '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
+ (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter)
+ (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)
+ (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-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-spamoracle ham spam-use-spamoracle))
+ "The spam-list-of-processors list contains pairs associating a
+ham/spam exit processor variable with a classification and a
+spam-use-* variable.")
+
(defun spam-group-processor-p (group processor)
(if (and (stringp group)
(symbolp processor))
- (member processor (car (gnus-parameter-spam-process group)))
+ (or (member processor (nth 0 (gnus-parameter-spam-process group)))
+ (spam-group-processor-multiple-p
+ group
+ (cdr-safe (assoc processor spam-list-of-processors))))
nil))
+(defun spam-group-processor-multiple-p (group processor-info)
+ (let* ((classification (nth 0 processor-info))
+ (check (nth 1 processor-info))
+ (parameters (nth 0 (gnus-parameter-spam-process group)))
+ found)
+ (dolist (parameter parameters)
+ (when (and (null found)
+ (listp parameter)
+ (eq classification (nth 0 parameter))
+ (eq check (nth 1 parameter)))
+ (setq found t)))
+ found))
+
(defun spam-group-spam-processor-report-gmane-p (group)
(spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
@@ -465,43 +532,56 @@
;;; 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 ()
(unless gnus-group-is-exiting-without-update-p
(gnus-message 6 "Exiting summary buffer and applying spam rules")
- (when (and spam-bogofilter-path
- (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
- (gnus-message 5 "Registering spam with bogofilter")
- (spam-bogofilter-register-spam-routine))
-
- (when (and spam-ifile-path
- (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
- (gnus-message 5 "Registering spam with ifile")
- (spam-ifile-register-spam-routine))
-
- (when (spam-group-spam-processor-spamoracle-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with spamoracle")
- (spam-spamoracle-learn-spam))
-
- (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with spam-stat")
- (spam-stat-register-spam-routine))
-
- (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with the blacklist")
- (spam-blacklist-register-routine))
-
- (when (spam-group-spam-processor-report-gmane-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with the Gmane report")
- (spam-report-gmane-register-routine))
+
+ ;; 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 (gnus-set-difference old-articles new-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
+ (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 processor))
+ (spam-register-routine classification check))))
(if spam-move-spam-nonspam-groups-only
(when (not (spam-group-spam-contents-p gnus-newsgroup-name))
(spam-mark-spam-as-expired-and-move-routine
(gnus-parameter-spam-process-destination gnus-newsgroup-name)))
- (gnus-message 5 "Marking spam as expired and moving it to %s" gnus-newsgroup-name)
+ (gnus-message 5 "Marking spam as expired and moving it to %s"
+ gnus-newsgroup-name)
(spam-mark-spam-as-expired-and-move-routine
(gnus-parameter-spam-process-destination gnus-newsgroup-name)))
@@ -514,24 +594,14 @@
(and (spam-group-spam-contents-p gnus-newsgroup-name)
spam-process-ham-in-spam-groups)
spam-process-ham-in-nonham-groups)
- (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with the whitelist")
- (spam-whitelist-register-routine))
- (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with ifile")
- (spam-ifile-register-ham-routine))
- (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with Bogofilter")
- (spam-bogofilter-register-ham-routine))
- (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with spam-stat")
- (spam-stat-register-ham-routine))
- (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with the BBDB")
- (spam-BBDB-register-routine))
- (when (spam-group-ham-processor-spamoracle-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with spamoracle")
- (spam-spamoracle-learn-ham)))
+ ;; 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 processor))
+ (spam-register-routine classification check)))))
(when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
(gnus-message 5 "Copying ham")
@@ -542,7 +612,10 @@
(when (spam-group-spam-contents-p gnus-newsgroup-name)
(gnus-message 5 "Moving ham messages from spam group")
(spam-ham-move-routine
- (gnus-parameter-ham-process-destination gnus-newsgroup-name)))))
+ (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+
+ (setq spam-old-ham-articles nil)
+ (setq spam-old-spam-articles nil))
(defun spam-mark-junk-as-spam-routine ()
;; check the global list of group names spam-junk-mailgroups and the
@@ -622,11 +695,11 @@
(gnus-summary-mark-article article gnus-unread-mark))
(gnus-summary-set-process-mark article))
- (if respool ; respooling is with a "fake" group
+ (if respool ; respooling is with a "fake" group
(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
+ (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
@@ -654,28 +727,6 @@
(apply 'spam-ham-move-routine (car groups))
(spam-ham-copy-or-move-routine nil groups)))
-(defun spam-generic-register-routine (spam-func ham-func)
- (let ((articles gnus-newsgroup-articles)
- article mark ham-articles spam-articles)
-
- (while articles
- (setq article (pop articles)
- mark (gnus-summary-article-mark article))
- (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark)
- (push article spam-articles))
- ((memq article gnus-newsgroup-saved))
- ((spam-group-ham-mark-p gnus-newsgroup-name mark)
- (push article ham-articles))))
-
- (when (and ham-articles ham-func)
- (mapc ham-func ham-articles)) ; we use mapc because unlike
- ; mapcar it discards the
- ; return values
- (when (and spam-articles spam-func)
- (mapc spam-func spam-articles)))) ; we use mapc because unlike
- ; mapcar it discards the
- ; return values
-
(eval-and-compile
(defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
'point-at-eol
@@ -683,12 +734,12 @@
(defun spam-get-article-as-string (article)
(let ((article-buffer (spam-get-article-as-buffer article))
- article-string)
+ article-string)
(when article-buffer
(save-window-excursion
(set-buffer article-buffer)
(setq article-string (buffer-string))))
- article-string))
+ article-string))
(defun spam-get-article-as-buffer (article)
(let ((article-buffer))
@@ -703,8 +754,10 @@
;; (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)))
+;; (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)))
@@ -713,40 +766,45 @@
"Fetch the `from' field quickly, using the internal gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-from
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun spam-fetch-field-subject-fast (article)
- "Fetch the `subject' field quickly, using the internal gnus-data-list function"
+ "Fetch the `subject' field quickly, using the internal
+ gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-subject
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun spam-fetch-field-message-id-fast (article)
- "Fetch the `subject' field quickly, using the internal gnus-data-list function"
+ "Fetch the `subject' field quickly, using the internal
+ gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-message-id (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-message-id
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
\f
;;;; Spam determination.
(defvar spam-list-of-checks
- '((spam-use-blacklist . spam-check-blacklist)
- (spam-use-regex-headers . spam-check-regex-headers)
- (spam-use-regex-body . spam-check-regex-body)
- (spam-use-whitelist . spam-check-whitelist)
- (spam-use-BBDB . 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-bogofilter-headers . spam-check-bogofilter-headers)
- (spam-use-bogofilter . spam-check-bogofilter))
-"The spam-list-of-checks list contains pairs associating a parameter
+ '((spam-use-blacklist . spam-check-blacklist)
+ (spam-use-regex-headers . spam-check-regex-headers)
+ (spam-use-regex-body . spam-check-regex-body)
+ (spam-use-whitelist . spam-check-whitelist)
+ (spam-use-BBDB . 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-bogofilter-headers . spam-check-bogofilter-headers)
+ (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
@@ -758,12 +816,16 @@
name is the value of `spam-split-group', meaning that the message is
definitely a spam.")
-(defvar spam-list-of-statistical-checks
- '(spam-use-ifile spam-use-regex-body spam-use-stat spam-use-bogofilter spam-use-spamoracle)
-"The spam-list-of-statistical-checks list contains all the mail
+(defvar spam-list-of-statistical-checks
+ '(spam-use-ifile
+ spam-use-regex-body
+ spam-use-stat
+ spam-use-bogofilter
+ spam-use-spamoracle)
+ "The spam-list-of-statistical-checks list contains all the mail
splitters that need to have the full message body available.")
-;;;TODO: modify to invoke self with each specific check if invoked without specific checks
+;;;TODO: modify to invoke self with each check if invoked without specifics
(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',
@@ -803,18 +865,160 @@
nil
decision)))))))
+(defvar spam-registration-functions
+ ;; first the ham, then the spam function
+ '((spam-use-blacklist nil
+ spam-blacklist-register-routine) ;done (with unreg)
+ (spam-use-whitelist spam-whitelist-register-routine ;done (with unreg)
+ nil)
+ (spam-use-BBDB spam-BBDB-register-routine
+ nil)
+ (spam-use-ifile spam-ifile-register-ham-routine
+ spam-ifile-register-spam-routine)
+ (spam-use-spamoracle spam-spamoracle-learn-ham
+ spam-spamoracle-learn-spam)
+ (spam-use-stat spam-stat-register-ham-routine
+ spam-stat-register-spam-routine)
+ ;; note that spam-use-gmane is not a legitimate check
+ (spam-use-gmane nil
+ spam-report-gmane-register-routine) ;done, can't unreg
+ (spam-use-bogofilter spam-bogofilter-register-ham-routine
+ spam-bogofilter-register-spam-routine))
+ "The spam-registration-functions list contains pairs associating
+a parameter variable with the ham and spam registration functions.")
+
+(defvar spam-unregistration-functions
+ ;; first the ham, then the spam unregister function
+ '((spam-use-blacklist nil
+ spam-blacklist-unregister-routine) ; done
+ (spam-use-whitelist spam-whitelist-unregister-routine ; done
+ nil)
+ (spam-use-BBDB spam-BBDB-unregister-routine
+ nil)
+ (spam-use-ifile spam-ifile-unregister-ham-routine
+ spam-ifile-unregister-spam-routine)
+ (spam-use-spamoracle spam-spamoracle-unlearn-ham
+ spam-spamoracle-unlearn-spam)
+ (spam-use-stat spam-stat-unregister-ham-routine
+ spam-stat-unregister-spam-routine)
+ (spam-use-bogofilter spam-bogofilter-unregister-ham-routine
+ spam-bogofilter-unregister-spam-routine))
+ "The spam-unregistration-functions list contains pairs associating
+a parameter variable with 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-unregistration-functions))
+
+(defun spam-registration-check-function (classification check)
+ (let ((flist (cdr-safe (assoc check spam-registration-functions))))
+ (when flist
+ (if (eq classification 'spam)
+ (nth 1 flist)
+ (nth 0 flist)))))
+
+(defun spam-unregistration-check-function (classification check)
+ (let ((flist (cdr-safe (assoc check spam-unregistration-functions))))
+ (when flist
+ (if (eq classification 'spam)
+ (nth 1 flist)
+ (nth 0 flist)))))
+
+(defun spam-list-articles (articles classification)
+ (let ((mark-check (if (eq classification 'spam)
+ 'spam-group-spam-mark-p
+ 'spam-group-ham-mark-p))
+ mark list)
+ (dolist (article articles)
+ ;; TODO: this should be optimized so we don't check the same mark
+ (when (funcall mark-check
+ gnus-newsgroup-name
+ (gnus-summary-article-mark article))
+ (push article list)))
+ list))
+
+(defun spam-register-routine (classification
+ check
+ &optional unregister
+ specific-articles)
+ (when (and (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (gnus-message 5 "%s %s articles with classification %s, check %s"
+ (if unregister "Unregistering" "Registering")
+ (if specific-articles "specific" "")
+ (symbol-name classification)
+ (symbol-name check))
+ (let* ((register-function
+ (spam-registration-check-function classification check))
+ (unregister-function
+ (spam-unregistration-check-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
+ (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))))))
+
+(defun spam-generic-register-routine (spam-func ham-func)
+ (let ((articles gnus-newsgroup-articles)
+ article mark ham-articles spam-articles)
+
+ (while articles
+ (setq article (pop articles)
+ mark (gnus-summary-article-mark article))
+ (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark)
+ (push article spam-articles))
+ ((memq article gnus-newsgroup-saved))
+ ((spam-group-ham-mark-p gnus-newsgroup-name mark)
+ (push article ham-articles))))
+
+ (when (and ham-articles ham-func)
+ (mapc ham-func ham-articles)) ; we use mapc because unlike
+ ; mapcar it discards the
+ ; return values
+ (when (and spam-articles spam-func)
+ (mapc spam-func spam-articles)))) ; we use mapc because unlike
+ ; mapcar it discards the
+ ; return values
+
;;; 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)
- (or (eq type 'incoming)
- (eq type 'process))
- (or (eq classification 'spam)
- (eq classification 'ham))
- (assoc check spam-list-of-checks))
+ (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)))
+ (cell (list classification check group)))
(push cell cell-list)
(gnus-registry-store-extra-entry
id
@@ -828,11 +1032,9 @@
(defun spam-log-unregistration-needed-p (id type classification check)
(when spam-log-to-registry
(if (and (stringp id)
- (or (eq type 'incoming)
- (eq type 'process))
- (or (eq classification 'spam)
- (eq classification 'ham))
- (assoc check spam-list-of-checks))
+ (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)
@@ -846,6 +1048,30 @@
"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 5 (format "%s called with bad ID, type, 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)
@@ -865,7 +1091,7 @@
(defun spam-check-regex-headers (&optional body)
(let ((type (if body "body" "header"))
- ret found)
+ ret found)
(dolist (h-regex spam-regex-headers-ham)
(unless found
(goto-char (point-min))
@@ -936,7 +1162,7 @@
(defun spam-check-hashcash ()
"Check the headers for hashcash payments."
- (mail-check-payment))) ;mail-check-payment returns a boolean
+ (mail-check-payment))) ;mail-check-payment returns a boolean
(file-error (progn
(defalias 'mail-check-payment 'ignore)
@@ -954,42 +1180,49 @@
(require 'bbdb)
(require 'bbdb-com)
- (defun spam-enter-ham-BBDB (from)
- "Enter an address into the BBDB; implies ham (non-spam) sender"
- (when (stringp from)
- (let* ((parsed-address (gnus-extract-address-components from))
- (name (or (car parsed-address) "Ham Sender"))
- (net-address (car (cdr parsed-address))))
- (gnus-message 5 "Adding address %s to BBDB" from)
- (when (and net-address
- (not (bbdb-search-simple nil net-address)))
- (bbdb-create-internal name nil net-address nil nil
- "ham sender added by spam.el")))))
-
- (defun spam-BBDB-register-routine ()
- (spam-generic-register-routine
- ;; spam function
- nil
- ;; ham function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-BBDB
- gnus-newsgroup-name)
- (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
-
- (defun spam-check-BBDB ()
- "Mail from people in the BBDB is classified as ham or non-spam"
- (let ((who (nnmail-fetch-field "from")))
- (when who
- (setq who (cadr (gnus-extract-address-components who)))
- (if (bbdb-search-simple nil who)
- t
- (if spam-use-BBDB-exclusive
- spam-split-group
- nil))))))
+ (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 5 "%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 (nnmail-fetch-field "from")))
+ (when who
+ (setq who (nth 1 (gnus-extract-address-components who)))
+ (if (bbdb-search-simple nil who)
+ t
+ (if spam-use-BBDB-exclusive
+ spam-split-group
+ nil))))))
(file-error (progn
(defalias 'bbdb-search-simple 'ignore)
@@ -997,6 +1230,7 @@
(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))))
\f
@@ -1006,7 +1240,8 @@
;;; as spam
(defun spam-get-ifile-database-parameter ()
- "Get the command-line parameter for ifile's database from spam-ifile-database-path."
+ "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))
@@ -1020,11 +1255,11 @@
(db-param (spam-get-ifile-database-parameter)))
(save-excursion
(set-buffer article-buffer-name)
- (if db-param
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil temp-buffer-name nil "-q" "-c" db-param)
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil temp-buffer-name nil "-q" "-c")))
+ (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) (spam-point-at-eol))))
@@ -1033,50 +1268,38 @@
(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))))))
+ (setq return spam-split-group)))))) ; note return is nil otherwise
return))
-(defun spam-ifile-register-with-ifile (article-string category)
+(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)."
- (when (stringp article-string)
- (let ((category (or category gnus-newsgroup-name))
- (db-param (spam-get-ifile-database-parameter)))
- (with-temp-buffer
- (insert article-string)
- (if db-param
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil nil nil
- "-h" "-i" category db-param)
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil nil nil
- "-h" "-i" category))))))
-
-(defun spam-ifile-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-ifile
- gnus-newsgroup-name)
- (spam-ifile-register-with-ifile
- (spam-get-article-as-string article) spam-ifile-spam-category))
- nil))
-
-(defun spam-ifile-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-ifile
- gnus-newsgroup-name)
- (spam-ifile-register-with-ifile
- (spam-get-article-as-string article) spam-ifile-ham-category))))
+ (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))
\f
;;;; spam-stat
@@ -1148,34 +1371,56 @@
(defvar spam-whitelist-cache nil)
(defvar spam-blacklist-cache nil)
-(defun spam-enter-whitelist (address)
- "Enter ADDRESS into the whitelist."
+(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)
+ (spam-enter-list address spam-whitelist remove)
(setq spam-whitelist-cache nil))
-(defun spam-enter-blacklist (address)
- "Enter ADDRESS into the blacklist."
+;;; 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)
+ (spam-enter-list address spam-blacklist remove)
(setq spam-blacklist-cache nil))
-(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-min))
- (unless (re-search-forward (regexp-quote address) nil t)
- (goto-char (point-max))
- (unless (bobp)
- (insert "\n"))
- (insert address "\n")
+(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))))
-;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise
+;;; 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-whitelist-cache
@@ -1202,7 +1447,7 @@
(forward-line 1)
;; insert the e-mail address if detected, otherwise the raw data
(unless (zerop (length address))
- (let ((pure-address (cadr (gnus-extract-address-components address))))
+ (let ((pure-address (nth 1 (gnus-extract-address-components address))))
(push (or pure-address address) contents)))))
(nreverse contents))))
@@ -1221,44 +1466,53 @@
cache nil))))
found))
-(defun spam-blacklist-register-routine ()
- (spam-generic-register-routine
- ;; the spam function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-blacklist
- gnus-newsgroup-name)
- (let ((from (spam-fetch-field-from-fast article)))
- (when (stringp from)
- (spam-enter-blacklist from))))
- ;; the ham function
- nil))
-
-(defun spam-whitelist-register-routine ()
- (spam-generic-register-routine
- ;; the spam function
- nil
- ;; the ham function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-whitelist
- gnus-newsgroup-name)
- (let ((from (spam-fetch-field-from-fast article)))
- (when (stringp from)
- (spam-enter-whitelist from))))))
+(defun spam-filelist-register-routine (articles blacklist &optional unregister)
+ (let ((de-symbol (if blacklist 'use-spam-whitelist 'use-spam-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)
+ (dolist (article articles)
+ (let ((from (spam-fetch-field-from-fast article))
+ (id (spam-fetch-field-message-id-fast article)))
+ (when (stringp from)
+ ;; 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 from unregister-list))
+ (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 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))
\f
;;;; Spam-report glue
-(defun spam-report-gmane-register-routine ()
- (spam-generic-register-routine
- 'spam-report-gmane
- nil))
+(defun spam-report-gmane-register-routine (articles)
+ (apply 'spam-report-gmane articles))
\f
;;;; Bogofilter
@@ -1289,62 +1543,57 @@
(defun spam-check-bogofilter (&optional score)
"Check the Bogofilter backend for the classification of this message"
- (let ((article-buffer-name (buffer-name))
+ (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)
- (if spam-bogofilter-database-directory
- (call-process-region (point-min) (point-max)
- spam-bogofilter-path
- nil temp-buffer-name nil "-v"
- "-d" spam-bogofilter-database-directory)
- (call-process-region (point-min) (point-max) spam-bogofilter-path
- nil temp-buffer-name nil "-v")))
- (setq return (spam-check-bogofilter-headers score))))
+ (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 (article-string spam)
+(defun spam-bogofilter-register-with-bogofilter (articles
+ spam
+ &optional unregister)
"Register an article, given as a string, as spam or non-spam."
- (when (stringp article-string)
- (let ((switch (if spam spam-bogofilter-spam-switch
- spam-bogofilter-ham-switch)))
- (with-temp-buffer
- (insert article-string)
- (if spam-bogofilter-database-directory
- (call-process-region (point-min) (point-max)
- spam-bogofilter-path
- nil nil nil "-v" switch
- "-d" spam-bogofilter-database-directory)
- (call-process-region (point-min) (point-max) spam-bogofilter-path
- nil nil nil "-v" switch))))))
-
-(defun spam-bogofilter-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-bogofilter
- gnus-newsgroup-name)
- (spam-bogofilter-register-with-bogofilter
- (spam-get-article-as-string article) t))
- nil))
-
-(defun spam-bogofilter-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-bogofilter
- gnus-newsgroup-name)
- (spam-bogofilter-register-with-bogofilter
- (spam-get-article-as-string article) nil))))
+ (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))
+
\f
;;;; spamoracle
@@ -1371,14 +1620,17 @@
spam-split-group))
(error "Error running spamoracle" status))))))))
-(defun spam-spamoracle-learn (article article-is-spam-p)
+(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))
- (insert (spam-get-article-as-string article))
- (let* ((arg (if article-is-spam-p "-spam" "-good"))
+ (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)
@@ -1390,30 +1642,19 @@
`("add" ,arg)))))
(when (not (zerop status))
(error "Error running spamoracle" status)))))))
-
-(defun spam-spamoracle-learn-ham ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-spamoracle
- gnus-newsgroup-name)
- (spam-spamoracle-learn article nil))))
-
-(defun spam-spamoracle-learn-spam ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-spamoracle
- gnus-newsgroup-name)
- (spam-spamoracle-learn article t))
- nil))
+
+(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))
+
\f
;;;; Hooks
Index: gnus.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus.el,v
retrieving revision 6.208
diff -u -r6.208 gnus.el
--- gnus.el 21 Nov 2003 15:53:58 -0000 6.208
+++ gnus.el 23 Nov 2003 05:59:17 -0000
@@ -1832,50 +1832,50 @@
When a spam group is entered, all unread articles are marked as spam.")
(defvar gnus-group-spam-exit-processor-ifile "ifile"
- "The ifile summary exit spam processor.")
+ "OBSOLETE: The ifile summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-stat "stat"
- "The spam-stat summary exit spam processor.")
+ "OBSOLETE: The spam-stat summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
- "The Bogofilter summary exit spam processor.")
+ "OBSOLETE: The Bogofilter summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-blacklist "blacklist"
- "The Blacklist summary exit spam processor.")
+ "OBSOLETE: The Blacklist summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
- "The Gmane reporting summary exit spam processor.
+ "OBSOLETE: The Gmane reporting summary exit spam processor.
Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
(defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
- "The spamoracle summary exit spam processor.")
+ "OBSOLETE: The spamoracle summary exit spam processor.")
(defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
- "The ifile summary exit ham processor.
+ "OBSOLETE: The ifile summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
- "The Bogofilter summary exit ham processor.
+ "OBSOLETE: The Bogofilter summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-stat "stat-ham"
- "The spam-stat summary exit ham processor.
+ "OBSOLETE: The spam-stat summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-whitelist "whitelist"
- "The whitelist summary exit ham processor.
+ "OBSOLETE: The whitelist summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-BBDB "bbdb"
- "The BBDB summary exit ham processor.
+ "OBSOLETE: The BBDB summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-copy "copy"
- "The ham copy exit ham processor.
+ "OBSOLETE: The ham copy exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
- "The spamoracle summary exit ham processor.
+ "OBSOLETE: The spamoracle summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(gnus-define-group-parameter
@@ -1891,15 +1891,28 @@
(variable-item gnus-group-spam-exit-processor-stat)
(variable-item gnus-group-spam-exit-processor-bogofilter)
(variable-item gnus-group-spam-exit-processor-blacklist)
- (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-spam-exit-processor-spamoracle)
+ (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-ham-exit-processor-bogofilter)
(variable-item gnus-group-ham-exit-processor-ifile)
(variable-item gnus-group-ham-exit-processor-stat)
(variable-item gnus-group-ham-exit-processor-whitelist)
(variable-item gnus-group-ham-exit-processor-BBDB)
+ (variable-item gnus-group-ham-exit-processor-spamoracle)
(variable-item gnus-group-ham-exit-processor-copy)
- (variable-item gnus-group-ham-exit-processor-spamoracle))))
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
:function-document
"Which spam or ham processors will be applied when the summary is exited."
:variable gnus-spam-process-newsgroups
@@ -1928,7 +1941,21 @@
(variable-item gnus-group-ham-exit-processor-whitelist)
(variable-item gnus-group-ham-exit-processor-BBDB)
(variable-item gnus-group-ham-exit-processor-spamoracle)
- (variable-item gnus-group-ham-exit-processor-copy))))
+ (variable-item gnus-group-ham-exit-processor-copy)
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
+
:parameter-document
"Which spam or ham processors will be applied when the summary is exited.")
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: spam.el mega patch
2003-11-23 6:04 spam.el mega patch Ted Zlatanov
@ 2003-11-23 13:38 ` Ted Zlatanov
2003-11-24 12:46 ` Reiner Steib
0 siblings, 1 reply; 6+ messages in thread
From: Ted Zlatanov @ 2003-11-23 13:38 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 575 bytes --]
On Sun, 23 Nov 2003, tzz@lifelogs.com wrote:
> I would really appreciate it if anyone looked over the attached
> patch, which adds some significant fixes to spam.el, namely:
[...]
version 2 of the patch does the preceding, plus:
- added spam-stat register/unregister functions, and they'll save the
database after processing spam or ham (once per batch of articles)
- spam-stat.el: saving and loading are done only when necessary,
according to spam-stat-dirty
- merged all register/unregister functions in one lookup table
- eliminated most TODO items
Thanks
Ted
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: spam-mega2.patch --]
[-- Type: text/x-patch, Size: 58208 bytes --]
Index: spam.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/spam.el,v
retrieving revision 6.133
diff -u -r6.133 spam.el
--- spam.el 20 Nov 2003 14:52:28 -0000 6.133
+++ spam.el 23 Nov 2003 13:36:12 -0000
@@ -39,8 +39,9 @@
(require 'gnus-sum)
(require 'gnus-uu) ; because of key prefix issues
-(require 'gnus) ; for the definitions of group content classification and spam processors
-(require 'message) ;for the message-fetch-field functions
+;;; for the definitions of group content classification and spam processors
+(require 'gnus)
+(require 'message) ;for the message-fetch-field functions
;; for nnimap-split-download-body-default
(eval-when-compile (require 'nnimap))
@@ -239,8 +240,11 @@
: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"))
+;;; 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"))
@@ -308,7 +312,7 @@
"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"))
+ (const :tag "Use the current group name"))
:group 'spam-ifile)
(defcustom spam-ifile-all-categories nil
@@ -343,6 +347,16 @@
: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
@@ -350,7 +364,8 @@
(defcustom spam-bogofilter-database-directory nil
"Directory path of the Bogofilter databases."
- :type '(choice (directory :tag "Location of the Bogofilter database directory")
+ :type '(choice (directory
+ :tag "Location of the Bogofilter database directory")
(const :tag "Use the default"))
:group 'spam-ifile)
@@ -380,7 +395,17 @@
"Msx" gnus-summary-mark-as-spam
"\M-d" gnus-summary-mark-as-spam)
+(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.")
+
+
;; convenience functions
+(defun spam-xor (a b) ; logical exclusive or
+ (and (or a b) (not (and a b))))
+
(defun spam-group-ham-mark-p (group mark &optional spam)
(when (stringp group)
(let* ((marks (spam-group-ham-marks group spam))
@@ -395,8 +420,8 @@
(defun spam-group-ham-marks (group &optional spam)
(when (stringp group)
(let* ((marks (if spam
- (gnus-parameter-spam-marks group)
- (gnus-parameter-ham-marks group)))
+ (gnus-parameter-spam-marks group)
+ (gnus-parameter-ham-marks group)))
(marks (car marks))
(marks (if (listp (car marks)) (car marks) marks)))
marks)))
@@ -417,12 +442,46 @@
(gnus-parameter-spam-contents group))
nil))
+(defvar spam-list-of-processors
+ '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
+ (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter)
+ (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)
+ (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-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-spamoracle ham spam-use-spamoracle))
+ "The spam-list-of-processors list contains pairs associating a
+ham/spam exit processor variable with a classification and a
+spam-use-* variable.")
+
(defun spam-group-processor-p (group processor)
(if (and (stringp group)
(symbolp processor))
- (member processor (car (gnus-parameter-spam-process group)))
+ (or (member processor (nth 0 (gnus-parameter-spam-process group)))
+ (spam-group-processor-multiple-p
+ group
+ (cdr-safe (assoc processor spam-list-of-processors))))
nil))
+(defun spam-group-processor-multiple-p (group processor-info)
+ (let* ((classification (nth 0 processor-info))
+ (check (nth 1 processor-info))
+ (parameters (nth 0 (gnus-parameter-spam-process group)))
+ found)
+ (dolist (parameter parameters)
+ (when (and (null found)
+ (listp parameter)
+ (eq classification (nth 0 parameter))
+ (eq check (nth 1 parameter)))
+ (setq found t)))
+ found))
+
(defun spam-group-spam-processor-report-gmane-p (group)
(spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
@@ -465,43 +524,56 @@
;;; 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 ()
(unless gnus-group-is-exiting-without-update-p
(gnus-message 6 "Exiting summary buffer and applying spam rules")
- (when (and spam-bogofilter-path
- (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
- (gnus-message 5 "Registering spam with bogofilter")
- (spam-bogofilter-register-spam-routine))
-
- (when (and spam-ifile-path
- (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
- (gnus-message 5 "Registering spam with ifile")
- (spam-ifile-register-spam-routine))
-
- (when (spam-group-spam-processor-spamoracle-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with spamoracle")
- (spam-spamoracle-learn-spam))
-
- (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with spam-stat")
- (spam-stat-register-spam-routine))
-
- (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with the blacklist")
- (spam-blacklist-register-routine))
-
- (when (spam-group-spam-processor-report-gmane-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with the Gmane report")
- (spam-report-gmane-register-routine))
+
+ ;; 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 (gnus-set-difference old-articles new-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
+ (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 processor))
+ (spam-register-routine classification check))))
(if spam-move-spam-nonspam-groups-only
(when (not (spam-group-spam-contents-p gnus-newsgroup-name))
(spam-mark-spam-as-expired-and-move-routine
(gnus-parameter-spam-process-destination gnus-newsgroup-name)))
- (gnus-message 5 "Marking spam as expired and moving it to %s" gnus-newsgroup-name)
+ (gnus-message 5 "Marking spam as expired and moving it to %s"
+ gnus-newsgroup-name)
(spam-mark-spam-as-expired-and-move-routine
(gnus-parameter-spam-process-destination gnus-newsgroup-name)))
@@ -514,24 +586,14 @@
(and (spam-group-spam-contents-p gnus-newsgroup-name)
spam-process-ham-in-spam-groups)
spam-process-ham-in-nonham-groups)
- (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with the whitelist")
- (spam-whitelist-register-routine))
- (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with ifile")
- (spam-ifile-register-ham-routine))
- (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with Bogofilter")
- (spam-bogofilter-register-ham-routine))
- (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with spam-stat")
- (spam-stat-register-ham-routine))
- (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with the BBDB")
- (spam-BBDB-register-routine))
- (when (spam-group-ham-processor-spamoracle-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with spamoracle")
- (spam-spamoracle-learn-ham)))
+ ;; 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 processor))
+ (spam-register-routine classification check)))))
(when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
(gnus-message 5 "Copying ham")
@@ -542,7 +604,10 @@
(when (spam-group-spam-contents-p gnus-newsgroup-name)
(gnus-message 5 "Moving ham messages from spam group")
(spam-ham-move-routine
- (gnus-parameter-ham-process-destination gnus-newsgroup-name)))))
+ (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+
+ (setq spam-old-ham-articles nil)
+ (setq spam-old-spam-articles nil))
(defun spam-mark-junk-as-spam-routine ()
;; check the global list of group names spam-junk-mailgroups and the
@@ -622,11 +687,11 @@
(gnus-summary-mark-article article gnus-unread-mark))
(gnus-summary-set-process-mark article))
- (if respool ; respooling is with a "fake" group
+ (if respool ; respooling is with a "fake" group
(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
+ (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
@@ -654,28 +719,6 @@
(apply 'spam-ham-move-routine (car groups))
(spam-ham-copy-or-move-routine nil groups)))
-(defun spam-generic-register-routine (spam-func ham-func)
- (let ((articles gnus-newsgroup-articles)
- article mark ham-articles spam-articles)
-
- (while articles
- (setq article (pop articles)
- mark (gnus-summary-article-mark article))
- (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark)
- (push article spam-articles))
- ((memq article gnus-newsgroup-saved))
- ((spam-group-ham-mark-p gnus-newsgroup-name mark)
- (push article ham-articles))))
-
- (when (and ham-articles ham-func)
- (mapc ham-func ham-articles)) ; we use mapc because unlike
- ; mapcar it discards the
- ; return values
- (when (and spam-articles spam-func)
- (mapc spam-func spam-articles)))) ; we use mapc because unlike
- ; mapcar it discards the
- ; return values
-
(eval-and-compile
(defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
'point-at-eol
@@ -683,12 +726,12 @@
(defun spam-get-article-as-string (article)
(let ((article-buffer (spam-get-article-as-buffer article))
- article-string)
+ article-string)
(when article-buffer
(save-window-excursion
(set-buffer article-buffer)
(setq article-string (buffer-string))))
- article-string))
+ article-string))
(defun spam-get-article-as-buffer (article)
(let ((article-buffer))
@@ -703,8 +746,10 @@
;; (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)))
+;; (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)))
@@ -713,40 +758,45 @@
"Fetch the `from' field quickly, using the internal gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-from
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun spam-fetch-field-subject-fast (article)
- "Fetch the `subject' field quickly, using the internal gnus-data-list function"
+ "Fetch the `subject' field quickly, using the internal
+ gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-subject
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun spam-fetch-field-message-id-fast (article)
- "Fetch the `subject' field quickly, using the internal gnus-data-list function"
+ "Fetch the `subject' field quickly, using the internal
+ gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-message-id (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-message-id
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
\f
;;;; Spam determination.
(defvar spam-list-of-checks
- '((spam-use-blacklist . spam-check-blacklist)
- (spam-use-regex-headers . spam-check-regex-headers)
- (spam-use-regex-body . spam-check-regex-body)
- (spam-use-whitelist . spam-check-whitelist)
- (spam-use-BBDB . 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-bogofilter-headers . spam-check-bogofilter-headers)
- (spam-use-bogofilter . spam-check-bogofilter))
-"The spam-list-of-checks list contains pairs associating a parameter
+ '((spam-use-blacklist . spam-check-blacklist)
+ (spam-use-regex-headers . spam-check-regex-headers)
+ (spam-use-regex-body . spam-check-regex-body)
+ (spam-use-whitelist . spam-check-whitelist)
+ (spam-use-BBDB . 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-bogofilter-headers . spam-check-bogofilter-headers)
+ (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
@@ -758,12 +808,16 @@
name is the value of `spam-split-group', meaning that the message is
definitely a spam.")
-(defvar spam-list-of-statistical-checks
- '(spam-use-ifile spam-use-regex-body spam-use-stat spam-use-bogofilter spam-use-spamoracle)
-"The spam-list-of-statistical-checks list contains all the mail
+(defvar spam-list-of-statistical-checks
+ '(spam-use-ifile
+ spam-use-regex-body
+ spam-use-stat
+ spam-use-bogofilter
+ spam-use-spamoracle)
+ "The spam-list-of-statistical-checks list contains all the mail
splitters that need to have the full message body available.")
-;;;TODO: modify to invoke self with each specific check if invoked without specific checks
+;;;TODO: modify to invoke self with each check if invoked without specifics
(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',
@@ -803,18 +857,158 @@
nil
decision)))))))
+(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-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 is not a legitimate check
+ (spam-use-gmane nil
+ spam-report-gmane-register-routine
+ ;; does Gmane support unregistration?
+ nil
+ nil)
+ (spam-use-bogofilter spam-bogofilter-register-ham-routine
+ spam-bogofilter-register-spam-routine
+ spam-bogofilter-unregister-ham-routine
+ spam-bogofilter-unregister-spam-routine))
+ "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))
+ mark list)
+ (dolist (article articles)
+ (when (funcall mark-check
+ gnus-newsgroup-name
+ (gnus-summary-article-mark article))
+ (push article list)))
+ list))
+
+(defun spam-register-routine (classification
+ check
+ &optional unregister
+ specific-articles)
+ (when (and (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (gnus-message 5 "%s %s articles with classification %s, check %s"
+ (if unregister "Unregistering" "Registering")
+ (if specific-articles "specific" "")
+ (symbol-name classification)
+ (symbol-name 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
+ (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))))))
+
+(defun spam-generic-register-routine (spam-func ham-func)
+ (let ((articles gnus-newsgroup-articles)
+ article mark ham-articles spam-articles)
+
+ (while articles
+ (setq article (pop articles)
+ mark (gnus-summary-article-mark article))
+ (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark)
+ (push article spam-articles))
+ ((memq article gnus-newsgroup-saved))
+ ((spam-group-ham-mark-p gnus-newsgroup-name mark)
+ (push article ham-articles))))
+
+ (when (and ham-articles ham-func)
+ (mapc ham-func ham-articles)) ; we use mapc because unlike
+ ; mapcar it discards the
+ ; return values
+ (when (and spam-articles spam-func)
+ (mapc spam-func spam-articles)))) ; we use mapc because unlike
+ ; mapcar it discards the
+ ; return values
+
;;; 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)
- (or (eq type 'incoming)
- (eq type 'process))
- (or (eq classification 'spam)
- (eq classification 'ham))
- (assoc check spam-list-of-checks))
+ (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)))
+ (cell (list classification check group)))
(push cell cell-list)
(gnus-registry-store-extra-entry
id
@@ -828,11 +1022,9 @@
(defun spam-log-unregistration-needed-p (id type classification check)
(when spam-log-to-registry
(if (and (stringp id)
- (or (eq type 'incoming)
- (eq type 'process))
- (or (eq classification 'spam)
- (eq classification 'ham))
- (assoc check spam-list-of-checks))
+ (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)
@@ -846,6 +1038,30 @@
"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 5 (format "%s called with bad ID, type, 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)
@@ -865,7 +1081,7 @@
(defun spam-check-regex-headers (&optional body)
(let ((type (if body "body" "header"))
- ret found)
+ ret found)
(dolist (h-regex spam-regex-headers-ham)
(unless found
(goto-char (point-min))
@@ -936,7 +1152,7 @@
(defun spam-check-hashcash ()
"Check the headers for hashcash payments."
- (mail-check-payment))) ;mail-check-payment returns a boolean
+ (mail-check-payment))) ;mail-check-payment returns a boolean
(file-error (progn
(defalias 'mail-check-payment 'ignore)
@@ -954,42 +1170,49 @@
(require 'bbdb)
(require 'bbdb-com)
- (defun spam-enter-ham-BBDB (from)
- "Enter an address into the BBDB; implies ham (non-spam) sender"
- (when (stringp from)
- (let* ((parsed-address (gnus-extract-address-components from))
- (name (or (car parsed-address) "Ham Sender"))
- (net-address (car (cdr parsed-address))))
- (gnus-message 5 "Adding address %s to BBDB" from)
- (when (and net-address
- (not (bbdb-search-simple nil net-address)))
- (bbdb-create-internal name nil net-address nil nil
- "ham sender added by spam.el")))))
-
- (defun spam-BBDB-register-routine ()
- (spam-generic-register-routine
- ;; spam function
- nil
- ;; ham function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-BBDB
- gnus-newsgroup-name)
- (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
-
- (defun spam-check-BBDB ()
- "Mail from people in the BBDB is classified as ham or non-spam"
- (let ((who (nnmail-fetch-field "from")))
- (when who
- (setq who (cadr (gnus-extract-address-components who)))
- (if (bbdb-search-simple nil who)
- t
- (if spam-use-BBDB-exclusive
- spam-split-group
- nil))))))
+ (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 5 "%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 (nnmail-fetch-field "from")))
+ (when who
+ (setq who (nth 1 (gnus-extract-address-components who)))
+ (if (bbdb-search-simple nil who)
+ t
+ (if spam-use-BBDB-exclusive
+ spam-split-group
+ nil))))))
(file-error (progn
(defalias 'bbdb-search-simple 'ignore)
@@ -997,6 +1220,7 @@
(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))))
\f
@@ -1006,7 +1230,8 @@
;;; as spam
(defun spam-get-ifile-database-parameter ()
- "Get the command-line parameter for ifile's database from spam-ifile-database-path."
+ "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))
@@ -1020,11 +1245,11 @@
(db-param (spam-get-ifile-database-parameter)))
(save-excursion
(set-buffer article-buffer-name)
- (if db-param
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil temp-buffer-name nil "-q" "-c" db-param)
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil temp-buffer-name nil "-q" "-c")))
+ (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) (spam-point-at-eol))))
@@ -1033,50 +1258,38 @@
(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))))))
+ (setq return spam-split-group)))))) ; note return is nil otherwise
return))
-(defun spam-ifile-register-with-ifile (article-string category)
+(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)."
- (when (stringp article-string)
- (let ((category (or category gnus-newsgroup-name))
- (db-param (spam-get-ifile-database-parameter)))
- (with-temp-buffer
- (insert article-string)
- (if db-param
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil nil nil
- "-h" "-i" category db-param)
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil nil nil
- "-h" "-i" category))))))
-
-(defun spam-ifile-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-ifile
- gnus-newsgroup-name)
- (spam-ifile-register-with-ifile
- (spam-get-article-as-string article) spam-ifile-spam-category))
- nil))
-
-(defun spam-ifile-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-ifile
- gnus-newsgroup-name)
- (spam-ifile-register-with-ifile
- (spam-get-article-as-string article) spam-ifile-ham-category))))
+ (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))
\f
;;;; spam-stat
@@ -1093,35 +1306,33 @@
category return)
(spam-stat-split-fancy)))
- (defun spam-stat-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-stat
- gnus-newsgroup-name)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (spam-stat-buffer-is-spam))))
- nil))
-
- (defun spam-stat-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-stat
- gnus-newsgroup-name)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (spam-stat-buffer-is-non-spam))))))
+ (defun spam-stat-register-spam-routine (articles &optional unregister)
+ (spam-stat-load)
+ (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)))))
+ (spam-stat-save))
+
+ (defun spam-stat-unregister-spam-routine (articles)
+ (spam-stat-register-spam-routine articles t))
+
+ (defun spam-stat-register-ham-routine (articles &optional unregister)
+ (spam-stat-load)
+ (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)))))
+ (spam-stat-save))
+
+ (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)))
@@ -1133,9 +1344,13 @@
(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-stat-load 'ignore)
(defalias 'spam-stat-save 'ignore)
@@ -1148,34 +1363,56 @@
(defvar spam-whitelist-cache nil)
(defvar spam-blacklist-cache nil)
-(defun spam-enter-whitelist (address)
- "Enter ADDRESS into the whitelist."
+(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)
+ (spam-enter-list address spam-whitelist remove)
(setq spam-whitelist-cache nil))
-(defun spam-enter-blacklist (address)
- "Enter ADDRESS into the blacklist."
+;;; 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)
+ (spam-enter-list address spam-blacklist remove)
(setq spam-blacklist-cache nil))
-(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-min))
- (unless (re-search-forward (regexp-quote address) nil t)
- (goto-char (point-max))
- (unless (bobp)
- (insert "\n"))
- (insert address "\n")
+(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))))
-;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise
+;;; 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-whitelist-cache
@@ -1202,7 +1439,7 @@
(forward-line 1)
;; insert the e-mail address if detected, otherwise the raw data
(unless (zerop (length address))
- (let ((pure-address (cadr (gnus-extract-address-components address))))
+ (let ((pure-address (nth 1 (gnus-extract-address-components address))))
(push (or pure-address address) contents)))))
(nreverse contents))))
@@ -1221,44 +1458,53 @@
cache nil))))
found))
-(defun spam-blacklist-register-routine ()
- (spam-generic-register-routine
- ;; the spam function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-blacklist
- gnus-newsgroup-name)
- (let ((from (spam-fetch-field-from-fast article)))
- (when (stringp from)
- (spam-enter-blacklist from))))
- ;; the ham function
- nil))
-
-(defun spam-whitelist-register-routine ()
- (spam-generic-register-routine
- ;; the spam function
- nil
- ;; the ham function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-whitelist
- gnus-newsgroup-name)
- (let ((from (spam-fetch-field-from-fast article)))
- (when (stringp from)
- (spam-enter-whitelist from))))))
+(defun spam-filelist-register-routine (articles blacklist &optional unregister)
+ (let ((de-symbol (if blacklist 'use-spam-whitelist 'use-spam-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)
+ (dolist (article articles)
+ (let ((from (spam-fetch-field-from-fast article))
+ (id (spam-fetch-field-message-id-fast article)))
+ (when (stringp from)
+ ;; 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 from unregister-list))
+ (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 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))
\f
;;;; Spam-report glue
-(defun spam-report-gmane-register-routine ()
- (spam-generic-register-routine
- 'spam-report-gmane
- nil))
+(defun spam-report-gmane-register-routine (articles)
+ (apply 'spam-report-gmane articles))
\f
;;;; Bogofilter
@@ -1289,62 +1535,57 @@
(defun spam-check-bogofilter (&optional score)
"Check the Bogofilter backend for the classification of this message"
- (let ((article-buffer-name (buffer-name))
+ (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)
- (if spam-bogofilter-database-directory
- (call-process-region (point-min) (point-max)
- spam-bogofilter-path
- nil temp-buffer-name nil "-v"
- "-d" spam-bogofilter-database-directory)
- (call-process-region (point-min) (point-max) spam-bogofilter-path
- nil temp-buffer-name nil "-v")))
- (setq return (spam-check-bogofilter-headers score))))
+ (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 (article-string spam)
+(defun spam-bogofilter-register-with-bogofilter (articles
+ spam
+ &optional unregister)
"Register an article, given as a string, as spam or non-spam."
- (when (stringp article-string)
- (let ((switch (if spam spam-bogofilter-spam-switch
- spam-bogofilter-ham-switch)))
- (with-temp-buffer
- (insert article-string)
- (if spam-bogofilter-database-directory
- (call-process-region (point-min) (point-max)
- spam-bogofilter-path
- nil nil nil "-v" switch
- "-d" spam-bogofilter-database-directory)
- (call-process-region (point-min) (point-max) spam-bogofilter-path
- nil nil nil "-v" switch))))))
-
-(defun spam-bogofilter-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-bogofilter
- gnus-newsgroup-name)
- (spam-bogofilter-register-with-bogofilter
- (spam-get-article-as-string article) t))
- nil))
-
-(defun spam-bogofilter-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-bogofilter
- gnus-newsgroup-name)
- (spam-bogofilter-register-with-bogofilter
- (spam-get-article-as-string article) nil))))
+ (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))
+
\f
;;;; spamoracle
@@ -1371,14 +1612,17 @@
spam-split-group))
(error "Error running spamoracle" status))))))))
-(defun spam-spamoracle-learn (article article-is-spam-p)
+(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))
- (insert (spam-get-article-as-string article))
- (let* ((arg (if article-is-spam-p "-spam" "-good"))
+ (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)
@@ -1390,30 +1634,19 @@
`("add" ,arg)))))
(when (not (zerop status))
(error "Error running spamoracle" status)))))))
-
-(defun spam-spamoracle-learn-ham ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-spamoracle
- gnus-newsgroup-name)
- (spam-spamoracle-learn article nil))))
-
-(defun spam-spamoracle-learn-spam ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-spamoracle
- gnus-newsgroup-name)
- (spam-spamoracle-learn article t))
- nil))
+
+(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))
+
\f
;;;; Hooks
Index: gnus.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus.el,v
retrieving revision 6.208
diff -u -r6.208 gnus.el
--- gnus.el 21 Nov 2003 15:53:58 -0000 6.208
+++ gnus.el 23 Nov 2003 13:36:14 -0000
@@ -1832,50 +1832,50 @@
When a spam group is entered, all unread articles are marked as spam.")
(defvar gnus-group-spam-exit-processor-ifile "ifile"
- "The ifile summary exit spam processor.")
+ "OBSOLETE: The ifile summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-stat "stat"
- "The spam-stat summary exit spam processor.")
+ "OBSOLETE: The spam-stat summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
- "The Bogofilter summary exit spam processor.")
+ "OBSOLETE: The Bogofilter summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-blacklist "blacklist"
- "The Blacklist summary exit spam processor.")
+ "OBSOLETE: The Blacklist summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
- "The Gmane reporting summary exit spam processor.
+ "OBSOLETE: The Gmane reporting summary exit spam processor.
Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
(defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
- "The spamoracle summary exit spam processor.")
+ "OBSOLETE: The spamoracle summary exit spam processor.")
(defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
- "The ifile summary exit ham processor.
+ "OBSOLETE: The ifile summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
- "The Bogofilter summary exit ham processor.
+ "OBSOLETE: The Bogofilter summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-stat "stat-ham"
- "The spam-stat summary exit ham processor.
+ "OBSOLETE: The spam-stat summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-whitelist "whitelist"
- "The whitelist summary exit ham processor.
+ "OBSOLETE: The whitelist summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-BBDB "bbdb"
- "The BBDB summary exit ham processor.
+ "OBSOLETE: The BBDB summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-copy "copy"
- "The ham copy exit ham processor.
+ "OBSOLETE: The ham copy exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
- "The spamoracle summary exit ham processor.
+ "OBSOLETE: The spamoracle summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(gnus-define-group-parameter
@@ -1891,15 +1891,28 @@
(variable-item gnus-group-spam-exit-processor-stat)
(variable-item gnus-group-spam-exit-processor-bogofilter)
(variable-item gnus-group-spam-exit-processor-blacklist)
- (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-spam-exit-processor-spamoracle)
+ (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-ham-exit-processor-bogofilter)
(variable-item gnus-group-ham-exit-processor-ifile)
(variable-item gnus-group-ham-exit-processor-stat)
(variable-item gnus-group-ham-exit-processor-whitelist)
(variable-item gnus-group-ham-exit-processor-BBDB)
+ (variable-item gnus-group-ham-exit-processor-spamoracle)
(variable-item gnus-group-ham-exit-processor-copy)
- (variable-item gnus-group-ham-exit-processor-spamoracle))))
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
:function-document
"Which spam or ham processors will be applied when the summary is exited."
:variable gnus-spam-process-newsgroups
@@ -1928,7 +1941,21 @@
(variable-item gnus-group-ham-exit-processor-whitelist)
(variable-item gnus-group-ham-exit-processor-BBDB)
(variable-item gnus-group-ham-exit-processor-spamoracle)
- (variable-item gnus-group-ham-exit-processor-copy))))
+ (variable-item gnus-group-ham-exit-processor-copy)
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
+
:parameter-document
"Which spam or ham processors will be applied when the summary is exited.")
Index: spam-stat.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/spam-stat.el,v
retrieving revision 6.13
diff -u -r6.13 spam-stat.el
--- spam-stat.el 30 May 2003 20:05:05 -0000 6.13
+++ spam-stat.el 23 Nov 2003 13:36:14 -0000
@@ -183,6 +183,9 @@
"Syntax table used when processing mails for statistical analysis.
The important part is which characters are word constituents.")
+(defvar spam-stat-dirty nil
+ "Whether the spam-stat database needs saving.")
+
(defvar spam-stat-buffer nil
"Buffer to use for scoring while splitting.
This is set by hooking into Gnus.")
@@ -341,7 +344,8 @@
(setq entry (spam-stat-make-entry 0 count)))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat)))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
(defun spam-stat-buffer-is-non-spam ()
"Consider current buffer to be a new non-spam mail."
@@ -354,7 +358,8 @@
(setq entry (spam-stat-make-entry count 0)))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat)))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
(defun spam-stat-buffer-change-to-spam ()
"Consider current buffer no longer normal mail but spam."
@@ -369,7 +374,8 @@
(spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat))))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
(defun spam-stat-buffer-change-to-non-spam ()
"Consider current buffer no longer spam but normal mail."
@@ -384,32 +390,37 @@
(spam-stat-set-bad entry (- (spam-stat-bad entry) count))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat))))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
;; Saving and Loading
-(defun spam-stat-save ()
+(defun spam-stat-save (&optional force)
"Save the `spam-stat' hash table as lisp file."
(interactive)
- (with-temp-buffer
- (let ((standard-output (current-buffer))
- (font-lock-maximum-size 0))
- (insert "(setq spam-stat-ngood "
- (number-to-string spam-stat-ngood)
- " spam-stat-nbad "
- (number-to-string spam-stat-nbad)
- " spam-stat (spam-stat-to-hash-table '(")
- (maphash (lambda (word entry)
- (prin1 (list word
- (spam-stat-good entry)
- (spam-stat-bad entry))))
- spam-stat)
- (insert ")))")
- (write-file spam-stat-file))))
+ (when (or force spam-stat-dirty)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer))
+ (font-lock-maximum-size 0))
+ (insert "(setq spam-stat-ngood "
+ (number-to-string spam-stat-ngood)
+ " spam-stat-nbad "
+ (number-to-string spam-stat-nbad)
+ " spam-stat (spam-stat-to-hash-table '(")
+ (maphash (lambda (word entry)
+ (prin1 (list word
+ (spam-stat-good entry)
+ (spam-stat-bad entry))))
+ spam-stat)
+ (insert ")))")
+ (write-file spam-stat-file)))
+ (setq spam-stat-dirty nil)))
(defun spam-stat-load ()
"Read the `spam-stat' hash table from disk."
- (load-file spam-stat-file))
+ ;; TODO: maybe we should warn the user if spam-stat-dirty is t?
+ (load-file spam-stat-file)
+ (setq spam-stat-dirty nil))
(defun spam-stat-to-hash-table (entries)
"Turn list ENTRIES into a hash table and store as `spam-stat'.
@@ -432,7 +443,8 @@
(interactive)
(setq spam-stat (make-hash-table :test 'equal)
spam-stat-ngood 0
- spam-stat-nbad 0))
+ spam-stat-nbad 0)
+ (setq spam-stat-dirty t))
;; Scoring buffers
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: spam.el mega patch
2003-11-23 13:38 ` Ted Zlatanov
@ 2003-11-24 12:46 ` Reiner Steib
2003-11-24 16:12 ` Ted Zlatanov
0 siblings, 1 reply; 6+ messages in thread
From: Reiner Steib @ 2003-11-24 12:46 UTC (permalink / raw)
On Sun, Nov 23 2003, Ted Zlatanov wrote:
> On Sun, 23 Nov 2003, tzz@lifelogs.com wrote:
>
>> I would really appreciate it if anyone looked over the attached
>> patch, which adds some significant fixes to spam.el, namely:
> [...]
>
> version 2 of the patch does the preceding, plus:
[...]
When I leave a group (nnml, which is neither classified as spam nor as
ham), I get:
Debugger entered--Lisp error: (error "Invalid argument 3")
call-process-region(1 1 nil nil nil nil "-d" "spam" "-h")
apply(call-process-region 1 1 nil nil nil nil "-d" "spam" "-h")
spam-ifile-register-with-ifile(nil "spam" t)
spam-ifile-register-spam-routine(nil t)
spam-ifile-unregister-spam-routine(nil)
spam-register-routine(spam spam-use-ifile t nil)
spam-summary-prepare-exit()
run-hooks(gnus-summary-prepare-exit-hook)
apply(run-hooks gnus-summary-prepare-exit-hook)
gnus-run-hooks(gnus-summary-prepare-exit-hook)
gnus-summary-exit()
call-interactively(gnus-summary-exit)
Note, that I don't use ifile at all and I only have set up spam
processors for some nnimap and ^gmane (nntp) groups (from my
`gnus-parameters'):
("Spam/spamblock"
(gnus-article-sort-functions '(gnus-article-sort-by-chars))
(ham-process-destination "nnimap+urz:INBOX" "nnimap+urz:bayes/ham")
(spam-contents gnus-group-spam-classification-spam))
("nnimap.*:\\(INBOX\\|[... some other groups ...]\\)"
(spam-process-destination . "nnimap+urz:bayes/spam")
(spam-contents gnus-group-spam-classification-ham))
("^gmane\\."
(spam-process (gnus-group-spam-exit-processor-report-gmane)))
Bye, Reiner.
--
,,,
(o o)
---ooO-(_)-Ooo--- PGP key available via WWW http://rsteib.home.pages.de/
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: spam.el mega patch
2003-11-24 12:46 ` Reiner Steib
@ 2003-11-24 16:12 ` Ted Zlatanov
2003-11-25 14:11 ` Reiner Steib
0 siblings, 1 reply; 6+ messages in thread
From: Ted Zlatanov @ 2003-11-24 16:12 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 1038 bytes --]
On Mon, 24 Nov 2003, 4.uce.03.r.s@nurfuerspam.de wrote:
> When I leave a group (nnml, which is neither classified as spam nor
> as ham), I get:
>
> Debugger entered--Lisp error: (error "Invalid argument 3")
> call-process-region(1 1 nil nil nil nil "-d" "spam" "-h")
Got it. Mega-patch #3 attached. Besides fixing this problem, I also
added ignore regexes for blacklisting, so for instance I have
(setq spam-blacklist-ignored-regexes '("tzz" "lifelogs"))
in my setup. I noticed this was a problem since spam is often sent
from spammers masquerading as you, but there's no way I could figure
out to block all the user's e-mail addresses easily. I could just
block the user's primary mail address, but I think that would create
a false sense of security because any secondary addresses would get
blocked while the primary worked.
I've been using the patch for 3 days now, and other than the problem
you noticed I haven't seen anything wrong with the behavior or
effects of the new registration/unregistration code.
Thanks
Ted
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: spam-mega3.patch --]
[-- Type: text/x-patch, Size: 58974 bytes --]
Index: gnus.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus.el,v
retrieving revision 6.208
diff -u -r6.208 gnus.el
--- gnus.el 21 Nov 2003 15:53:58 -0000 6.208
+++ gnus.el 24 Nov 2003 16:07:19 -0000
@@ -1832,50 +1832,50 @@
When a spam group is entered, all unread articles are marked as spam.")
(defvar gnus-group-spam-exit-processor-ifile "ifile"
- "The ifile summary exit spam processor.")
+ "OBSOLETE: The ifile summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-stat "stat"
- "The spam-stat summary exit spam processor.")
+ "OBSOLETE: The spam-stat summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
- "The Bogofilter summary exit spam processor.")
+ "OBSOLETE: The Bogofilter summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-blacklist "blacklist"
- "The Blacklist summary exit spam processor.")
+ "OBSOLETE: The Blacklist summary exit spam processor.")
(defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
- "The Gmane reporting summary exit spam processor.
+ "OBSOLETE: The Gmane reporting summary exit spam processor.
Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
(defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
- "The spamoracle summary exit spam processor.")
+ "OBSOLETE: The spamoracle summary exit spam processor.")
(defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
- "The ifile summary exit ham processor.
+ "OBSOLETE: The ifile summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
- "The Bogofilter summary exit ham processor.
+ "OBSOLETE: The Bogofilter summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-stat "stat-ham"
- "The spam-stat summary exit ham processor.
+ "OBSOLETE: The spam-stat summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-whitelist "whitelist"
- "The whitelist summary exit ham processor.
+ "OBSOLETE: The whitelist summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-BBDB "bbdb"
- "The BBDB summary exit ham processor.
+ "OBSOLETE: The BBDB summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-copy "copy"
- "The ham copy exit ham processor.
+ "OBSOLETE: The ham copy exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
- "The spamoracle summary exit ham processor.
+ "OBSOLETE: The spamoracle summary exit ham processor.
Only applicable to non-spam (unclassified and ham) groups.")
(gnus-define-group-parameter
@@ -1891,15 +1891,28 @@
(variable-item gnus-group-spam-exit-processor-stat)
(variable-item gnus-group-spam-exit-processor-bogofilter)
(variable-item gnus-group-spam-exit-processor-blacklist)
- (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-spam-exit-processor-spamoracle)
+ (variable-item gnus-group-spam-exit-processor-report-gmane)
(variable-item gnus-group-ham-exit-processor-bogofilter)
(variable-item gnus-group-ham-exit-processor-ifile)
(variable-item gnus-group-ham-exit-processor-stat)
(variable-item gnus-group-ham-exit-processor-whitelist)
(variable-item gnus-group-ham-exit-processor-BBDB)
+ (variable-item gnus-group-ham-exit-processor-spamoracle)
(variable-item gnus-group-ham-exit-processor-copy)
- (variable-item gnus-group-ham-exit-processor-spamoracle))))
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
:function-document
"Which spam or ham processors will be applied when the summary is exited."
:variable gnus-spam-process-newsgroups
@@ -1928,7 +1941,21 @@
(variable-item gnus-group-ham-exit-processor-whitelist)
(variable-item gnus-group-ham-exit-processor-BBDB)
(variable-item gnus-group-ham-exit-processor-spamoracle)
- (variable-item gnus-group-ham-exit-processor-copy))))
+ (variable-item gnus-group-ham-exit-processor-copy)
+ (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
+ (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
+ (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
+ (const :tag "Spam: ifile" (spam spam-use-ifile))
+ (const :tag "Spam: Spam-stat" (spam spam-use-stat))
+ (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
+ (const :tag "Ham: ifile" (ham spam-use-ifile))
+ (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
+ (const :tag "Ham: Spam-stat" (ham spam-use-stat))
+ (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
+ (const :tag "Ham: BBDB" (ham spam-use-BBDB))
+ (const :tag "Ham: Copy" (ham spam-use-ham-copy))
+ (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
+
:parameter-document
"Which spam or ham processors will be applied when the summary is exited.")
Index: spam-stat.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/spam-stat.el,v
retrieving revision 6.13
diff -u -r6.13 spam-stat.el
--- spam-stat.el 30 May 2003 20:05:05 -0000 6.13
+++ spam-stat.el 24 Nov 2003 16:07:19 -0000
@@ -183,6 +183,9 @@
"Syntax table used when processing mails for statistical analysis.
The important part is which characters are word constituents.")
+(defvar spam-stat-dirty nil
+ "Whether the spam-stat database needs saving.")
+
(defvar spam-stat-buffer nil
"Buffer to use for scoring while splitting.
This is set by hooking into Gnus.")
@@ -341,7 +344,8 @@
(setq entry (spam-stat-make-entry 0 count)))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat)))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
(defun spam-stat-buffer-is-non-spam ()
"Consider current buffer to be a new non-spam mail."
@@ -354,7 +358,8 @@
(setq entry (spam-stat-make-entry count 0)))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat)))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
(defun spam-stat-buffer-change-to-spam ()
"Consider current buffer no longer normal mail but spam."
@@ -369,7 +374,8 @@
(spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat))))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
(defun spam-stat-buffer-change-to-non-spam ()
"Consider current buffer no longer spam but normal mail."
@@ -384,32 +390,37 @@
(spam-stat-set-bad entry (- (spam-stat-bad entry) count))
(spam-stat-set-score entry (spam-stat-compute-score entry))
(puthash word entry spam-stat))))
- (spam-stat-buffer-words)))
+ (spam-stat-buffer-words))
+ (setq spam-stat-dirty t))
;; Saving and Loading
-(defun spam-stat-save ()
+(defun spam-stat-save (&optional force)
"Save the `spam-stat' hash table as lisp file."
(interactive)
- (with-temp-buffer
- (let ((standard-output (current-buffer))
- (font-lock-maximum-size 0))
- (insert "(setq spam-stat-ngood "
- (number-to-string spam-stat-ngood)
- " spam-stat-nbad "
- (number-to-string spam-stat-nbad)
- " spam-stat (spam-stat-to-hash-table '(")
- (maphash (lambda (word entry)
- (prin1 (list word
- (spam-stat-good entry)
- (spam-stat-bad entry))))
- spam-stat)
- (insert ")))")
- (write-file spam-stat-file))))
+ (when (or force spam-stat-dirty)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer))
+ (font-lock-maximum-size 0))
+ (insert "(setq spam-stat-ngood "
+ (number-to-string spam-stat-ngood)
+ " spam-stat-nbad "
+ (number-to-string spam-stat-nbad)
+ " spam-stat (spam-stat-to-hash-table '(")
+ (maphash (lambda (word entry)
+ (prin1 (list word
+ (spam-stat-good entry)
+ (spam-stat-bad entry))))
+ spam-stat)
+ (insert ")))")
+ (write-file spam-stat-file)))
+ (setq spam-stat-dirty nil)))
(defun spam-stat-load ()
"Read the `spam-stat' hash table from disk."
- (load-file spam-stat-file))
+ ;; TODO: maybe we should warn the user if spam-stat-dirty is t?
+ (load-file spam-stat-file)
+ (setq spam-stat-dirty nil))
(defun spam-stat-to-hash-table (entries)
"Turn list ENTRIES into a hash table and store as `spam-stat'.
@@ -432,7 +443,8 @@
(interactive)
(setq spam-stat (make-hash-table :test 'equal)
spam-stat-ngood 0
- spam-stat-nbad 0))
+ spam-stat-nbad 0)
+ (setq spam-stat-dirty t))
;; Scoring buffers
Index: spam.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/spam.el,v
retrieving revision 6.133
diff -u -r6.133 spam.el
--- spam.el 20 Nov 2003 14:52:28 -0000 6.133
+++ spam.el 24 Nov 2003 16:07:19 -0000
@@ -39,8 +39,9 @@
(require 'gnus-sum)
(require 'gnus-uu) ; because of key prefix issues
-(require 'gnus) ; for the definitions of group content classification and spam processors
-(require 'message) ;for the message-fetch-field functions
+;;; for the definitions of group content classification and spam processors
+(require 'gnus)
+(require 'message) ;for the message-fetch-field functions
;; for nnimap-split-download-body-default
(eval-when-compile (require 'nnimap))
@@ -140,6 +141,11 @@
: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
@@ -239,8 +245,11 @@
: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"))
+;;; 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"))
@@ -308,7 +317,7 @@
"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"))
+ (const :tag "Use the current group name"))
:group 'spam-ifile)
(defcustom spam-ifile-all-categories nil
@@ -343,6 +352,16 @@
: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
@@ -350,7 +369,8 @@
(defcustom spam-bogofilter-database-directory nil
"Directory path of the Bogofilter databases."
- :type '(choice (directory :tag "Location of the Bogofilter database directory")
+ :type '(choice (directory
+ :tag "Location of the Bogofilter database directory")
(const :tag "Use the default"))
:group 'spam-ifile)
@@ -380,7 +400,17 @@
"Msx" gnus-summary-mark-as-spam
"\M-d" gnus-summary-mark-as-spam)
+(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.")
+
+
;; convenience functions
+(defun spam-xor (a b) ; logical exclusive or
+ (and (or a b) (not (and a b))))
+
(defun spam-group-ham-mark-p (group mark &optional spam)
(when (stringp group)
(let* ((marks (spam-group-ham-marks group spam))
@@ -395,8 +425,8 @@
(defun spam-group-ham-marks (group &optional spam)
(when (stringp group)
(let* ((marks (if spam
- (gnus-parameter-spam-marks group)
- (gnus-parameter-ham-marks group)))
+ (gnus-parameter-spam-marks group)
+ (gnus-parameter-ham-marks group)))
(marks (car marks))
(marks (if (listp (car marks)) (car marks) marks)))
marks)))
@@ -417,12 +447,46 @@
(gnus-parameter-spam-contents group))
nil))
+(defvar spam-list-of-processors
+ '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
+ (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter)
+ (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)
+ (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-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-spamoracle ham spam-use-spamoracle))
+ "The spam-list-of-processors list contains pairs associating a
+ham/spam exit processor variable with a classification and a
+spam-use-* variable.")
+
(defun spam-group-processor-p (group processor)
(if (and (stringp group)
(symbolp processor))
- (member processor (car (gnus-parameter-spam-process group)))
+ (or (member processor (nth 0 (gnus-parameter-spam-process group)))
+ (spam-group-processor-multiple-p
+ group
+ (cdr-safe (assoc processor spam-list-of-processors))))
nil))
+(defun spam-group-processor-multiple-p (group processor-info)
+ (let* ((classification (nth 0 processor-info))
+ (check (nth 1 processor-info))
+ (parameters (nth 0 (gnus-parameter-spam-process group)))
+ found)
+ (dolist (parameter parameters)
+ (when (and (null found)
+ (listp parameter)
+ (eq classification (nth 0 parameter))
+ (eq check (nth 1 parameter)))
+ (setq found t)))
+ found))
+
(defun spam-group-spam-processor-report-gmane-p (group)
(spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
@@ -465,43 +529,58 @@
;;; 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 ()
(unless gnus-group-is-exiting-without-update-p
(gnus-message 6 "Exiting summary buffer and applying spam rules")
- (when (and spam-bogofilter-path
- (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
- (gnus-message 5 "Registering spam with bogofilter")
- (spam-bogofilter-register-spam-routine))
-
- (when (and spam-ifile-path
- (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
- (gnus-message 5 "Registering spam with ifile")
- (spam-ifile-register-spam-routine))
-
- (when (spam-group-spam-processor-spamoracle-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with spamoracle")
- (spam-spamoracle-learn-spam))
-
- (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with spam-stat")
- (spam-stat-register-spam-routine))
-
- (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with the blacklist")
- (spam-blacklist-register-routine))
-
- (when (spam-group-spam-processor-report-gmane-p gnus-newsgroup-name)
- (gnus-message 5 "Registering spam with the Gmane report")
- (spam-report-gmane-register-routine))
+
+ ;; 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 (gnus-set-difference old-articles new-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 processor))
+ (spam-register-routine classification check))))
(if spam-move-spam-nonspam-groups-only
(when (not (spam-group-spam-contents-p gnus-newsgroup-name))
(spam-mark-spam-as-expired-and-move-routine
(gnus-parameter-spam-process-destination gnus-newsgroup-name)))
- (gnus-message 5 "Marking spam as expired and moving it to %s" gnus-newsgroup-name)
+ (gnus-message 5 "Marking spam as expired and moving it to %s"
+ gnus-newsgroup-name)
(spam-mark-spam-as-expired-and-move-routine
(gnus-parameter-spam-process-destination gnus-newsgroup-name)))
@@ -514,24 +593,14 @@
(and (spam-group-spam-contents-p gnus-newsgroup-name)
spam-process-ham-in-spam-groups)
spam-process-ham-in-nonham-groups)
- (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with the whitelist")
- (spam-whitelist-register-routine))
- (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with ifile")
- (spam-ifile-register-ham-routine))
- (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with Bogofilter")
- (spam-bogofilter-register-ham-routine))
- (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with spam-stat")
- (spam-stat-register-ham-routine))
- (when (spam-group-ham-processor-BBDB-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with the BBDB")
- (spam-BBDB-register-routine))
- (when (spam-group-ham-processor-spamoracle-p gnus-newsgroup-name)
- (gnus-message 5 "Registering ham with spamoracle")
- (spam-spamoracle-learn-ham)))
+ ;; 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 processor))
+ (spam-register-routine classification check)))))
(when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
(gnus-message 5 "Copying ham")
@@ -542,7 +611,10 @@
(when (spam-group-spam-contents-p gnus-newsgroup-name)
(gnus-message 5 "Moving ham messages from spam group")
(spam-ham-move-routine
- (gnus-parameter-ham-process-destination gnus-newsgroup-name)))))
+ (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
+
+ (setq spam-old-ham-articles nil)
+ (setq spam-old-spam-articles nil))
(defun spam-mark-junk-as-spam-routine ()
;; check the global list of group names spam-junk-mailgroups and the
@@ -622,11 +694,11 @@
(gnus-summary-mark-article article gnus-unread-mark))
(gnus-summary-set-process-mark article))
- (if respool ; respooling is with a "fake" group
+ (if respool ; respooling is with a "fake" group
(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
+ (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
@@ -654,28 +726,6 @@
(apply 'spam-ham-move-routine (car groups))
(spam-ham-copy-or-move-routine nil groups)))
-(defun spam-generic-register-routine (spam-func ham-func)
- (let ((articles gnus-newsgroup-articles)
- article mark ham-articles spam-articles)
-
- (while articles
- (setq article (pop articles)
- mark (gnus-summary-article-mark article))
- (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark)
- (push article spam-articles))
- ((memq article gnus-newsgroup-saved))
- ((spam-group-ham-mark-p gnus-newsgroup-name mark)
- (push article ham-articles))))
-
- (when (and ham-articles ham-func)
- (mapc ham-func ham-articles)) ; we use mapc because unlike
- ; mapcar it discards the
- ; return values
- (when (and spam-articles spam-func)
- (mapc spam-func spam-articles)))) ; we use mapc because unlike
- ; mapcar it discards the
- ; return values
-
(eval-and-compile
(defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
'point-at-eol
@@ -683,12 +733,12 @@
(defun spam-get-article-as-string (article)
(let ((article-buffer (spam-get-article-as-buffer article))
- article-string)
+ article-string)
(when article-buffer
(save-window-excursion
(set-buffer article-buffer)
(setq article-string (buffer-string))))
- article-string))
+ article-string))
(defun spam-get-article-as-buffer (article)
(let ((article-buffer))
@@ -703,8 +753,10 @@
;; (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)))
+;; (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)))
@@ -713,40 +765,45 @@
"Fetch the `from' field quickly, using the internal gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-from (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-from
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun spam-fetch-field-subject-fast (article)
- "Fetch the `subject' field quickly, using the internal gnus-data-list function"
+ "Fetch the `subject' field quickly, using the internal
+ gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-subject (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-subject
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
(defun spam-fetch-field-message-id-fast (article)
- "Fetch the `subject' field quickly, using the internal gnus-data-list function"
+ "Fetch the `subject' field quickly, using the internal
+ gnus-data-list function"
(if (and (numberp article)
(assoc article (gnus-data-list nil)))
- (mail-header-message-id (gnus-data-header (assoc article (gnus-data-list nil))))
+ (mail-header-message-id
+ (gnus-data-header (assoc article (gnus-data-list nil))))
nil))
\f
;;;; Spam determination.
(defvar spam-list-of-checks
- '((spam-use-blacklist . spam-check-blacklist)
- (spam-use-regex-headers . spam-check-regex-headers)
- (spam-use-regex-body . spam-check-regex-body)
- (spam-use-whitelist . spam-check-whitelist)
- (spam-use-BBDB . 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-bogofilter-headers . spam-check-bogofilter-headers)
- (spam-use-bogofilter . spam-check-bogofilter))
-"The spam-list-of-checks list contains pairs associating a parameter
+ '((spam-use-blacklist . spam-check-blacklist)
+ (spam-use-regex-headers . spam-check-regex-headers)
+ (spam-use-regex-body . spam-check-regex-body)
+ (spam-use-whitelist . spam-check-whitelist)
+ (spam-use-BBDB . 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-bogofilter-headers . spam-check-bogofilter-headers)
+ (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
@@ -758,12 +815,16 @@
name is the value of `spam-split-group', meaning that the message is
definitely a spam.")
-(defvar spam-list-of-statistical-checks
- '(spam-use-ifile spam-use-regex-body spam-use-stat spam-use-bogofilter spam-use-spamoracle)
-"The spam-list-of-statistical-checks list contains all the mail
+(defvar spam-list-of-statistical-checks
+ '(spam-use-ifile
+ spam-use-regex-body
+ spam-use-stat
+ spam-use-bogofilter
+ spam-use-spamoracle)
+ "The spam-list-of-statistical-checks list contains all the mail
splitters that need to have the full message body available.")
-;;;TODO: modify to invoke self with each specific check if invoked without specific checks
+;;;TODO: modify to invoke self with each check if invoked without specifics
(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',
@@ -803,18 +864,158 @@
nil
decision)))))))
+(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-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 is not a legitimate check
+ (spam-use-gmane nil
+ spam-report-gmane-register-routine
+ ;; does Gmane support unregistration?
+ nil
+ nil)
+ (spam-use-bogofilter spam-bogofilter-register-ham-routine
+ spam-bogofilter-register-spam-routine
+ spam-bogofilter-unregister-ham-routine
+ spam-bogofilter-unregister-spam-routine))
+ "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))
+ mark list)
+ (dolist (article articles)
+ (when (funcall mark-check
+ gnus-newsgroup-name
+ (gnus-summary-article-mark article))
+ (push article list)))
+ list))
+
+(defun spam-register-routine (classification
+ check
+ &optional unregister
+ specific-articles)
+ (when (and (spam-classification-valid-p classification)
+ (spam-registration-check-valid-p check))
+ (gnus-message 5 "%s %s articles with classification %s, check %s"
+ (if unregister "Unregistering" "Registering")
+ (if specific-articles "specific" "")
+ (symbol-name classification)
+ (symbol-name 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
+ (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))))))
+
+(defun spam-generic-register-routine (spam-func ham-func)
+ (let ((articles gnus-newsgroup-articles)
+ article mark ham-articles spam-articles)
+
+ (while articles
+ (setq article (pop articles)
+ mark (gnus-summary-article-mark article))
+ (cond ((spam-group-spam-mark-p gnus-newsgroup-name mark)
+ (push article spam-articles))
+ ((memq article gnus-newsgroup-saved))
+ ((spam-group-ham-mark-p gnus-newsgroup-name mark)
+ (push article ham-articles))))
+
+ (when (and ham-articles ham-func)
+ (mapc ham-func ham-articles)) ; we use mapc because unlike
+ ; mapcar it discards the
+ ; return values
+ (when (and spam-articles spam-func)
+ (mapc spam-func spam-articles)))) ; we use mapc because unlike
+ ; mapcar it discards the
+ ; return values
+
;;; 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)
- (or (eq type 'incoming)
- (eq type 'process))
- (or (eq classification 'spam)
- (eq classification 'ham))
- (assoc check spam-list-of-checks))
+ (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)))
+ (cell (list classification check group)))
(push cell cell-list)
(gnus-registry-store-extra-entry
id
@@ -828,11 +1029,9 @@
(defun spam-log-unregistration-needed-p (id type classification check)
(when spam-log-to-registry
(if (and (stringp id)
- (or (eq type 'incoming)
- (eq type 'process))
- (or (eq classification 'spam)
- (eq classification 'ham))
- (assoc check spam-list-of-checks))
+ (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)
@@ -846,6 +1045,30 @@
"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 5 (format "%s called with bad ID, type, 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)
@@ -865,7 +1088,7 @@
(defun spam-check-regex-headers (&optional body)
(let ((type (if body "body" "header"))
- ret found)
+ ret found)
(dolist (h-regex spam-regex-headers-ham)
(unless found
(goto-char (point-min))
@@ -936,7 +1159,7 @@
(defun spam-check-hashcash ()
"Check the headers for hashcash payments."
- (mail-check-payment))) ;mail-check-payment returns a boolean
+ (mail-check-payment))) ;mail-check-payment returns a boolean
(file-error (progn
(defalias 'mail-check-payment 'ignore)
@@ -954,42 +1177,49 @@
(require 'bbdb)
(require 'bbdb-com)
- (defun spam-enter-ham-BBDB (from)
- "Enter an address into the BBDB; implies ham (non-spam) sender"
- (when (stringp from)
- (let* ((parsed-address (gnus-extract-address-components from))
- (name (or (car parsed-address) "Ham Sender"))
- (net-address (car (cdr parsed-address))))
- (gnus-message 5 "Adding address %s to BBDB" from)
- (when (and net-address
- (not (bbdb-search-simple nil net-address)))
- (bbdb-create-internal name nil net-address nil nil
- "ham sender added by spam.el")))))
-
- (defun spam-BBDB-register-routine ()
- (spam-generic-register-routine
- ;; spam function
- nil
- ;; ham function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-BBDB
- gnus-newsgroup-name)
- (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
-
- (defun spam-check-BBDB ()
- "Mail from people in the BBDB is classified as ham or non-spam"
- (let ((who (nnmail-fetch-field "from")))
- (when who
- (setq who (cadr (gnus-extract-address-components who)))
- (if (bbdb-search-simple nil who)
- t
- (if spam-use-BBDB-exclusive
- spam-split-group
- nil))))))
+ (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 5 "%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 (nnmail-fetch-field "from")))
+ (when who
+ (setq who (nth 1 (gnus-extract-address-components who)))
+ (if (bbdb-search-simple nil who)
+ t
+ (if spam-use-BBDB-exclusive
+ spam-split-group
+ nil))))))
(file-error (progn
(defalias 'bbdb-search-simple 'ignore)
@@ -997,6 +1227,7 @@
(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))))
\f
@@ -1006,7 +1237,8 @@
;;; as spam
(defun spam-get-ifile-database-parameter ()
- "Get the command-line parameter for ifile's database from spam-ifile-database-path."
+ "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))
@@ -1020,11 +1252,11 @@
(db-param (spam-get-ifile-database-parameter)))
(save-excursion
(set-buffer article-buffer-name)
- (if db-param
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil temp-buffer-name nil "-q" "-c" db-param)
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil temp-buffer-name nil "-q" "-c")))
+ (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) (spam-point-at-eol))))
@@ -1033,50 +1265,38 @@
(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))))))
+ (setq return spam-split-group)))))) ; note return is nil otherwise
return))
-(defun spam-ifile-register-with-ifile (article-string category)
+(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)."
- (when (stringp article-string)
- (let ((category (or category gnus-newsgroup-name))
- (db-param (spam-get-ifile-database-parameter)))
- (with-temp-buffer
- (insert article-string)
- (if db-param
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil nil nil
- "-h" "-i" category db-param)
- (call-process-region (point-min) (point-max) spam-ifile-path
- nil nil nil
- "-h" "-i" category))))))
-
-(defun spam-ifile-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-ifile
- gnus-newsgroup-name)
- (spam-ifile-register-with-ifile
- (spam-get-article-as-string article) spam-ifile-spam-category))
- nil))
-
-(defun spam-ifile-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-ifile
- gnus-newsgroup-name)
- (spam-ifile-register-with-ifile
- (spam-get-article-as-string article) spam-ifile-ham-category))))
+ (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))
\f
;;;; spam-stat
@@ -1093,35 +1313,33 @@
category return)
(spam-stat-split-fancy)))
- (defun spam-stat-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-stat
- gnus-newsgroup-name)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (spam-stat-buffer-is-spam))))
- nil))
-
- (defun spam-stat-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-stat
- gnus-newsgroup-name)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (spam-stat-buffer-is-non-spam))))))
+ (defun spam-stat-register-spam-routine (articles &optional unregister)
+ (spam-stat-load)
+ (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)))))
+ (spam-stat-save))
+
+ (defun spam-stat-unregister-spam-routine (articles)
+ (spam-stat-register-spam-routine articles t))
+
+ (defun spam-stat-register-ham-routine (articles &optional unregister)
+ (spam-stat-load)
+ (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)))))
+ (spam-stat-save))
+
+ (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)))
@@ -1133,9 +1351,13 @@
(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-stat-load 'ignore)
(defalias 'spam-stat-save 'ignore)
@@ -1148,34 +1370,56 @@
(defvar spam-whitelist-cache nil)
(defvar spam-blacklist-cache nil)
-(defun spam-enter-whitelist (address)
- "Enter ADDRESS into the whitelist."
+(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)
+ (spam-enter-list address spam-whitelist remove)
(setq spam-whitelist-cache nil))
-(defun spam-enter-blacklist (address)
- "Enter ADDRESS into the blacklist."
+;;; 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)
+ (spam-enter-list address spam-blacklist remove)
(setq spam-blacklist-cache nil))
-(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-min))
- (unless (re-search-forward (regexp-quote address) nil t)
- (goto-char (point-max))
- (unless (bobp)
- (insert "\n"))
- (insert address "\n")
+(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))))
-;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise
+;;; 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-whitelist-cache
@@ -1202,7 +1446,7 @@
(forward-line 1)
;; insert the e-mail address if detected, otherwise the raw data
(unless (zerop (length address))
- (let ((pure-address (cadr (gnus-extract-address-components address))))
+ (let ((pure-address (nth 1 (gnus-extract-address-components address))))
(push (or pure-address address) contents)))))
(nreverse contents))))
@@ -1221,44 +1465,61 @@
cache nil))))
found))
-(defun spam-blacklist-register-routine ()
- (spam-generic-register-routine
- ;; the spam function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-blacklist
- gnus-newsgroup-name)
- (let ((from (spam-fetch-field-from-fast article)))
- (when (stringp from)
- (spam-enter-blacklist from))))
- ;; the ham function
- nil))
-
-(defun spam-whitelist-register-routine ()
- (spam-generic-register-routine
- ;; the spam function
- nil
- ;; the ham function
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-whitelist
- gnus-newsgroup-name)
- (let ((from (spam-fetch-field-from-fast article)))
- (when (stringp from)
- (spam-enter-whitelist from))))))
+(defun spam-filelist-register-routine (articles blacklist &optional unregister)
+ (let ((de-symbol (if blacklist 'use-spam-whitelist 'use-spam-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)
+ (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 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 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))
\f
;;;; Spam-report glue
-(defun spam-report-gmane-register-routine ()
- (spam-generic-register-routine
- 'spam-report-gmane
- nil))
+(defun spam-report-gmane-register-routine (articles)
+ (apply 'spam-report-gmane articles))
\f
;;;; Bogofilter
@@ -1289,62 +1550,57 @@
(defun spam-check-bogofilter (&optional score)
"Check the Bogofilter backend for the classification of this message"
- (let ((article-buffer-name (buffer-name))
+ (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)
- (if spam-bogofilter-database-directory
- (call-process-region (point-min) (point-max)
- spam-bogofilter-path
- nil temp-buffer-name nil "-v"
- "-d" spam-bogofilter-database-directory)
- (call-process-region (point-min) (point-max) spam-bogofilter-path
- nil temp-buffer-name nil "-v")))
- (setq return (spam-check-bogofilter-headers score))))
+ (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 (article-string spam)
+(defun spam-bogofilter-register-with-bogofilter (articles
+ spam
+ &optional unregister)
"Register an article, given as a string, as spam or non-spam."
- (when (stringp article-string)
- (let ((switch (if spam spam-bogofilter-spam-switch
- spam-bogofilter-ham-switch)))
- (with-temp-buffer
- (insert article-string)
- (if spam-bogofilter-database-directory
- (call-process-region (point-min) (point-max)
- spam-bogofilter-path
- nil nil nil "-v" switch
- "-d" spam-bogofilter-database-directory)
- (call-process-region (point-min) (point-max) spam-bogofilter-path
- nil nil nil "-v" switch))))))
-
-(defun spam-bogofilter-register-spam-routine ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-bogofilter
- gnus-newsgroup-name)
- (spam-bogofilter-register-with-bogofilter
- (spam-get-article-as-string article) t))
- nil))
-
-(defun spam-bogofilter-register-ham-routine ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-bogofilter
- gnus-newsgroup-name)
- (spam-bogofilter-register-with-bogofilter
- (spam-get-article-as-string article) nil))))
+ (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))
+
\f
;;;; spamoracle
@@ -1371,14 +1627,17 @@
spam-split-group))
(error "Error running spamoracle" status))))))))
-(defun spam-spamoracle-learn (article article-is-spam-p)
+(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))
- (insert (spam-get-article-as-string article))
- (let* ((arg (if article-is-spam-p "-spam" "-good"))
+ (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)
@@ -1390,30 +1649,19 @@
`("add" ,arg)))))
(when (not (zerop status))
(error "Error running spamoracle" status)))))))
-
-(defun spam-spamoracle-learn-ham ()
- (spam-generic-register-routine
- nil
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'ham
- 'spam-use-spamoracle
- gnus-newsgroup-name)
- (spam-spamoracle-learn article nil))))
-
-(defun spam-spamoracle-learn-spam ()
- (spam-generic-register-routine
- (lambda (article)
- (spam-log-processing-to-registry
- (spam-fetch-field-message-id-fast article)
- 'process
- 'spam
- 'spam-use-spamoracle
- gnus-newsgroup-name)
- (spam-spamoracle-learn article t))
- nil))
+
+(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))
+
\f
;;;; Hooks
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: spam.el mega patch
2003-11-24 16:12 ` Ted Zlatanov
@ 2003-11-25 14:11 ` Reiner Steib
2003-11-25 18:26 ` Ted Zlatanov
0 siblings, 1 reply; 6+ messages in thread
From: Reiner Steib @ 2003-11-25 14:11 UTC (permalink / raw)
On Mon, Nov 24 2003, Ted Zlatanov wrote:
> ;;;; Spam-report glue
> -(defun spam-report-gmane-register-routine ()
> - (spam-generic-register-routine
> - 'spam-report-gmane
> - nil))
> +(defun spam-report-gmane-register-routine (articles)
> + (apply 'spam-report-gmane articles))
`apply' fails here when `articles' is nil:
,----
| ELISP> (defun rs-1 (arg)
| t)
| rs-1
| ELISP> (rs-1 nil)
| t
| ELISP> (apply 'rs-1 nil)
| *** Eval error *** Wrong number of arguments: (lambda (arg) t), 0
| ELISP>
`----
I don't know what's better: Calling `spam-report-gmane' only if
`articles' is non-nil[1], making `articles' in `spam-report-gmane'
optional[2] or use something else (what?) instead of `apply'.
[1]
(defun spam-report-gmane-register-routine (articles)
(when articles
(apply 'spam-report-gmane articles)))
[2]
(defun spam-report-gmane (&optional article)
"Report an article as spam through Gmane"
(interactive "nEnter the article number: ")
(when (and article
gnus-newsgroup-name
[...])))
Bye, Reiner.
--
,,,
(o o)
---ooO-(_)-Ooo--- PGP key available via WWW http://rsteib.home.pages.de/
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: spam.el mega patch
2003-11-25 14:11 ` Reiner Steib
@ 2003-11-25 18:26 ` Ted Zlatanov
0 siblings, 0 replies; 6+ messages in thread
From: Ted Zlatanov @ 2003-11-25 18:26 UTC (permalink / raw)
On Tue, 25 Nov 2003, 4.uce.03.r.s@nurfuerspam.de wrote:
On Mon, Nov 24 2003, Ted Zlatanov wrote:
>
>> ;;;; Spam-report glue
>> -(defun spam-report-gmane-register-routine ()
>> - (spam-generic-register-routine
>> - 'spam-report-gmane
>> - nil))
>> +(defun spam-report-gmane-register-routine (articles)
>> + (apply 'spam-report-gmane articles))
>
> `apply' fails here when `articles' is nil:
> I don't know what's better: Calling `spam-report-gmane' only if
> `articles' is non-nil[1], making `articles' in `spam-report-gmane'
> optional[2] or use something else (what?) instead of `apply'.
I don't call apply if articles is nil - that's the most sensible
approach. Thanks.
Since the mega-patch has been stable, I'll commit it to CVS. Thanks
for your help with debugging it.
Ted
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2003-11-25 18:26 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2003-11-23 6:04 spam.el mega patch Ted Zlatanov
2003-11-23 13:38 ` Ted Zlatanov
2003-11-24 12:46 ` Reiner Steib
2003-11-24 16:12 ` Ted Zlatanov
2003-11-25 14:11 ` Reiner Steib
2003-11-25 18:26 ` Ted Zlatanov
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).