X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fspam.el;h=adb83c79f61ef3ffd7e81eb782cd4fd90a9b9977;hb=13fedf515a4498dba4f9f2cfd16913650260e3c7;hp=fe25c0fe961f2f2bd6f71bcc9034ae91752c48bf;hpb=38449704ecdcf78c19fe5ae755a36c2d56258d27;p=elisp%2Fgnus.git- diff --git a/lisp/spam.el b/lisp/spam.el index fe25c0f..adb83c7 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -73,7 +73,7 @@ (defgroup spam nil "Spam configuration.") -(defcustom spam-directory "~/News/spam/" +(defcustom spam-directory (nnheader-concat gnus-directory "spam/") "Directory for spam whitelists and blacklists." :type 'directory :group 'spam) @@ -162,6 +162,11 @@ The regular expression is matched against the address." :type 'boolean :group 'spam) +(defcustom spam-use-gmane-xref nil + "Whether the Gmane spam xref should be used by `spam-split'." + :type 'boolean + :group 'spam) + (defcustom spam-use-blacklist nil "Whether the blacklist should be used by `spam-split'." :type 'boolean @@ -218,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 @@ -260,6 +277,7 @@ them." (defcustom spam-install-hooks (or spam-use-dig + spam-use-gmane-xref spam-use-blacklist spam-use-whitelist spam-use-whitelist-exclusive @@ -271,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 @@ -296,14 +316,23 @@ All unmarked article in such group receive the spam mark on group entry." :type '(repeat (string :tag "Group")) :group 'spam) + +(defcustom spam-gmane-xref-spam-group "gmane.spam.detected" + "The group where spam xrefs can be found on Gmane. +Only meaningful if you enable `spam-use-gmane-xref'." + :type 'string + :group 'spam) + (defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org" "dev.null.dk" "relays.visi.com") - "List of blackhole servers." + "List of blackhole servers. +Only meaningful if you enable `spam-use-blackholes'." :type '(repeat (string :tag "Server")) :group 'spam) (defcustom spam-blackhole-good-server-regex nil - "String matching IP addresses that should not be checked in the blackholes." + "String matching IP addresses that should not be checked in the blackholes. +Only meaningful if you enable `spam-use-blackholes'." :type '(radio (const nil) (regexp :format "%t: %v\n" :size 0)) :group 'spam) @@ -314,22 +343,26 @@ All unmarked article in such group receive the spam mark on group entry." :group 'spam) (defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES") - "Regular expression for positive header spam matches." + "Regular expression for positive header spam matches. +Only meaningful if you enable `spam-use-regex-headers'." :type '(repeat (regexp :tag "Regular expression to match spam header")) :group 'spam) (defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO") - "Regular expression for positive header ham matches." + "Regular expression for positive header ham matches. +Only meaningful if you enable `spam-use-regex-headers'." :type '(repeat (regexp :tag "Regular expression to match ham header")) :group 'spam) (defcustom spam-regex-body-spam '() - "Regular expression for positive body spam matches." + "Regular expression for positive body spam matches. +Only meaningful if you enable `spam-use-regex-body'." :type '(repeat (regexp :tag "Regular expression to match spam body")) :group 'spam) (defcustom spam-regex-body-ham '() - "Regular expression for positive body ham matches." + "Regular expression for positive body ham matches. +Only meaningful if you enable `spam-use-regex-body'." :type '(repeat (regexp :tag "Regular expression to match ham body")) :group 'spam) @@ -415,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) @@ -581,18 +661,20 @@ 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) (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle) - (gnus-group-spam-exit-processor-spamassassin spam spam-use-spam-spamassassin) + (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin) (gnus-group-ham-exit-processor-ifile ham spam-use-ifile) (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter) + (gnus-group-ham-exit-processor-bsfilter ham spam-use-bsfilter) (gnus-group-ham-exit-processor-stat ham spam-use-stat) (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist) (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB) (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy) - (gnus-group-ham-exit-processor-spamassassin ham spam-use-ham-spamassassin) + (gnus-group-ham-exit-processor-spamassassin ham spam-use-spamassassin) (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle)) "The `spam-list-of-processors' list. This list contains pairs associating a ham/spam exit processor @@ -667,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. @@ -699,7 +832,7 @@ Respects the process/prefix convention." (new-articles (spam-list-articles gnus-newsgroup-articles classification)) - (changed-articles (gnus-set-difference old-articles new-articles))) + (changed-articles (spam-set-difference new-articles old-articles))) ;; now that we have the changed articles, we go through the processors (dolist (processor-param spam-list-of-processors) (let ((processor (nth 0 processor-param)) @@ -714,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) @@ -725,19 +859,24 @@ 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) - (spam-mark-spam-as-expired-and-move-routine - (gnus-parameter-spam-process-destination gnus-newsgroup-name))) + (unless (and spam-move-spam-nonspam-groups-only + (spam-group-spam-contents-p gnus-newsgroup-name)) + (when (< 0 (length (spam-list-articles + gnus-newsgroup-articles + 'spam))) + (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 (length (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) @@ -752,25 +891,42 @@ Respects the process/prefix convention." (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") - (spam-ham-copy-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name))) + (when (< 0 (length (spam-list-articles + gnus-newsgroup-articles + 'ham))) + (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))) - ;; 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") - (spam-ham-move-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 6 "Moving ham messages from spam group") + (spam-ham-move-routine + (gnus-parameter-ham-process-destination gnus-newsgroup-name))))) (setq spam-old-ham-articles nil) (setq spam-old-spam-articles nil)) +(defun spam-set-difference (list1 list2) + "Return a set difference of LIST1 and LIST2. +When either list is nil, the other is returned." + (if (and list1 list2) + ;; we have two non-nil lists + (progn + (dolist (item (append list1 list2)) + (when (and (memq item list1) (memq item list2)) + (setq list1 (delq item list1)) + (setq list2 (delq item list2)))) + (append list1 list2)) + ;; if either of the lists was nil, return the other one + (if list1 list1 list2))) + (defun spam-mark-junk-as-spam-routine () ;; 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")) @@ -918,7 +1074,7 @@ Respects the process/prefix convention." (mail-header-extra data-header)) (t nil)) - (gnus-error 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)) @@ -944,7 +1100,7 @@ Respects the process/prefix convention." (spam-fetch-field-fast article 'xref dh)) (when (spam-fetch-field-fast article 'extra dh) (format "%s\n" (spam-fetch-field-fast article 'extra dh)))) - (gnus-error + (gnus-message 5 "spam-generate-fake-headers: article %d didn't have a valid header" article)))) @@ -952,6 +1108,7 @@ Respects the process/prefix convention." (defun spam-fetch-article-header (article) (save-excursion (set-buffer gnus-summary-buffer) + (gnus-read-header article) (nth 3 (assq article gnus-newsgroup-data)))) @@ -960,6 +1117,7 @@ Respects the process/prefix convention." (defvar spam-list-of-checks '((spam-use-blacklist . spam-check-blacklist) (spam-use-regex-headers . spam-check-regex-headers) + (spam-use-gmane-xref . spam-check-gmane-xref) (spam-use-regex-body . spam-check-regex-body) (spam-use-whitelist . spam-check-whitelist) (spam-use-BBDB . spam-check-BBDB) @@ -972,7 +1130,9 @@ Respects the process/prefix convention." (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, @@ -992,6 +1152,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) @@ -1038,7 +1199,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 @@ -1088,7 +1249,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." registry-lookup) (unless id - (gnus-error 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)) @@ -1142,6 +1303,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." nil spam-whitelist-unregister-routine nil) + (spam-use-ham-copy nil + nil + nil + nil) (spam-use-BBDB spam-BBDB-register-routine nil spam-BBDB-unregister-routine @@ -1171,7 +1336,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 @@ -1207,21 +1376,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 @@ -1248,7 +1415,7 @@ functions") gnus-newsgroup-articles classification))) ;; process them - (gnus-message 5 "%s %d %s articles with classification %s, check %s" + (gnus-message 5 "%s %d %s articles as %s using backend %s" (if unregister "Unregistering" "Registering") (length articles) (if specific-articles "specific" "") @@ -1280,8 +1447,10 @@ functions") type cell-list)) - (gnus-error 5 (format "%s called with bad ID, type, classification, check, or group" - "spam-log-processing-to-registry"))))) + (gnus-message + 5 + (format "%s call with bad ID, type, classification, spam-check, or group" + "spam-log-processing-to-registry"))))) ;;; check if a ham- or spam-processor registration has been done (defun spam-log-registered-p (id type) @@ -1290,8 +1459,10 @@ functions") (spam-process-type-valid-p type)) (cdr-safe (gnus-registry-fetch-extra id type)) (progn - (gnus-error 5 (format "%s called with bad ID, type, classification, or check" - "spam-log-registered-p")) + (gnus-message + 5 + (format "%s called with bad ID, type, classification, or spam-check" + "spam-log-registered-p")) nil)))) ;;; check what a ham- or spam-processor registration says @@ -1310,6 +1481,7 @@ functions") nil decision))) + ;;; check if a ham- or spam-processor registration needs to be undone (defun spam-log-unregistration-needed-p (id type classification check) (when spam-log-to-registry @@ -1326,8 +1498,10 @@ functions") (setq found t)))) found) (progn - (gnus-error 5 (format "%s called with bad ID, type, classification, or check" - "spam-log-unregistration-needed-p")) + (gnus-message + 5 + (format "%s called with bad ID, type, classification, or spam-check" + "spam-log-unregistration-needed-p")) nil)))) @@ -1350,8 +1524,8 @@ functions") type new-cell-list)) (progn - (gnus-error 5 (format "%s called with bad ID, type, check, or group" - "spam-log-undo-registration")) + (gnus-message 6 (format "%s call with bad ID, type, spam-check, or group" + "spam-log-undo-registration")) nil)))) ;;; set up IMAP widening if it's necessary @@ -1361,6 +1535,20 @@ functions") (setq nnimap-split-download-body-default t)))) +;;;; Gmane xrefs +(defun spam-check-gmane-xref () + (let ((header (or + (message-fetch-field "Xref") + (message-fetch-field "Newsgroups"))) + (spam-split-group (if spam-split-symbolic-return + 'spam + spam-split-group))) + (when header ; return nil when no header + (when (string-match spam-gmane-xref-spam-group + header) + spam-split-group)))) + + ;;;; Regex body (defun spam-check-regex-body () @@ -1412,7 +1600,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)) @@ -1430,13 +1618,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 @@ -1487,7 +1675,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")) @@ -1817,7 +2005,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)) @@ -1833,6 +2021,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))))) @@ -1841,7 +2030,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 @@ -1885,13 +2074,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) @@ -1977,7 +2167,7 @@ REMOVE not nil, remove the ADDRESSES." (goto-char (point-min)) (when (re-search-forward "^X-Spam: yes;" nil t) spam-split-group)) - (error "Error running spamoracle" status)))))))) + (error "Error running spamoracle: %s" status)))))))) (defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister) "Run spamoracle in training mode." @@ -1999,8 +2189,8 @@ REMOVE not nil, remove the ADDRESSES." `("-f" ,spam-spamoracle-database "add" ,arg) `("add" ,arg))))) - (when (not (eq 0 status)) - (error "Error running spamoracle" status))))))) + (unless (eq 0 status) + (error "Error running spamoracle: %s" status))))))) (defun spam-spamoracle-learn-ham (articles &optional unregister) (spam-spamoracle-learn articles nil unregister)) @@ -2050,13 +2240,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) @@ -2103,13 +2294,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)