X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fspam.el;h=c3be15adc1a0a92449faeeb3250e0e8a72ad3b68;hb=6910044663bc77081e08faabd6385cd34a9c8f5d;hp=ec3212b96e55212824c144a2c5b2f075601c00d8;hpb=4c2a7a1c25d5b10316f35f28c972ef3e70225f25;p=gnus diff --git a/lisp/spam.el b/lisp/spam.el index ec3212b96..c3be15adc 100644 --- a/lisp/spam.el +++ b/lisp/spam.el @@ -1,7 +1,6 @@ ;;; spam.el --- Identifying spam -;; Copyright (C) 2002-2011 -;; Free Software Foundation, Inc. +;; Copyright (C) 2002-2012 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Maintainer: Ted Zlatanov @@ -69,9 +68,9 @@ ;; autoload gnus-registry (autoload 'gnus-registry-group-count "gnus-registry") -(autoload 'gnus-registry-add-group "gnus-registry") -(autoload 'gnus-registry-store-extra-entry "gnus-registry") -(autoload 'gnus-registry-fetch-extra "gnus-registry") +(autoload 'gnus-registry-get-id-key "gnus-registry") +(autoload 'gnus-registry-set-id-key "gnus-registry") +(autoload 'gnus-registry-handle-action "gnus-registry") ;; autoload dns-query (autoload 'dns-query "dns") @@ -157,7 +156,7 @@ last rule in your split configuration." :group 'spam) (defcustom spam-autodetect-recheck-messages nil - "Should spam.el recheck all meessages when autodetecting? + "Should spam.el recheck all messages when autodetecting? Normally this is nil, so only unseen messages will be checked." :type 'boolean :group 'spam) @@ -1582,31 +1581,31 @@ to find it out)." (when (numberp article) (let* ((data-header (or prepared-data-header (spam-fetch-article-header article)))) - (if (arrayp data-header) - (cond - ((equal field 'number) - (mail-header-number data-header)) - ((equal field 'from) - (mail-header-from data-header)) - ((equal field 'message-id) - (mail-header-message-id data-header)) - ((equal field 'subject) - (mail-header-subject data-header)) - ((equal field 'references) - (mail-header-references data-header)) - ((equal field 'date) - (mail-header-date data-header)) - ((equal field 'xref) - (mail-header-xref data-header)) - ((equal field 'extra) - (mail-header-extra data-header)) - (t - (gnus-error - 5 - "spam-fetch-field-fast: unknown field %s requested" - field) - nil)) - (gnus-message 6 "Article %d has a nil data header" article))))) + (cond + ((not (arrayp data-header)) + (gnus-message 6 "Article %d has a nil data header" article)) + ((equal field 'number) + (mail-header-number data-header)) + ((equal field 'from) + (mail-header-from data-header)) + ((equal field 'message-id) + (mail-header-message-id data-header)) + ((equal field 'subject) + (mail-header-subject data-header)) + ((equal field 'references) + (mail-header-references data-header)) + ((equal field 'date) + (mail-header-date data-header)) + ((equal field 'xref) + (mail-header-xref data-header)) + ((equal field 'extra) + (mail-header-extra data-header)) + (t + (gnus-error + 5 + "spam-fetch-field-fast: unknown field %s requested" + field) + nil))))) (defun spam-fetch-field-from-fast (article &optional prepared-data-header) (spam-fetch-field-fast article 'from prepared-data-header)) @@ -1765,8 +1764,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when (and id split-return spam-log-to-registry) (when (zerop (gnus-registry-group-count id)) - (gnus-registry-add-group - id group subject sender)) + (gnus-registry-handle-action id nil group subject sender)) (unless registry-lookup (spam-log-processing-to-registry @@ -1895,13 +1893,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (spam-process-type-valid-p type) (spam-classification-valid-p classification) (spam-backend-valid-p backend)) - (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + (let ((cell-list (gnus-registry-get-id-key id type)) (cell (list classification backend group))) (push cell cell-list) - (gnus-registry-store-extra-entry - id - type - cell-list)) + (gnus-registry-set-id-key id type cell-list)) (gnus-error 7 @@ -1914,7 +1909,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (when spam-log-to-registry (if (and (stringp id) (spam-process-type-valid-p type)) - (cdr-safe (gnus-registry-fetch-extra id type)) + (gnus-registry-get-id-key id type) (progn (gnus-error 7 @@ -1946,7 +1941,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (spam-process-type-valid-p type) (spam-classification-valid-p classification) (spam-backend-valid-p backend)) - (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + (let ((cell-list (gnus-registry-get-id-key id type)) found) (dolist (cell cell-list) (unless found @@ -1971,16 +1966,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (spam-process-type-valid-p type) (spam-classification-valid-p classification) (spam-backend-valid-p backend)) - (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type))) + (let ((cell-list (gnus-registry-get-id-key id type)) new-cell-list found) (dolist (cell cell-list) (unless (and (eq classification (nth 0 cell)) (eq backend (nth 1 cell))) (push cell new-cell-list))) - (gnus-registry-store-extra-entry - id - type - new-cell-list)) + (gnus-registry-set-id-key id type new-cell-list)) (progn (gnus-error 7 (format "%s call with bad ID, type, spam-backend, or group" @@ -2096,11 +2088,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; all this is done inside a condition-case to trap errors -(eval-when-compile - (autoload 'bbdb-buffer "bbdb") - (autoload 'bbdb-create-internal "bbdb") - (autoload 'bbdb-search-simple "bbdb")) - ;; Autoloaded in message, which we require. (declare-function gnus-extract-address-components "gnus-util" (from)) @@ -2112,9 +2099,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (file-error ;; `bbdb-records' should not be bound as an autoload function ;; before loading bbdb because of `bbdb-hashtable-size'. + (defalias 'bbdb-buffer 'ignore) + (defalias 'bbdb-create-internal 'ignore) (defalias 'bbdb-records 'ignore) (defalias 'spam-BBDB-register-routine 'ignore) (defalias 'spam-enter-ham-BBDB 'ignore) + (defalias 'spam-exists-in-BBDB-p 'ignore) + (defalias 'bbdb-gethash 'ignore) nil)) ;; when the BBDB changes, we want to clear out our cache @@ -2134,7 +2125,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." 'ignore)) (net-address (nth 1 parsed-address)) (record (and net-address - (bbdb-search-simple nil net-address)))) + (spam-exists-in-BBDB-p net-address)))) (when net-address (gnus-message 6 "%s address %s %s BBDB" (if remove "Deleting" "Adding") @@ -2156,31 +2147,17 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun spam-BBDB-unregister-routine (articles) (spam-BBDB-register-routine articles t)) + (defsubst spam-exists-in-BBDB-p (net) + (when (and (stringp net) (not (zerop (length net)))) + (bbdb-records) + (bbdb-gethash (downcase net)))) + (defun spam-check-BBDB () "Mail from people in the BBDB is classified as ham or non-spam" - (let ((who (message-fetch-field "from")) - bbdb-cache bbdb-hashtable) - (when spam-cache-lookups - (setq bbdb-cache (gethash 'spam-use-BBDB spam-caches)) - (unless bbdb-cache - (setq bbdb-cache (make-vector 17 0)) ; a good starting hash value - ;; this is based on the expanded (bbdb-hashtable) macro - ;; without the debugging support - (with-current-buffer (bbdb-buffer) - (save-excursion - (save-window-excursion - (bbdb-records nil t) - (mapatoms - (lambda (symbol) - (intern (downcase (symbol-name symbol)) bbdb-cache)) - bbdb-hashtable)))) - (puthash 'spam-use-BBDB bbdb-cache spam-caches))) - (when who - (setq who (nth 1 (gnus-extract-address-components who))) - (if - (if spam-cache-lookups - (intern-soft (downcase who) bbdb-cache) - (bbdb-search-simple nil who)) + (let ((net (message-fetch-field "from"))) + (when net + (setq net (nth 1 (gnus-extract-address-components net))) + (if (spam-exists-in-BBDB-p net) t (if spam-use-BBDB-exclusive spam-split-group @@ -2268,51 +2245,44 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (autoload 'spam-stat-save "spam-stat") (autoload 'spam-stat-split-fancy "spam-stat")) -(eval-and-compile - (when (condition-case nil - (let ((spam-stat-install-hooks nil)) - (require 'spam-stat)) - (file-error - (defalias 'spam-stat-register-ham-routine 'ignore) - (defalias 'spam-stat-register-spam-routine 'ignore) - nil)) +(require 'spam-stat) - (defun spam-check-stat () - "Check the spam-stat backend for the classification of this message" - (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override - (spam-stat-buffer (buffer-name)) ; stat the current buffer - category return) - (spam-stat-split-fancy))) +(defun spam-check-stat () + "Check the spam-stat backend for the classification of this message" + (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override + (spam-stat-buffer (buffer-name)) ; stat the current buffer + category return) + (spam-stat-split-fancy))) - (defun spam-stat-register-spam-routine (articles &optional unregister) - (dolist (article articles) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (if unregister - (spam-stat-buffer-change-to-non-spam) - (spam-stat-buffer-is-spam)))))) +(defun spam-stat-register-spam-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-non-spam) + (spam-stat-buffer-is-spam)))))) - (defun spam-stat-unregister-spam-routine (articles) - (spam-stat-register-spam-routine articles t)) +(defun spam-stat-unregister-spam-routine (articles) + (spam-stat-register-spam-routine articles t)) - (defun spam-stat-register-ham-routine (articles &optional unregister) - (dolist (article articles) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (if unregister - (spam-stat-buffer-change-to-spam) - (spam-stat-buffer-is-non-spam)))))) +(defun spam-stat-register-ham-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-spam) + (spam-stat-buffer-is-non-spam)))))) - (defun spam-stat-unregister-ham-routine (articles) - (spam-stat-register-ham-routine articles t)) +(defun spam-stat-unregister-ham-routine (articles) + (spam-stat-register-ham-routine articles t)) - (defun spam-maybe-spam-stat-load () - (when spam-use-stat (spam-stat-load))) +(defun spam-maybe-spam-stat-load () + (when spam-use-stat (spam-stat-load))) - (defun spam-maybe-spam-stat-save () - (when spam-use-stat (spam-stat-save))))) +(defun spam-maybe-spam-stat-save () + (when spam-use-stat (spam-stat-save))) ;;}}}