X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fspam.el;h=39a6748e03402cbf3a1579a9f2d5b27086e51dd8;hb=e5ab2b48c63f436bb8222caa5e6aa63df093d1f2;hp=5a566a5130f86792725a09882d1d99f256cb7f84;hpb=e0651adaa233905a1fe0b64769e9301821c3d315;p=elisp%2Fgnus.git- diff --git a/lisp/spam.el b/lisp/spam.el index 5a566a5..39a6748 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -223,6 +223,18 @@ Enable this if you want Gnus to invoke Bogofilter on new messages." :type 'boolean :group 'spam) +(defcustom spam-use-bsfilter-headers nil + "Whether bsfilter headers should be used by `spam-split'. +Enable this if you pre-process messages with Bsfilter BEFORE Gnus sees them." + :type 'boolean + :group 'spam) + +(defcustom spam-use-bsfilter nil + "Whether bsfilter should be invoked by `spam-split'. +Enable this if you want Gnus to invoke Bsfilter on new messages." + :type 'boolean + :group 'spam) + (defcustom spam-use-BBDB nil "Whether BBDB should be used by `spam-split'." :type 'boolean @@ -277,6 +289,8 @@ them." spam-use-bogofilter-headers spam-use-spamassassin spam-use-spamassassin-headers + spam-use-bsfilter + spam-use-bsfilter-headers spam-use-BBDB spam-use-BBDB-exclusive spam-use-ifile @@ -434,6 +448,53 @@ your main source of newsgroup names." (const :tag "Use the default")) :group 'spam-bogofilter) +(defgroup spam-bsfilter nil + "Spam bsfilter configuration." + :group 'spam) + +(defcustom spam-bsfilter-path (executable-find "bsfilter") + "File path of the Bsfilter executable program." + :type '(choice (file :tag "Location of bsfilter") + (const :tag "Bsfilter is not installed")) + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-header "X-Spam-Flag" + "The header inserted by Bsfilter to flag spam." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-probability-header "X-Spam-Probability" + "The header that Bsfilter inserts in messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-spam-switch "--add-spam" + "The switch that Bsfilter uses to register spam messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-ham-switch "--add-ham" + "The switch that Bsfilter uses to register ham messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-spam-strong-switch "--sub-spam" + "The switch that Bsfilter uses to unregister ham messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-ham-strong-switch "--sub-clean" + "The switch that Bsfilter uses to unregister spam messages." + :type 'string + :group 'spam-bsfilter) + +(defcustom spam-bsfilter-database-directory nil + "Directory path of the Bsfilter databases." + :type '(choice (directory + :tag "Location of the Bsfilter database directory") + (const :tag "Use the default")) + :group 'spam-bsfilter) + (defgroup spam-spamoracle nil "Spam spamoracle configuration." :group 'spam) @@ -600,6 +661,7 @@ finds ham or spam.") (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-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) @@ -607,6 +669,7 @@ finds ham or spam.") (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin) (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) + (gnus-group-ham-exit-processor-bsfilter ham spam-use-bsfilter) (gnus-group-ham-exit-processor-stat ham spam-use-stat) (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) @@ -686,14 +749,65 @@ Respects the process/prefix convention." (gnus-summary-remove-process-mark article) (spam-report-gmane article))) -(defun spam-generic-score () - (interactive) +(defun spam-necessary-extra-headers () + "Return the extra headers spam.el thinks are necessary." + (let (list) + (when (or spam-use-spamassassin + spam-use-spamassassin-headers + spam-use-regex-headers) + (push 'X-Spam-Status list)) + list)) + +(defun spam-user-format-function-S (headers) + (when headers + (spam-summary-score headers))) + +(defun spam-article-sort-by-spam-status (h1 h2) + "Sort articles by score." + (let (result) + (dolist (header (spam-necessary-extra-headers)) + (let ((s1 (spam-summary-score h1 header)) + (s2 (spam-summary-score h2 header))) + (unless (= s1 s2) + (setq result (< s1 s2)) + (return)))) + result)) + +(defun spam-extra-header-to-number (header headers) + "Transform an extra header to a number." + (if (gnus-extra-header header headers) + (cond + ((eq header 'X-Spam-Status) + (string-to-number (gnus-replace-in-string + (gnus-extra-header header headers) + ".*hits=" ""))) + (t nil)) + nil)) + +(defun spam-summary-score (headers &optional specific-header) + "Score an article for the summary buffer, as fast as possible. +With SPECIFIC-HEADER, returns only that header's score. +Will not return a nil score." + (let (score) + (dolist (header + (if specific-header + (list specific-header) + (spam-necessary-extra-headers))) + (setq score + (spam-extra-header-to-number header headers)) + (when score + (return))) + (or score 0))) + +(defun spam-generic-score (&optional recheck) "Invoke whatever scoring method we can." - (if (or - spam-use-spamassassin - spam-use-spamassassin-headers) - (spam-spamassassin-score) - (spam-bogofilter-score))) + (interactive "P") + (cond + ((or spam-use-spamassassin spam-use-spamassassin-headers) + (spam-spamassassin-score recheck)) + ((or spam-use-bsfilter spam-use-bsfilter-headers) + (spam-bsfilter-score recheck)) + (t (spam-bogofilter-score recheck)))) ;;; Summary entry and exit processing. @@ -733,7 +847,8 @@ Respects the process/prefix convention." ;; 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)))))) + (spam-register-routine + classification check t unregister-list)))))) ;; find all the spam processors applicable to this group (dolist (processor-param spam-list-of-processors) @@ -744,19 +859,21 @@ Respects the process/prefix convention." (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) + (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 + gnus-newsgroup-name)) (spam-mark-spam-as-expired-and-move-routine (gnus-parameter-spam-process-destination gnus-newsgroup-name))) ;; now we redo spam-mark-spam-as-expired-and-move-routine to only ;; expire spam, in case the above did not expire them - (gnus-message 5 "Marking spam as expired without moving it") - (spam-mark-spam-as-expired-and-move-routine nil) + (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)) (when (or (spam-group-ham-contents-p gnus-newsgroup-name) (and (spam-group-spam-contents-p gnus-newsgroup-name) @@ -772,13 +889,13 @@ Respects the process/prefix convention." (spam-register-routine classification check))))) (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) - (gnus-message 5 "Copying ham") + (gnus-message 6 "Copying ham") (spam-ham-copy-routine (gnus-parameter-ham-process-destination gnus-newsgroup-name))) ;; now move all ham articles out of spam groups (when (spam-group-spam-contents-p gnus-newsgroup-name) - (gnus-message 5 "Moving ham messages from spam group") + (gnus-message 6 "Moving ham messages from spam group") (spam-ham-move-routine (gnus-parameter-ham-process-destination gnus-newsgroup-name)))) @@ -803,7 +920,7 @@ When either list is nil, the other is returned." ;; check the global list of group names spam-junk-mailgroups and the ;; group parameters (when (spam-group-spam-contents-p gnus-newsgroup-name) - (gnus-message 5 "Marking %s articles as spam" + (gnus-message 6 "Marking %s articles as spam" (if spam-mark-only-unseen-as-spam "unseen" "unread")) @@ -951,7 +1068,7 @@ When either list is nil, the other is returned." (mail-header-extra data-header)) (t nil)) - (gnus-message 5 "Article %d has a nil data header" article))))) + (gnus-message 6 "Article %d has a nil data header" article))))) (defun spam-fetch-field-from-fast (article &optional prepared-data-header) (spam-fetch-field-fast article 'from prepared-data-header)) @@ -985,6 +1102,7 @@ When either list is nil, the other is returned." (defun spam-fetch-article-header (article) (save-excursion (set-buffer gnus-summary-buffer) + (gnus-read-header article) (nth 3 (assq article gnus-newsgroup-data)))) @@ -1006,7 +1124,9 @@ When either list is nil, the other is returned." (spam-use-spamassassin-headers . spam-check-spamassassin-headers) (spam-use-spamassassin . spam-check-spamassassin) (spam-use-bogofilter-headers . spam-check-bogofilter-headers) - (spam-use-bogofilter . spam-check-bogofilter)) + (spam-use-bogofilter . spam-check-bogofilter) + (spam-use-bsfilter-headers . spam-check-bsfilter-headers) + (spam-use-bsfilter . spam-check-bsfilter)) "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, @@ -1026,6 +1146,7 @@ definitely a spam.") spam-use-regex-body spam-use-stat spam-use-bogofilter + spam-use-bsfilter spam-use-blackholes spam-use-spamassassin spam-use-spamoracle) @@ -1072,7 +1193,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (and specific-checks (memq (car pair) specific-checks)) ;; or, given no specific checks, spam-use-CHECK is set (and (null specific-checks) (symbol-value (car pair)))) - (gnus-message 5 "spam-split: calling the %s function" + (gnus-message 6 "spam-split: calling the %s function" (symbol-name (cdr pair))) (setq decision (funcall (cdr pair))) ;; if we got a decision at all, save the current check @@ -1122,7 +1243,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." registry-lookup) (unless id - (gnus-message 5 "Article %d has no message ID!" article)) + (gnus-message 6 "Article %d has no message ID!" article)) (when (and id spam-log-to-registry) (setq registry-lookup (spam-log-registration-type id 'incoming)) @@ -1209,7 +1330,11 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (spam-use-bogofilter spam-bogofilter-register-ham-routine spam-bogofilter-register-spam-routine spam-bogofilter-unregister-ham-routine - spam-bogofilter-unregister-spam-routine)) + spam-bogofilter-unregister-spam-routine) + (spam-use-bsfilter spam-bsfilter-register-ham-routine + spam-bsfilter-register-spam-routine + spam-bsfilter-unregister-ham-routine + spam-bsfilter-unregister-spam-routine)) "The spam-registration-functions list contains pairs associating a parameter variable with the ham and spam registration functions, and the ham and spam unregistration @@ -1245,21 +1370,19 @@ functions") (let ((mark-check (if (eq classification 'spam) 'spam-group-spam-mark-p 'spam-group-ham-mark-p)) - list mark-cache-yes mark-cache-no) + alist mark-cache-yes mark-cache-no) (dolist (article articles) (let ((mark (gnus-summary-article-mark article))) - (unless (memq mark mark-cache-no) - (if (memq mark mark-cache-yes) - (push article list) - ;; else, we have to actually check the mark - (if (funcall mark-check - gnus-newsgroup-name - mark) - (progn - (push article list) - (push mark mark-cache-yes)) - (push mark mark-cache-no)))))) - list)) + (unless (or (memq mark mark-cache-yes) + (memq mark mark-cache-no)) + (if (funcall mark-check + gnus-newsgroup-name + mark) + (push mark mark-cache-yes) + (push mark mark-cache-no))) + (when (memq mark mark-cache-yes) + (push article alist)))) + alist)) (defun spam-register-routine (classification check @@ -1395,7 +1518,7 @@ functions") type new-cell-list)) (progn - (gnus-message 5 (format "%s call with bad ID, type, spam-check, or group" + (gnus-message 6 (format "%s call with bad ID, type, spam-check, or group" "spam-log-undo-registration")) nil)))) @@ -1471,7 +1594,7 @@ functions") (with-temp-buffer (insert headers) (goto-char (point-min)) - (gnus-message 5 "Checking headers for relay addresses") + (gnus-message 6 "Checking headers for relay addresses") (while (re-search-forward "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) @@ -1489,13 +1612,13 @@ functions") (if spam-use-dig (let ((query-result (query-dig query-string))) (when query-result - (gnus-message 5 "(DIG): positive blackhole check '%s'" + (gnus-message 6 "(DIG): positive blackhole check '%s'" query-result) (push (list ip server query-result) matches))) ;; else, if not using dig.el (when (query-dns query-string) - (gnus-message 5 "positive blackhole check") + (gnus-message 6 "positive blackhole check") (push (list ip server (query-dns query-string 'TXT)) matches))))))))) (when matches @@ -1546,7 +1669,7 @@ functions") (record (and net-address (bbdb-search-simple nil net-address)))) (when net-address - (gnus-message 5 "%s address %s %s BBDB" + (gnus-message 6 "%s address %s %s BBDB" (if remove "Deleting" "Adding") from (if remove "from" "to")) @@ -1876,7 +1999,7 @@ REMOVE not nil, remove the ADDRESSES." (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) (remove-function (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) - from addresses unregister-list) + from addresses unregister-list article-unregister-list) (dolist (article articles) (let ((from (spam-fetch-field-from-fast article)) (id (spam-fetch-field-message-id-fast article)) @@ -1892,6 +2015,7 @@ REMOVE not nil, remove the ADDRESSES." (null unregister) (spam-log-unregistration-needed-p id 'process declassification de-symbol)) + (push article article-unregister-list) (push from unregister-list)) (unless sender-ignored (push from addresses))))) @@ -1900,7 +2024,7 @@ REMOVE not nil, remove the ADDRESSES." (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) + (dolist (article article-unregister-list) (spam-log-undo-registration (spam-fetch-field-message-id-fast article) 'process @@ -1944,13 +2068,14 @@ REMOVE not nil, remove the ADDRESSES." spam-split-group))))) ;; return something sensible if the score can't be determined -(defun spam-bogofilter-score () +(defun spam-bogofilter-score (&optional recheck) "Get the Bogofilter spamicity score" - (interactive) + (interactive "P") (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) - (let ((score (or (spam-check-bogofilter-headers t) + (let ((score (or (unless recheck + (spam-check-bogofilter-headers t)) (spam-check-bogofilter t)))) (gnus-summary-show-article) (message "Spamicity score %s" score) @@ -2109,13 +2234,14 @@ REMOVE not nil, remove the ADDRESSES." (spam-check-spamassassin-headers score))))) ;; return something sensible if the score can't be determined -(defun spam-spamassassin-score () +(defun spam-spamassassin-score (&optional recheck) "Get the SpamAssassin score" - (interactive) + (interactive "P") (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) - (let ((score (or (spam-check-spamassassin-headers t) + (let ((score (or (unless recheck + (spam-check-spamassassin-headers t)) (spam-check-spamassassin t)))) (gnus-summary-show-article) (message "SpamAssassin score %s" score) @@ -2162,13 +2288,113 @@ REMOVE not nil, remove the ADDRESSES." (defun spam-spamassassin-unregister-ham-routine (articles) (spam-spamassassin-register-with-sa-learn articles nil t)) + + +;;;; Bsfilter +;;; based mostly on the bogofilter code +(defun spam-check-bsfilter-headers (&optional score) + (if score + (or (nnmail-fetch-field spam-bsfilter-probability-header) + "0") + (let ((header (nnmail-fetch-field spam-bsfilter-header)) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (when (string-match "YES" header) + spam-split-group))))) + +;; return something sensible if the score can't be determined +(defun spam-bsfilter-score (&optional recheck) + "Get the Bsfilter spamicity score" + (interactive "P") + (save-window-excursion + (gnus-summary-show-article t) + (set-buffer gnus-article-buffer) + (let ((score (or (unless recheck + (spam-check-bsfilter-headers t)) + (spam-check-bsfilter t)))) + (gnus-summary-show-article) + (message "Spamicity score %s" score) + (or score "0")))) + +(defun spam-check-bsfilter (&optional score) + "Check the Bsfilter backend for the classification of this message" + (let ((article-buffer-name (buffer-name)) + (dir spam-bsfilter-database-directory) + return) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (apply 'call-process-region + (point-min) (point-max) + spam-bsfilter-path + nil temp-buffer-name nil + "--pipe" + "--insert-flag" + "--insert-probability" + (when dir + (list "--homedir" dir)))) + (setq return (spam-check-bsfilter-headers score)))) + return)) + +(defun spam-bsfilter-register-with-bsfilter (articles + spam + &optional unregister) + "Register an article, given as a string, as spam or non-spam." + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article)) + (switch (if unregister + (if spam + spam-bsfilter-spam-strong-switch + spam-bsfilter-ham-strong-switch) + (if spam + spam-bsfilter-spam-switch + spam-bsfilter-ham-switch)))) + (when (stringp article-string) + (with-temp-buffer + (insert article-string) + (apply 'call-process-region + (point-min) (point-max) + spam-bsfilter-path + nil nil nil switch + "--update" + (when spam-bsfilter-database-directory + (list "--homedir" + spam-bsfilter-database-directory)))))))) + +(defun spam-bsfilter-register-spam-routine (articles &optional unregister) + (spam-bsfilter-register-with-bsfilter articles t unregister)) + +(defun spam-bsfilter-unregister-spam-routine (articles) + (spam-bsfilter-register-spam-routine articles t)) + +(defun spam-bsfilter-register-ham-routine (articles &optional unregister) + (spam-bsfilter-register-with-bsfilter articles nil unregister)) + +(defun spam-bsfilter-unregister-ham-routine (articles) + (spam-bsfilter-register-ham-routine articles t)) + ;;;; Hooks ;;;###autoload -(defun spam-initialize () - "Install the spam.el hooks and do other initialization" +(defun spam-initialize (&rest symbols) + "Install the spam.el hooks and do other initialization. +When SYMBOLS is given, set those variables to t. This is so you +can call spam-initialize before you set spam-use-* variables on +explicitly, and matters only if you need the extra headers +installed through spam-necessary-extra-headers." (interactive) + + (dolist (var symbols) + (set var t)) + + (dolist (header (spam-necessary-extra-headers)) + (add-to-list 'nnmail-extra-headers header) + (add-to-list 'gnus-extra-headers header)) + (setq spam-install-hooks t) ;; TODO: How do we redo this every time spam-face is customized? (push '((eq mark gnus-spam-mark) . spam-face)