X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fspam.el;h=4d4c9f09825025c6d9322f1d29253ae9aca43da8;hp=7577a710014421ea462f259f15b1915958f4e301;hb=13064ac85b6eb8614b74dec7439bab1483abec2d;hpb=6e719e3b8ded612ed52bea66846b13a1f96a78b3 diff --git a/lisp/spam.el b/lisp/spam.el index 7577a7100..4d4c9f098 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -55,7 +55,8 @@ ;; autoload spam-report (eval-and-compile - (autoload 'spam-report-gmane "spam-report")) + (autoload 'spam-report-gmane "spam-report") + (autoload 'spam-report-resend "spam-report")) ;; autoload gnus-registry (eval-and-compile @@ -275,6 +276,11 @@ them." :type 'boolean :group 'spam) +(defcustom spam-use-crm114 nil + "Whether the CRM114 Mailfilter should be used by `spam-split'." + :type 'boolean + :group 'spam) + (defcustom spam-install-hooks (or spam-use-dig spam-use-gmane-xref @@ -295,7 +301,8 @@ them." spam-use-BBDB-exclusive spam-use-ifile spam-use-stat - spam-use-spamoracle) + spam-use-spamoracle + spam-use-crm114) "Whether the spam hooks should be installed. Default to t if one of the spam-use-* variables is set." :group 'spam @@ -576,6 +583,53 @@ order for SpamAssassin to recognize the new registered spam." :type 'string :group 'spam-spamassassin) +(defgroup spam-crm114 nil + "Spam CRM114 Mailfilter configuration." + :group 'spam) + +(defcustom spam-crm114-program (executable-find "mailfilter.crm") + "File path of the CRM114 Mailfilter executable program." + :type '(choice (file :tag "Location of CRM114 Mailfilter") + (const :tag "CRM114 Mailfilter is not installed")) + :group 'spam-crm114) + +(defcustom spam-crm114-header "X-CRM114-Status" + "The header that CRM114 Mailfilter inserts in messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-spam-switch "--learnspam" + "The switch that CRM114 Mailfilter uses to register spam messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-ham-switch "--learnnonspam" + "The switch that CRM114 Mailfilter uses to register ham messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-spam-strong-switch "--UNKNOWN" + "The switch that CRM114 Mailfilter uses to unregister ham messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-ham-strong-switch "--UNKNOWN" + "The switch that CRM114 Mailfilter uses to unregister spam messages." + :type 'string + :group 'spam-crm114) + +(defcustom spam-crm114-positive-spam-header "^SPAM" + "The regex on `spam-crm114-header' for positive spam identification." + :type 'regexp + :group 'spam-crm114) + +(defcustom spam-crm114-database-directory nil + "Directory path of the CRM114 Mailfilter databases." + :type '(choice (directory + :tag "Location of the CRM114 Mailfilter database directory") + (const :tag "Use the default")) + :group 'spam-crm114) + ;;; Key bindings for spam control. (gnus-define-keys gnus-summary-mode-map @@ -659,13 +713,16 @@ finds ham or spam.") nil)) (defvar spam-list-of-processors - '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane) + ;; note the nil processors are not defined in gnus.el + '((nil spam spam-use-gmane) + (nil spam spam-use-resend) (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter) (gnus-group-spam-exit-processor-bsfilter spam spam-use-bsfilter) (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist) (gnus-group-spam-exit-processor-ifile spam spam-use-ifile) (gnus-group-spam-exit-processor-stat spam spam-use-stat) (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) + (nil spam spam-use-crm114) (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin) (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) @@ -675,80 +732,55 @@ finds ham or spam.") (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) (gnus-group-ham-exit-processor-spamassassin ham spam-use-spamassassin) - (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle)) + (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle) + (nil ham spam-use-crm114)) "The `spam-list-of-processors' list. -This list contains pairs associating a ham/spam exit processor -variable with a classification and a spam-use-* variable.") - -(defun spam-group-processor-p (group processor) +This list contains pairs associating the obsolete ham/spam exit +processor variables with a classification and a spam-use-* +variable. When the processor variable is nil, just the +classification and spam-use-* check variable are used.") + +(defun spam-group-processor-p (group check &optional classification) + "Checks if GROUP has a CHECK with CLASSIFICATION registered. +Also accepts the obsolete processors, which can be found in +gnus.el and in spam-list-of-processors." (if (and (stringp group) - (symbolp processor)) - (or (member processor (nth 0 (gnus-parameter-spam-process group))) - (spam-group-processor-multiple-p - group - (cdr-safe (assoc processor spam-list-of-processors)))) + (symbolp check)) + (let ((old-style (assq check spam-list-of-processors)) + (parameters (nth 0 (gnus-parameter-spam-process group))) + found) + (if old-style ; old-style processor + (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style)) + ;; now search for the parameter + (dolist (parameter parameters) + (when (and (null found) + (listp parameter) + (eq classification (nth 0 parameter)) + (eq check (nth 1 parameter))) + (setq found t))) + found)) nil)) -(defun spam-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)) - -(defun spam-group-spam-processor-bogofilter-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter)) - -(defun spam-group-spam-processor-blacklist-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist)) - -(defun spam-group-spam-processor-ifile-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile)) - -(defun spam-group-ham-processor-ifile-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile)) - -(defun spam-group-spam-processor-spamoracle-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle)) - -(defun spam-group-ham-processor-bogofilter-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter)) - -(defun spam-group-spam-processor-stat-p (group) - (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat)) - -(defun spam-group-ham-processor-stat-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat)) - -(defun spam-group-ham-processor-whitelist-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist)) - -(defun spam-group-ham-processor-BBDB-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB)) - -(defun spam-group-ham-processor-copy-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy)) - -(defun spam-group-ham-processor-spamoracle-p (group) - (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle)) - (defun spam-report-articles-gmane (n) - "Report the current message as spam. + "Report the current message as spam via Gmane. Respects the process/prefix convention." (interactive "P") (dolist (article (gnus-summary-work-articles n)) (gnus-summary-remove-process-mark article) (spam-report-gmane article))) +(defun spam-report-articles-resend (n) + "Report the current message as spam by resending it. +Respects the process/prefix convention. Also see +`spam-report-resend-to'." + (interactive "P") + (let ((spam-report-resend-to + (gnus-parameter-spam-resend-to gnus-newsgroup-name)) + (articles (gnus-summary-work-articles n))) + (spam-report-resend articles) + (dolist (article articles) + (gnus-summary-remove-process-mark article)))) + (defun spam-necessary-extra-headers () "Return the extra headers spam.el thinks are necessary." (let (list) @@ -781,6 +813,9 @@ Respects the process/prefix convention." (string-to-number (gnus-replace-in-string (gnus-extra-header header headers) ".*hits=" ""))) + ;; for CRM checking, it's probably faster to just do the string match + ((and spam-use-crm114 (string-match "( pR: \\([0-9.-]+\\)" header)) + (match-string 1 header)) (t nil)) nil)) @@ -807,6 +842,8 @@ Will not return a nil score." (spam-spamassassin-score recheck)) ((or spam-use-bsfilter spam-use-bsfilter-headers) (spam-bsfilter-score recheck)) + (spam-use-crm114 + (spam-crm114-score)) (t (spam-bogofilter-score recheck)))) ;;; Summary entry and exit processing. @@ -847,7 +884,7 @@ Will not return a nil score." ;; 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 + (spam-register-routine classification check t unregister-list)))))) ;; find all the spam processors applicable to this group @@ -856,24 +893,26 @@ Will not return a nil score." (classification (nth 1 processor-param)) (check (nth 2 processor-param))) (when (and (eq 'spam classification) - (spam-group-processor-p gnus-newsgroup-name processor)) + (spam-group-processor-p gnus-newsgroup-name check classification)) (spam-register-routine classification check)))) (unless (and spam-move-spam-nonspam-groups-only (spam-group-spam-contents-p gnus-newsgroup-name)) - (gnus-message 6 "Marking spam as expired and moving it to %s" - (gnus-parameter-spam-process-destination + (let* ((group (gnus-parameter-spam-process-destination gnus-newsgroup-name)) - (spam-mark-spam-as-expired-and-move-routine - (gnus-parameter-spam-process-destination gnus-newsgroup-name))) + (num (spam-mark-spam-as-expired-and-move-routine group))) + (when (> num 0) + (gnus-message 6 + "%d spam messages are marked as expired and moved it to %s" + num group)))) ;; now we redo spam-mark-spam-as-expired-and-move-routine to only ;; expire spam, in case the above did not expire them - (when (< 0 (spam-list-articles - gnus-newsgroup-articles - 'spam)) - (gnus-message 6 "Marking spam as expired without moving it") - (spam-mark-spam-as-expired-and-move-routine nil)) + (let ((num (spam-mark-spam-as-expired-and-move-routine nil))) + (when (> num 0) + (gnus-message 6 + "%d spam messages are markd as expired without moving it" + num))) (when (or (spam-group-ham-contents-p gnus-newsgroup-name) (and (spam-group-spam-contents-p gnus-newsgroup-name) @@ -885,19 +924,23 @@ Will not return a nil score." (classification (nth 1 processor-param)) (check (nth 2 processor-param))) (when (and (eq 'ham classification) - (spam-group-processor-p gnus-newsgroup-name processor)) + (spam-group-processor-p gnus-newsgroup-name check classification)) (spam-register-routine classification check))))) - (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) - (gnus-message 6 "Copying ham") - (spam-ham-copy-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name))) + (when (spam-group-processor-p gnus-newsgroup-name 'ham 'spam-use-ham-copy) + (let ((num + (spam-ham-copy-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) + (when (> num 0) + (gnus-message 6 "%d ham messages are copied" num)))) ;; now move all ham articles out of spam groups (when (spam-group-spam-contents-p gnus-newsgroup-name) - (gnus-message 6 "Moving ham messages from spam group") - (spam-ham-move-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) + (let ((num + (spam-ham-move-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) + (when (> num 0) + (gnus-message 6 "%d ham messages are moved from spam group" num))))) (setq spam-old-ham-articles nil) (setq spam-old-spam-articles nil)) @@ -967,7 +1010,8 @@ When either list is nil, the other is returned." (let ((gnus-novice-user nil)) ; don't ask me if I'm sure (gnus-summary-delete-article nil)))) - (gnus-summary-yank-process-mark)))) + (gnus-summary-yank-process-mark) + (length tomove)))) (defun spam-ham-copy-or-move-routine (copy groups) (gnus-summary-kill-process-mark) @@ -1011,9 +1055,10 @@ When either list is nil, the other is returned." (gnus-summary-set-process-mark article)) (when todo (let ((gnus-novice-user nil)) ; don't ask me if I'm sure - (gnus-summary-delete-article nil)))))) + (gnus-summary-delete-article nil))))) - (gnus-summary-yank-process-mark)) + (gnus-summary-yank-process-mark) + (length todo))) (defun spam-ham-copy-routine (&rest groups) (if (and (car-safe groups) (listp (car-safe groups))) @@ -1126,7 +1171,8 @@ When either list is nil, the other is returned." (spam-use-bogofilter-headers . spam-check-bogofilter-headers) (spam-use-bogofilter . spam-check-bogofilter) (spam-use-bsfilter-headers . spam-check-bsfilter-headers) - (spam-use-bsfilter . spam-check-bsfilter)) + (spam-use-bsfilter . spam-check-bsfilter) + (spam-use-crm114 . spam-check-crm114)) "The spam-list-of-checks list contains pairs associating a parameter variable with a spam checking function. If the parameter variable is true, then the checking function is called, @@ -1149,7 +1195,8 @@ definitely a spam.") spam-use-bsfilter spam-use-blackholes spam-use-spamassassin - spam-use-spamoracle) + spam-use-spamoracle + spam-use-crm114) "The spam-list-of-statistical-checks list contains all the mail splitters that need to have the full message body available. Note that you should fetch extra headers if you don't like this, @@ -1317,12 +1364,16 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." 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 + ;; note that spam-use-gmane and spam-use-resend are not legitimate checks (spam-use-gmane nil spam-report-gmane-register-routine ;; does Gmane support unregistration? nil nil) + (spam-use-resend nil + spam-report-resend-register-routine + nil + nil) (spam-use-spamassassin spam-spamassassin-register-ham-routine spam-spamassassin-register-spam-routine spam-spamassassin-unregister-ham-routine @@ -1334,7 +1385,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (spam-use-bsfilter spam-bsfilter-register-ham-routine spam-bsfilter-register-spam-routine spam-bsfilter-unregister-ham-routine - spam-bsfilter-unregister-spam-routine)) + spam-bsfilter-unregister-spam-routine) + (spam-use-crm114 spam-crm114-register-ham-routine + spam-crm114-register-spam-routine + ;; does CRM114 Mailfilter support unregistration? + nil + nil)) "The spam-registration-functions list contains pairs associating a parameter variable with the ham and spam registration functions, and the ham and spam unregistration @@ -2050,6 +2106,10 @@ REMOVE not nil, remove the ADDRESSES." (when articles (apply 'spam-report-gmane articles))) +(defun spam-report-resend-register-routine (articles) + (let ((spam-report-resend-to (gnus-parameter-spam-resend-to gnus-newsgroup-name))) + (spam-report-resend articles))) + ;;;; Bogofilter (defun spam-check-bogofilter-headers (&optional score) @@ -2376,6 +2436,89 @@ REMOVE not nil, remove the ADDRESSES." (defun spam-bsfilter-unregister-ham-routine (articles) (spam-bsfilter-register-ham-routine articles t)) + +;;;; CRM114 Mailfilter +(defun spam-check-crm114-headers (&optional score) + (let ((header (message-fetch-field spam-crm114-header)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (if score ; scoring mode + (if (string-match "( pR: \\([0-9.-]+\\)" header) + (match-string 1 header) + "0") + ;; spam detection mode + (when (string-match spam-crm114-positive-spam-header + header) + spam-split-group))))) + +;; return something sensible if the score can't be determined +(defun spam-crm114-score () + "Get the CRM114 Mailfilter pR" + (interactive) + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (spam-check-crm114-headers t) + (spam-check-crm114 t)))) + (gnus-summary-show-article) + (message "pR: %s" score) + (or score "0")))) + +(defun spam-check-crm114 (&optional score) + "Check the CRM114 Mailfilter backend for the classification of this message" + (let ((article-buffer-name (buffer-name)) + (db spam-crm114-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-crm114-program + nil temp-buffer-name nil + (when db (list (concat "--fileprefix=" db))))) + (setq return (spam-check-crm114-headers score)))) + return)) + +(defun spam-crm114-register-with-crm114 (articles + spam + &optional unregister) + "Register an article, given as a string, as spam or non-spam." + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (db spam-crm114-database-directory) + (switch (if unregister + (if spam + spam-crm114-spam-strong-switch + spam-crm114-ham-strong-switch) + (if spam + spam-crm114-spam-switch + spam-crm114-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + + (apply 'call-process-region + (point-min) (point-max) + spam-crm114-program + nil nil nil + (when db (list switch (concat "--fileprefix=" db))))))))) + +(defun spam-crm114-register-spam-routine (articles &optional unregister) + (spam-crm114-register-with-crm114 articles t unregister)) + +(defun spam-crm114-unregister-spam-routine (articles) + (spam-crm114-register-spam-routine articles t)) + +(defun spam-crm114-register-ham-routine (articles &optional unregister) + (spam-crm114-register-with-crm114 articles nil unregister)) + +(defun spam-crm114-unregister-ham-routine (articles) + (spam-crm114-register-ham-routine articles t)) + ;;;; Hooks @@ -2424,4 +2567,5 @@ installed through spam-necessary-extra-headers." (provide 'spam) +;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f ;;; spam.el ends here