;;; spam.el --- Identifying spam
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2002-2014 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
;;{{{ compilation directives and autoloads/requires
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'message) ;for the message-fetch-field functions
;;; for the definitions of group content classification and spam processors
(require 'gnus)
-(eval-when-compile (require 'spam-report))
(eval-when-compile (require 'hashcash))
;; for nnimap-split-download-body-default
(autoload 'query-dig "dig")
;; autoload spam-report
-(eval-and-compile
- (autoload 'spam-report-gmane "spam-report")
- (autoload 'spam-report-gmane-spam "spam-report")
- (autoload 'spam-report-gmane-ham "spam-report")
- (autoload 'spam-report-resend "spam-report"))
+(autoload 'spam-report-gmane "spam-report")
+(autoload 'spam-report-gmane-spam "spam-report")
+(autoload 'spam-report-gmane-ham "spam-report")
+(autoload 'spam-report-resend "spam-report")
;; 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")
a group through group/topic parameters overrides this mechanism."
:type '(choice
(const
- 'default
- :tag "Move spam out of all groups and ham out of spam groups.")
+ :tag "Move spam out of all groups and ham out of spam groups"
+ default)
(const
- 'move-all
- :tag "Move spam out of all groups and ham out of all groups.")
+ :tag "Move spam out of all groups and ham out of all groups"
+ move-all)
(const
- 'move-none
- :tag "Never move spam or ham out of any groups."))
+ :tag "Never move spam or ham out of any groups"
+ move-none))
:group 'spam)
(defcustom spam-directory (nnheader-concat gnus-directory "spam/")
: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)
(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))
(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
(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
(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
(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
(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"
;; 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))
(eval-and-compile
- (when (condition-case nil
- (progn
- (require 'bbdb)
- (require 'bbdb-com))
- (file-error
- ;; `bbdb-records' should not be bound as an autoload function
- ;; before loading bbdb because of `bbdb-hashtable-size'.
- (defalias 'bbdb-records 'ignore)
- (defalias 'spam-BBDB-register-routine 'ignore)
- (defalias 'spam-enter-ham-BBDB 'ignore)
- nil))
+ (condition-case nil
+ (progn
+ (require 'bbdb)
+ (require 'bbdb-com))
+ (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)))
+(eval-and-compile
+ (when (featurep 'bbdb-com)
;; when the BBDB changes, we want to clear out our cache
(defun spam-clear-cache-BBDB (&rest immaterial)
(spam-clear-cache 'spam-use-BBDB))
'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")
(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
(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))
-
- (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))))))
+(require 'spam-stat)
- (defun spam-stat-unregister-spam-routine (articles)
- (spam-stat-register-spam-routine articles t))
+(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-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-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-ham-routine (articles)
- (spam-stat-register-ham-routine articles t))
+(defun spam-stat-unregister-spam-routine (articles)
+ (spam-stat-register-spam-routine articles t))
- (defun spam-maybe-spam-stat-load ()
- (when spam-use-stat (spam-stat-load)))
+(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-maybe-spam-stat-save ()
- (when spam-use-stat (spam-stat-save)))))
+(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-save ()
+ (when spam-use-stat (spam-stat-save)))
;;}}}
(defun spam-report-resend-register-ham-routine (articles)
(spam-report-resend-register-routine articles t))
+(defvar spam-report-resend-to)
+
(defun spam-report-resend-register-routine (articles &optional ham)
+ (require 'spam-report)
(let* ((resend-to-gp
(if ham
(gnus-parameter-ham-resend-to gnus-newsgroup-name)
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 the `spam' face is customized?
- (push '((eq mark gnus-spam-mark) . spam)
- gnus-summary-highlight)
- ;; 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)
- (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)
- (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
+ (when spam-install-hooks
+ (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))
+
+ ;; TODO: How do we redo this every time the `spam' face is customized?
+ (push '((eq mark gnus-spam-mark) . spam)
+ gnus-summary-highlight)
+ ;; 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)
+ (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)
+ (add-hook 'gnus-summary-prepared-hook 'spam-find-spam)
+ ;; Don't install things more than once.
+ (setq spam-install-hooks nil)))
(defun spam-unload-hook ()
"Uninstall the spam.el hooks."
(add-hook 'spam-unload-hook 'spam-unload-hook)
-(when spam-install-hooks
- (spam-initialize))
;;}}}
(provide 'spam)
projects / gnus / blobdiff