X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fspam.el;h=946f7153480b04b7ca867d35f385bc299f5cb04f;hb=7d3cebb22d43e3ae26e7b1ab3b40c12ec80be154;hp=690ad7f479b1c940b6e4301b141b38bd0562872c;hpb=7f6b650c8f83d87836c2dd4337857c454fde0ce0;p=elisp%2Fgnus.git- diff --git a/lisp/spam.el b/lisp/spam.el index 690ad7f..946f715 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -79,7 +79,8 @@ Populated by spam-install-backend-super.") (defgroup spam nil - "Spam configuration.") + "Spam configuration." + :version "21.4") (defcustom spam-summary-exit-behavior 'default "Exit behavior at the time of summary exit. @@ -379,6 +380,14 @@ Only meaningful if you enable `spam-use-regex-body'." :type '(repeat (regexp :tag "Regular expression to match ham body")) :group 'spam) +(defcustom spam-summary-score-preferred-header nil + "Preferred header to use for spam-summary-score." + :type '(choice :tag "Header name" + (symbol :tag "SpamAssassin etc" X-Spam-Status) + (symbol :tag "Bogofilter" X-Bogosity) + (const :tag "No preference, take best guess." nil)) + :group 'spam) + (defgroup spam-ifile nil "Spam ifile configuration." :group 'spam) @@ -877,6 +886,32 @@ CLASSIFICATION is 'ham or 'spam." classification type))) +(defun spam-backend-article-list-property (classification + &optional unregister) + "Property name of article list with CLASSIFICATION and UNREGISTER." + (let* ((r (if unregister "unregister" "register")) + (prop (format "%s-%s" classification r))) + prop)) + +(defun spam-backend-get-article-todo-list (backend + classification + &optional unregister) + "Get the articles to be processed for BACKEND and CLASSIFICATION. +With UNREGISTER, get articles to be unregistered. +This is a temporary storage function - nothing here persists." + (get + backend + (intern (spam-backend-article-list-property classification unregister)))) + +(defun spam-backend-put-article-todo-list (backend classification list &optional unregister) + "Set the LIST of articles to be processed for BACKEND and CLASSIFICATION. +With UNREGISTER, set articles to be unregistered. +This is a temporary storage function - nothing here persists." + (put + backend + (intern (spam-backend-article-list-property classification unregister)) + list)) + (defun spam-backend-ham-registration-function (backend) "Get the ham registration function for BACKEND." (get backend 'hrf)) @@ -1098,11 +1133,14 @@ backends)." spam-use-spamassassin-headers spam-use-regex-headers) (push 'X-Spam-Status list)) + (when spam-use-bogofilter + (push 'X-Bogosity list)) list)) (defun spam-user-format-function-S (headers) (when headers - (spam-summary-score headers))) + (format "%3.2f" + (spam-summary-score headers spam-summary-score-preferred-header)))) (defun spam-article-sort-by-spam-status (h1 h2) "Sort articles by score." @@ -1116,7 +1154,8 @@ backends)." result)) (defun spam-extra-header-to-number (header headers) - "Transform an extra header to a number." + "Transform an extra HEADER to a number, using list of HEADERS. +Note this has to be fast." (if (gnus-extra-header header headers) (cond ((eq header 'X-Spam-Status) @@ -1126,6 +1165,12 @@ backends)." ;; 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)) + ((eq header 'X-Bogosity) + (string-to-number (gnus-replace-in-string + (gnus-replace-in-string + (gnus-extra-header header headers) + ".*spamicity=" "") + ",.*" ""))) (t nil)) nil)) @@ -1290,27 +1335,26 @@ addition to the set values for the group." ;; 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 backend)) - (spam-unregister-routine - classification - backend - unregister-list)))))) + (spam-backend-put-article-todo-list backend + classification + unregister-list + t)))))) ;; do the non-moving backends first, then the moving ones (dolist (backend-type '(non-mover mover)) - (dolist (classification '(spam ham)) + (dolist (classification (spam-classifications)) (dolist (backend (spam-backend-list backend-type)) (when (spam-group-processor-p gnus-newsgroup-name backend classification) - (let ((num (spam-register-routine classification backend))) - (when (> num 0) - (gnus-message - 6 - "%d %s messages were processed by backend %s." - num - classification - backend))))))) + (spam-backend-put-article-todo-list backend + classification + (spam-list-articles + gnus-newsgroup-articles + classification)))))) + + (spam-resolve-registrations-routine) ; do the registrations now ;; we mark all the leftover spam articles as expired at the end (dolist (article (spam-list-articles @@ -1657,15 +1701,71 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;{{{ registration/unregistration functions +(defun spam-resolve-registrations-routine () + "Go through the backends and register or unregister articles as needed." + (dolist (backend-type '(non-mover mover)) + (dolist (classification (spam-classifications)) + (dolist (backend (spam-backend-list backend-type)) + (let ((rlist (spam-backend-get-article-todo-list + backend classification)) + (ulist (spam-backend-get-article-todo-list + backend classification t)) + (delcount 0)) + + ;; clear the old lists right away + (spam-backend-put-article-todo-list backend + classification + nil + nil) + (spam-backend-put-article-todo-list backend + classification + nil + t) + + ;; eliminate duplicates + (dolist (article (copy-sequence ulist)) + (when (memq article rlist) + (incf delcount) + (setq rlist (delq article rlist)) + (setq ulist (delq article ulist)))) + + (unless (zerop delcount) + (gnus-message + 9 + "%d messages were saved the trouble of unregistering and then registering" + delcount)) + + ;; unregister articles + (unless (zerop (length ulist)) + (let ((num (spam-unregister-routine classification backend ulist))) + (when (> num 0) + (gnus-message + 6 + "%d %s messages were unregistered by backend %s." + num + classification + backend)))) + + ;; register articles + (unless (zerop (length rlist)) + (let ((num (spam-register-routine classification backend rlist))) + (when (> num 0) + (gnus-message + 6 + "%d %s messages were registered by backend %s." + num + classification + backend))))))))) + (defun spam-unregister-routine (classification - backend - &optional specific-articles) - (spam-register-routine classification backend t specific-articles)) + backend + specific-articles) + (spam-register-routine classification backend specific-articles t)) (defun spam-register-routine (classification - backend - &optional unregister - specific-articles) + backend + specific-articles + &optional unregister) (when (and (spam-classification-valid-p classification) (spam-backend-valid-p backend)) (let* ((register-function @@ -1695,7 +1795,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." classification backend) (funcall run-function articles) - ;; now log all the registrations (or undo them, depending on unregister) + ;; now log all the registrations (or undo them, depending on + ;; unregister) (dolist (article articles) (funcall log-function (spam-fetch-field-message-id-fast article) @@ -1703,7 +1804,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." classification backend gnus-newsgroup-name)))) - (length articles)))) ;return the number of articles processed + ;; return the number of articles processed + (length articles)))) ;;; log a ham- or spam-processor invocation to the registry (defun spam-log-processing-to-registry (id type classification backend group) @@ -2357,11 +2459,11 @@ REMOVE not nil, remove the ADDRESSES." (defun spam-verify-bogofilter () "Verify the Bogofilter version is sufficient." - (when (eq spam-bogofilter-valid 'never) + (when (eq spam-bogofilter-valid 'unknown) (setq spam-bogofilter-valid (not (string-match "^bogofilter version 0\\.\\([0-9]\\|1[01]\\)\\." (shell-command-to-string - (format "%s -sV" spam-bogofilter-path)))))) + (format "%s -V" spam-bogofilter-path)))))) spam-bogofilter-valid) (defun spam-check-bogofilter (&optional score) @@ -2784,6 +2886,8 @@ installed through spam-necessary-extra-headers." (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) +(add-hook 'spam-unload-hook 'spam-unload-hook) + (when spam-install-hooks (spam-initialize)) ;;}}}