From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/54928 Path: main.gmane.org!not-for-mail From: Ted Zlatanov Newsgroups: gmane.emacs.gnus.general Subject: Re: spam.el mega patch Date: Mon, 24 Nov 2003 11:12:39 -0500 Organization: =?koi8-r?q?=F4=C5=CF=C4=CF=D2=20=FA=CC=C1=D4=C1=CE=CF=D7?= @ Cienfuegos Sender: ding-owner@lists.math.uh.edu Message-ID: <4nr7zxeoeg.fsf@lockgroove.bwh.harvard.edu> References: <4n7k1rsjry.fsf@lockgroove.bwh.harvard.edu> <4n3ccfryr4.fsf@lockgroove.bwh.harvard.edu> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1069716400 24307 80.91.224.253 (24 Nov 2003 23:26:40 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Mon, 24 Nov 2003 23:26:40 +0000 (UTC) Original-X-From: ding-owner+M3468@lists.math.uh.edu Tue Nov 25 00:26:34 2003 Return-path: Original-Received: from malifon.math.uh.edu ([129.7.128.13]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1AOQ6D-0007yU-00 for ; Tue, 25 Nov 2003 00:26:33 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 1AOQ5k-0005PG-00; Mon, 24 Nov 2003 17:26:04 -0600 Original-Received: from justine.libertine.org ([66.139.78.221] ident=postfix) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 1AOJOY-0003rR-00 for ding@lists.math.uh.edu; Mon, 24 Nov 2003 10:17:02 -0600 Original-Received: from clifford.bwh.harvard.edu (unknown [134.174.9.41]) by justine.libertine.org (Postfix) with ESMTP id 824DC3A0042 for ; Mon, 24 Nov 2003 10:16:18 -0600 (CST) Original-Received: from lockgroove.bwh.harvard.edu (lockgroove [134.174.9.133]) by clifford.bwh.harvard.edu (8.10.2+Sun/8.11.0) with ESMTP id hAOGDD710806 for ; Mon, 24 Nov 2003 11:13:14 -0500 (EST) Original-Received: (from tzz@localhost) by lockgroove.bwh.harvard.edu (8.11.6+Sun/8.11.0) id hAOGCfK03305; Mon, 24 Nov 2003 11:12:41 -0500 (EST) Original-To: ding@gnus.org X-Face: bd.DQ~'29fIs`T_%O%C\g%6jW)yi[zuz6;d4V0`@y-~$#3P_Ng{@m+e4o<4P'#(_GJQ%TT= D}[Ep*b!\e,fBZ'j_+#"Ps?s2!4H2-Y"sx" Mail-Followup-To: ding@gnus.org In-Reply-To: (Reiner Steib's message of "Mon, 24 Nov 2003 13:46:31 +0100") User-Agent: Gnus/5.1003 (Gnus v5.10.3) Emacs/21.3.50 (usg-unix-v) Precedence: bulk Xref: main.gmane.org gmane.emacs.gnus.general:54928 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:54928 --=-=-= 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=spam-mega3.patch 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)) ;;;; 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)))) @@ -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)) ;;;; 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)) ;;;; 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)) ;;;; 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)) + ;;;; 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)) + ;;;; Hooks --=-=-=--