X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fspam.el;h=783cc2e7533144672f3b5fb77e1dc25baabdb503;hb=d2e2b790234a9d20132b20c173302a24f0525b1f;hp=ff6302682cc90c6e48e2efbe6ff67524fc1a7b5c;hpb=f52f58276912f62c0c24d42faf90fe53ee58c65b;p=gnus diff --git a/lisp/spam.el b/lisp/spam.el index ff6302682..783cc2e75 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -34,6 +34,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'gnus-sum) (require 'gnus-uu) ; because of key prefix issues @@ -52,6 +54,15 @@ (eval-and-compile (autoload 'query-dig "dig")) +;; autoload spam-report +(eval-and-compile + (autoload 'spam-report-gmane "spam-report")) + +;; autoload gnus-registry +(eval-and-compile + (autoload 'gnus-registry-store-extra-entry "gnus-registry") + (autoload 'gnus-registry-fetch-extra "gnus-registry")) + ;; autoload query-dns (eval-and-compile (autoload 'query-dns "dns")) @@ -68,12 +79,35 @@ (defcustom spam-move-spam-nonspam-groups-only t "Whether spam should be moved in non-spam groups only. -When nil, only ham and unclassified groups will have their spam moved -to the spam-process-destination. When t, spam will also be moved from +When t, only ham and unclassified groups will have their spam moved +to the spam-process-destination. When nil, spam will also be moved from spam groups." :type 'boolean :group 'spam) +(defcustom spam-process-ham-in-nonham-groups nil + "Whether ham should be processed in non-ham groups." + :type 'boolean + :group 'spam) + +(defcustom spam-log-to-registry nil + "Whether spam/ham processing should be logged in the registry." + :type 'boolean + :group 'spam) + +(defcustom spam-process-ham-in-spam-groups nil + "Whether ham should be processed in spam groups." + :type 'boolean + :group 'spam) + +(defcustom spam-mark-only-unseen-as-spam t + "Whether only unseen articles should be marked as spam in spam +groups. When nil, all unread articles in a spam group are marked as +spam. Set this if you want to leave an article unread in a spam group +without losing it to the automatic spam-marking process." + :type 'boolean + :group 'spam) + (defcustom spam-mark-ham-unread-before-move-from-spam-group nil "Whether ham should be marked unread before it's moved out of a spam group according to ham-process-destination. This variable is an @@ -130,7 +164,13 @@ are considered spam." (defcustom spam-use-regex-headers nil "Whether a header regular expression match should be used by spam-split. -Also see the variable `spam-spam-regex-headers' and `spam-ham-regex-headers'." +Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'." + :type 'boolean + :group 'spam) + +(defcustom spam-use-regex-body nil + "Whether a body regular expression match should be used by spam-split. +Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'." :type 'boolean :group 'spam) @@ -168,11 +208,38 @@ considered spam." :type 'boolean :group 'spam) +(defcustom spam-use-spamoracle nil + "Whether spamoracle should be used by spam-split." + :type 'boolean + :group 'spam) + +(defcustom spam-install-hooks (or + spam-use-dig + spam-use-blacklist + spam-use-whitelist + spam-use-whitelist-exclusive + spam-use-blackholes + spam-use-hashcash + spam-use-regex-headers + spam-use-regex-body + spam-use-bogofilter-headers + spam-use-bogofilter + spam-use-BBDB + spam-use-BBDB-exclusive + spam-use-ifile + spam-use-stat + spam-use-spamoracle) + "Whether the spam hooks should be installed, default to t if one of +the spam-use-* variables is set." + :group 'spam + :type 'boolean) + (defcustom spam-split-group "spam" "Group name where incoming spam should be put by spam-split." :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")) "Mailgroups with spam contents. All unmarked article in such group receive the spam mark on group entry." @@ -187,7 +254,8 @@ All unmarked article in such group receive the spam mark on group entry." (defcustom spam-blackhole-good-server-regex nil "String matching IP addresses that should not be checked in the blackholes" - :type 'regexp + :type '(radio (const nil) + (regexp :format "%t: %v\n" :size 0)) :group 'spam) (defcustom spam-face 'gnus-splash-face @@ -205,6 +273,16 @@ All unmarked article in such group receive the spam mark on group entry." :type '(repeat (regexp :tag "Regular expression to match ham header")) :group 'spam) +(defcustom spam-regex-body-spam '() + "Regular expression for positive body spam matches" + :type '(repeat (regexp :tag "Regular expression to match spam body")) + :group 'spam) + +(defcustom spam-regex-body-ham '() + "Regular expression for positive body ham matches" + :type '(repeat (regexp :tag "Regular expression to match ham body")) + :group 'spam) + (defgroup spam-ifile nil "Spam ifile configuration." :group 'spam) @@ -276,6 +354,23 @@ your main source of newsgroup names." (const :tag "Use the default")) :group 'spam-ifile) +(defgroup spam-spamoracle nil + "Spam spamoracle configuration." + :group 'spam) + +(defcustom spam-spamoracle-database nil + "Location of spamoracle database file. When nil, use the default +spamoracle database." + :type '(choice (directory :tag "Location of spamoracle database file.") + (const :tag "Use the default")) + :group 'spam-spamoracle) + +(defcustom spam-spamoracle-binary (executable-find "spamoracle") + "Location of the spamoracle binary." + :type '(choice (directory :tag "Location of the spamoracle binary") + (const :tag "Use the default")) + :group 'spam-spamoracle) + ;;; Key bindings for spam control. (gnus-define-keys gnus-summary-mode-map @@ -285,13 +380,6 @@ your main source of newsgroup names." "Msx" gnus-summary-mark-as-spam "\M-d" gnus-summary-mark-as-spam) -;;; How to highlight a spam summary line. - -;; TODO: How do we redo this every time spam-face is customized? - -(push '((eq mark gnus-spam-mark) . spam-face) - gnus-summary-highlight) - ;; convenience functions (defun spam-group-ham-mark-p (group mark &optional spam) (when (stringp group) @@ -335,6 +423,9 @@ your main source of newsgroup names." (member processor (car (gnus-parameter-spam-process group))) nil)) +(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)) @@ -347,6 +438,9 @@ your main source of newsgroup names." (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)) @@ -365,13 +459,14 @@ your main source of newsgroup names." (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)) + ;;; Summary entry and exit processing. (defun spam-summary-prepare () (spam-mark-junk-as-spam-routine)) -(add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) - ;; 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 @@ -386,6 +481,10 @@ your main source of newsgroup names." (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)) @@ -394,6 +493,10 @@ your main source of newsgroup names." (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)) + (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 @@ -407,7 +510,10 @@ your main source of newsgroup names." (gnus-message 5 "Marking spam as expired without moving it") (spam-mark-spam-as-expired-and-move-routine nil) - (when (spam-group-ham-contents-p gnus-newsgroup-name) + (when (or (spam-group-ham-contents-p gnus-newsgroup-name) + (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)) @@ -422,12 +528,15 @@ your main source of newsgroup names." (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))) + (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))) (when (spam-group-ham-processor-copy-p gnus-newsgroup-name) (gnus-message 5 "Copying ham") - (spam-ham-move-routine - (gnus-parameter-ham-process-destination gnus-newsgroup-name) t)) + (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) @@ -435,59 +544,103 @@ your main source of newsgroup names." (spam-ham-move-routine (gnus-parameter-ham-process-destination gnus-newsgroup-name))))) -(add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) - (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 unread articles as spam") - (let ((articles gnus-newsgroup-articles) - article) - (while articles - (setq article (pop articles)) - (when (eq (gnus-summary-article-mark article) gnus-unread-mark) - (gnus-summary-mark-article article gnus-spam-mark)))))) - -(defun spam-mark-spam-as-expired-and-move-routine (&optional group) + (gnus-message 5 "Marking %s articles as spam" + (if spam-mark-only-unseen-as-spam + "unseen" + "unread")) + (let ((articles (if spam-mark-only-unseen-as-spam + gnus-newsgroup-unseen + gnus-newsgroup-unreads))) + (dolist (article articles) + (gnus-summary-mark-article article gnus-spam-mark))))) + +(defun spam-mark-spam-as-expired-and-move-routine (&rest groups) (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article tomove) + (backend-supports-deletions + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)) + article tomove deletep) (dolist (article articles) (when (eq (gnus-summary-article-mark article) gnus-spam-mark) (gnus-summary-mark-article article gnus-expirable-mark) (push article tomove))) - - ;; now do the actual move - (when (and tomove - (stringp group)) + + ;; now do the actual copies + (dolist (group groups) + (when (and tomove + (stringp group)) + (dolist (article tomove) + (gnus-summary-set-process-mark article)) + (when tomove + (if (or (not backend-supports-deletions) + (> (length groups) 1)) + (progn + (gnus-summary-copy-article nil group) + (setq deletep t)) + (gnus-summary-move-article nil group))))) + + ;; now delete the articles, if there was a copy done, and the + ;; backend allows it + (when (and deletep backend-supports-deletions) (dolist (article tomove) (gnus-summary-set-process-mark article)) - (when tomove (gnus-summary-move-article nil group)))) - (gnus-summary-yank-process-mark)) + (when tomove + (let ((gnus-novice-user nil)) ; don't ask me if I'm sure + (gnus-summary-delete-article nil)))) + + (gnus-summary-yank-process-mark))) -(defun spam-ham-move-routine (&optional group copy) +(defun spam-ham-copy-or-move-routine (copy groups) (gnus-summary-kill-process-mark) (let ((articles gnus-newsgroup-articles) - article mark tomove) - (when (stringp group) ; this routine will do nothing - ; without a valid group - (dolist (article articles) - (when (spam-group-ham-mark-p gnus-newsgroup-name - (gnus-summary-article-mark article)) - (push article tomove))) + (backend-supports-deletions + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)) + article mark todo deletep) + (dolist (article articles) + (when (spam-group-ham-mark-p gnus-newsgroup-name + (gnus-summary-article-mark article)) + (push article todo))) - ;; now do the actual move - (when tomove - (dolist (article tomove) + ;; now do the actual move + (dolist (group groups) + (when (and todo (stringp group)) + (dolist (article todo) (when spam-mark-ham-unread-before-move-from-spam-group - (gnus-summary-mark-article article gnus-unread-mark)) + (gnus-summary-mark-article article gnus-unread-mark)) + (gnus-summary-set-process-mark article)) + + (if (or (not backend-supports-deletions) + (> (length groups) 1)) + (progn + (gnus-summary-copy-article nil group) + (setq deletep t)) + (gnus-summary-move-article nil group)))) + + ;; now delete the articles, unless a) copy is t, and there was a copy done + ;; b) a move was done to a single group + ;; c) backend-supports-deletions is nil + (unless copy + (when (and deletep backend-supports-deletions) + (dolist (article todo) (gnus-summary-set-process-mark article)) - (if copy - (gnus-summary-copy-article nil group) - (gnus-summary-move-article nil group))))) + (when todo + (let ((gnus-novice-user nil)) ; don't ask me if I'm sure + (gnus-summary-delete-article nil)))))) + (gnus-summary-yank-process-mark)) +(defun spam-ham-copy-routine (&rest groups) + (spam-ham-copy-or-move-routine t groups)) + +(defun spam-ham-move-routine (&rest 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) @@ -557,15 +710,24 @@ your main source of newsgroup names." (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" + (if (and (numberp article) + (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) @@ -584,59 +746,124 @@ 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-stat spam-use-bogofilter) + '(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.") -(defun spam-split () +;;;TODO: modify to invoke self with each specific check if invoked without specific checks +(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', for -example like this: (: spam-split) +This function can be used as an entry in `nnmail-split-fancy', +for example like this: (: spam-split). It can take checks as +parameters. A string as a parameter will set the +spam-split-group to that string. See the Info node `(gnus)Fancy Mail Splitting' for more details." (interactive) - (save-excursion - (dolist (check spam-list-of-statistical-checks) - (when (symbol-value check) - (widen) - (gnus-message 8 "spam-split: widening the buffer (%s requires it)" - (symbol-name check)) - (return))) -;; (progn (widen) (debug (buffer-string))) - (let ((list-of-checks spam-list-of-checks) - decision) - (while (and list-of-checks (not decision)) - (let ((pair (pop list-of-checks))) - (when (symbol-value (car pair)) - (gnus-message 5 "spam-split: calling the %s function" (symbol-name (cdr pair))) - (setq decision (funcall (cdr pair)))))) - (if (eq decision t) - nil - decision)))) - + (let ((spam-split-group-choice spam-split-group)) + (dolist (check specific-checks) + (when (stringp check) + (setq spam-split-group-choice check) + (setq specific-checks (delq check specific-checks)))) + + (let ((spam-split-group spam-split-group-choice)) + (save-excursion + (save-restriction + (dolist (check spam-list-of-statistical-checks) + (when (and (symbolp check) (symbol-value check)) + (widen) + (gnus-message 8 "spam-split: widening the buffer (%s requires it)" + (symbol-name check)) + (return))) + ;; (progn (widen) (debug (buffer-string))) + (let ((list-of-checks spam-list-of-checks) + decision) + (while (and list-of-checks (not decision)) + (let ((pair (pop list-of-checks))) + (when (and (symbol-value (car pair)) + (or (null specific-checks) + (memq (car pair) specific-checks))) + (gnus-message 5 "spam-split: calling the %s function" + (symbol-name (cdr pair))) + (setq decision (funcall (cdr pair)))))) + (if (eq decision t) + nil + decision))))))) + +;;; 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)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + (cell (list classification check group))) + (push cell cell-list) + (gnus-registry-store-extra-entry + id + type + cell-list)) + + (gnus-message 5 (format "%s called with bad ID, type, check, or group" + "spam-log-processing-to-registry"))))) + +;;; 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 + (if (and (stringp id) + (or (eq type 'incoming) + (eq type 'process)) + (or (eq classification 'spam) + (eq classification 'ham)) + (assoc check spam-list-of-checks)) + (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + found) + (dolist (cell cell-list) + (unless found + (when (and (eq classification (nth 0 cell)) + (eq check (nth 1 cell))) + (setq found t)))) + found) + (progn + (gnus-message 5 (format "%s called with bad ID, type, check, or group" + "spam-log-unregistration-needed-p")) + nil)))) + +;;; set up IMAP widening if it's necessary (defun spam-setup-widening () (dolist (check spam-list-of-statistical-checks) (when (symbol-value check) (setq nnimap-split-download-body-default t)))) -(add-hook 'gnus-get-new-news-hook 'spam-setup-widening) + +;;;; Regex body + +(defun spam-check-regex-body () + (let ((spam-regex-headers-ham spam-regex-body-ham) + (spam-regex-headers-spam spam-regex-body-spam)) + (spam-check-regex-headers t))) ;;;; Regex headers -(defun spam-check-regex-headers () - (let (ret found) +(defun spam-check-regex-headers (&optional body) + (let ((type (if body "body" "header")) + ret found) (dolist (h-regex spam-regex-headers-ham) (unless found (goto-char (point-min)) (when (re-search-forward h-regex nil t) - (message "Ham regex header search positive.") + (message "Ham regex %s search positive." type) (setq found t)))) (dolist (s-regex spam-regex-headers-spam) (unless found (goto-char (point-min)) (when (re-search-forward s-regex nil t) - (message "Spam regex header search positive." (match-string 1)) + (message "Spam regex %s search positive." type) (setq found t) (setq ret spam-split-group)))) ret)) @@ -644,9 +871,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;;; Blackholes. +(defun spam-reverse-ip-string (ip) + (when (stringp ip) + (mapconcat 'identity + (nreverse (split-string ip "\\.")) + "."))) + (defun spam-check-blackholes () "Check the Received headers for blackholed relays." - (let ((headers (message-fetch-field "received")) + (let ((headers (nnmail-fetch-field "received")) ips matches) (when headers (with-temp-buffer @@ -654,29 +887,31 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (goto-char (point-min)) (gnus-message 5 "Checking headers for relay addresses") (while (re-search-forward - "\\[\\([0-9]+.[0-9]+.[0-9]+.[0-9]+\\)\\]" nil t) + "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) (gnus-message 9 "Blackhole search found host IP %s." (match-string 1)) - (push (mapconcat 'identity - (nreverse (split-string (match-string 1) "\\.")) - ".") + (push (spam-reverse-ip-string (match-string 1)) ips))) (dolist (server spam-blackhole-servers) (dolist (ip ips) (unless (and spam-blackhole-good-server-regex - (string-match spam-blackhole-good-server-regex ip)) - (let ((query-string (concat ip "." server))) - (if spam-use-dig - (let ((query-result (query-dig query-string))) - (when query-result - (gnus-message 5 "(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") - (push (list ip server (query-dns query-string 'TXT)) - matches)))))))) + ;; match the good-server-regex against the reversed (again) IP string + (string-match + spam-blackhole-good-server-regex + (spam-reverse-ip-string ip))) + (unless matches + (let ((query-string (concat ip "." server))) + (if spam-use-dig + (let ((query-result (query-dig query-string))) + (when query-result + (gnus-message 5 "(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") + (push (list ip server (query-dns query-string 'TXT)) + matches))))))))) (when matches spam-split-group))) @@ -724,11 +959,17 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." 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 (message-fetch-field "from"))) + (let ((who (nnmail-fetch-field "from"))) (when who (setq who (cadr (gnus-extract-address-components who))) (if (bbdb-search-simple nil who) @@ -801,6 +1042,12 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (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)) @@ -809,6 +1056,12 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (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)))) @@ -830,6 +1083,12 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (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) @@ -840,6 +1099,12 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (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) @@ -849,14 +1114,11 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (when spam-use-stat (spam-stat-load))) (defun spam-maybe-spam-stat-save () - (when spam-use-stat (spam-stat-save))) - - ;; Add hooks for loading and saving the spam stats - (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) - (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) - (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)) + (when spam-use-stat (spam-stat-save)))) (file-error (progn + (defalias 'spam-maybe-spam-stat-load 'ignore) + (defalias 'spam-maybe-spam-stat-save 'ignore) (defalias 'spam-stat-register-ham-routine 'ignore) (defalias 'spam-stat-register-spam-routine 'ignore) (defalias 'spam-stat-buffer-is-spam 'ignore) @@ -892,11 +1154,13 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (save-excursion (set-buffer (find-file-noselect file)) - (goto-char (point-max)) - (unless (bobp) - (insert "\n")) - (insert address "\n") - (save-buffer))) + (goto-char (point-min)) + (unless (re-search-forward (regexp-quote address) nil t) + (goto-char (point-max)) + (unless (bobp) + (insert "\n")) + (insert address "\n") + (save-buffer)))) ;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise (defun spam-check-whitelist () @@ -923,26 +1187,37 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (while (not (eobp)) (setq address (buffer-substring (point) (spam-point-at-eol))) (forward-line 1) + ;; insert the e-mail address if detected, otherwise the raw data (unless (zerop (length address)) - (setq address (regexp-quote address)) - (while (string-match "\\\\\\*" address) - (setq address (replace-match ".*" t t address))) - (push address contents)))) + (let ((pure-address (cadr (gnus-extract-address-components address)))) + (push (or pure-address address) contents))))) (nreverse contents)))) (defun spam-from-listed-p (cache) - (let ((from (message-fetch-field "from")) + (let ((from (nnmail-fetch-field "from")) found) (while cache - (when (string-match (pop cache) from) - (setq found t - cache nil))) + (let ((address (pop cache))) + (unless (zerop (length address)) ; 0 for a nil address too + (setq address (regexp-quote address)) + ;; fix regexp-quote's treatment of user-intended regexes + (while (string-match "\\\\\\*" address) + (setq address (replace-match ".*" t t address)))) + (when (and address (string-match address from)) + (setq found t + 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)))) @@ -955,22 +1230,36 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." 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)))))) -;;;; Bogofilter +;;;; Spam-report glue +(defun spam-report-gmane-register-routine () + (spam-generic-register-routine + 'spam-report-gmane + nil)) + +;;;; Bogofilter (defun spam-check-bogofilter-headers (&optional score) - (let ((header (message-fetch-field spam-bogofilter-header))) - (when (and header - (string-match spam-bogofilter-bogosity-positive-spam-header - header)) - (if score - (when (string-match "spamicity=\\([0-9.]+\\)" header) - (match-string 1 header)) - spam-split-group)))) + (let ((header (nnmail-fetch-field spam-bogofilter-header))) + (when header ; return nil when no header + (if score ; scoring mode + (if (string-match "spamicity=\\([0-9.]+\\)" header) + (match-string 1 header) + "0") + ;; spam detection mode + (when (string-match spam-bogofilter-bogosity-positive-spam-header + header) + spam-split-group))))) ;; return something sensible if the score can't be determined (defun spam-bogofilter-score () @@ -979,9 +1268,11 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (save-window-excursion (gnus-summary-show-article t) (set-buffer gnus-article-buffer) - (let ((score (spam-check-bogofilter t))) + (let ((score (or (spam-check-bogofilter-headers t) + (spam-check-bogofilter t)))) (message "Spamicity score %s" score) - (or score "0")))) + (or score "0")) + (gnus-summary-show-article))) (defun spam-check-bogofilter (&optional score) "Check the Bogofilter backend for the classification of this message" @@ -1019,6 +1310,12 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (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)) @@ -1027,9 +1324,116 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (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)))) + +;;;; spamoracle +(defun spam-check-spamoracle () + "Run spamoracle on an article to determine whether it's spam." + (let ((article-buffer-name (buffer-name))) + (with-temp-buffer + (let ((temp-buffer-name (buffer-name))) + (save-excursion + (set-buffer article-buffer-name) + (let ((status + (apply 'call-process-region + (point-min) (point-max) + spam-spamoracle-binary + nil temp-buffer-name nil + (if spam-spamoracle-database + `("-f" ,spam-spamoracle-database "mark") + '("mark"))))) + (if (zerop status) + (progn + (set-buffer temp-buffer-name) + (goto-char (point-min)) + (when (re-search-forward "^X-Spam: yes;" nil t) + spam-split-group)) + (error "Error running spamoracle" status)))))))) + +(defun spam-spamoracle-learn (article article-is-spam-p) + "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")) + (status + (apply 'call-process-region + (point-min) (point-max) + spam-spamoracle-binary + nil temp-buffer-name nil + (if spam-spamoracle-database + `("-f" ,spam-spamoracle-database + "add" ,arg) + `("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)) + +;;;; Hooks + +;;;###autoload +(defun spam-initialize () + "Install the spam.el hooks and do other initialization" + (interactive) + (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) + gnus-summary-highlight) + ;; Add hooks for loading and saving the spam stats + (when spam-use-stat + (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) + (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) + (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)) + (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) + (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)) + +(defun spam-unload-hook () + "Uninstall the spam.el hooks" + (interactive) + (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) + (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) + (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) + (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) + (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) + (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)) + +(when spam-install-hooks + (spam-initialize)) + (provide 'spam) ;;; spam.el ends here.