Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-37
[gnus] / lisp / spam.el
index d899b15..ee57514 100644 (file)
@@ -79,7 +79,8 @@
 Populated by spam-install-backend-super.")
 
 (defgroup spam nil
-  "Spam configuration.")
+  "Spam configuration."
+  :version "22.1")
 
 (defcustom spam-summary-exit-behavior 'default
   "Exit behavior at the time of summary exit.
@@ -346,11 +347,22 @@ Only meaningful if you enable `spam-use-blackholes'."
 (defcustom spam-blackhole-good-server-regex nil
   "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))
+  :type '(radio (const nil) regexp)
   :group 'spam)
 
-(defcustom spam-face 'gnus-splash-face
+(defface spam-face
+  '((((class color) (type tty) (background dark))
+     (:foreground "gray80" :background "gray50"))
+    (((class color) (type tty) (background light))
+     (:foreground "gray50" :background "gray80"))
+    (((class color) (background dark))
+     (:foreground "ivory2"))
+    (((class color) (background light))
+     (:foreground "ivory4"))
+    (t :inverse-video t))
+  "Face for spam-marked articles.")
+
+(defcustom spam-face 'spam-face
   "Face for spam-marked articles."
   :type 'face
   :group 'spam)
@@ -379,6 +391,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 +897,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 +1144,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 +1165,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 +1176,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))
 
@@ -1271,6 +1327,10 @@ addition to the set values for the group."
   (unless gnus-group-is-exiting-without-update-p
     (gnus-message 6 "Exiting summary buffer and applying spam rules")
 
+    ;; before we begin, remove any article limits
+;    (ignore-errors
+;      (gnus-summary-pop-limit t))
+
     ;; first of all, unregister any articles that are no longer ham or spam
     ;; we have to iterate over the processors, or else we'll be too slow
     (dolist (classification (spam-classifications))
@@ -1290,27 +1350,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 +1716,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 +1810,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 +1819,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)
@@ -1898,6 +2015,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
 ;;{{{ Hashcash.
 
+(eval-when-compile
+  (autoload 'mail-check-payment "hashcash"))
+
 (condition-case nil
     (progn
       (require 'hashcash)
@@ -1906,9 +2026,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
        "Check the headers for hashcash payments."
        (mail-check-payment)))   ;mail-check-payment returns a boolean
 
-  (file-error (progn
-               (defalias 'mail-check-payment 'ignore)
-               (defalias 'spam-check-hashcash 'ignore))))
+  (file-error))
 ;;}}}
 
 ;;{{{ BBDB
@@ -1918,88 +2036,92 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
 ;; all this is done inside a condition-case to trap errors
 
-(condition-case nil
-    (progn
-      (require 'bbdb)
-      (require '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))
-
-      (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
-
-      (defun spam-enter-ham-BBDB (addresses &optional remove)
-       "Enter an address into the BBDB; implies ham (non-spam) sender"
-       (dolist (from addresses)
-         (when (stringp from)
-           (let* ((parsed-address (gnus-extract-address-components from))
-                  (name (or (nth 0 parsed-address) "Ham Sender"))
-                  (remove-function (if remove
-                                       'bbdb-delete-record-internal
-                                     'ignore))
-                  (net-address (nth 1 parsed-address))
-                  (record (and net-address
-                               (bbdb-search-simple nil net-address))))
-             (when net-address
-               (gnus-message 6 "%s address %s %s BBDB"
-                             (if remove "Deleting" "Adding")
-                             from
-                             (if remove "from" "to"))
-               (if record
-                   (funcall remove-function record)
-                 (bbdb-create-internal name nil net-address nil nil
-                                       "ham sender added by spam.el")))))))
-
-      (defun spam-BBDB-register-routine (articles &optional unregister)
-       (let (addresses)
-         (dolist (article articles)
-           (when (stringp (spam-fetch-field-from-fast article))
-             (push (spam-fetch-field-from-fast article) addresses)))
-         ;; now do the register/unregister action
-         (spam-enter-ham-BBDB addresses unregister)))
-
-      (defun spam-BBDB-unregister-routine (articles)
-       (spam-BBDB-register-routine articles t))
-
-      (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
-                   ;; this is the expanded (bbdb-hashtable) macro
-                   ;; without the debugging support
-                   (with-current-buffer (bbdb-buffer)
-                     (save-excursion
-                       (save-window-excursion
-                         (bbdb-records nil t)
-                         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
-                   (symbol-value
-                    (intern-soft who bbdb-cache))
-                 (bbdb-search-simple nil who))
-               t
-             (if spam-use-BBDB-exclusive
-                 spam-split-group
-               nil))))))
-
-  (file-error (progn
-               (defalias 'bbdb-search-simple 'ignore)
-               (defalias 'bbdb-records 'ignore)
-               (defalias 'bbdb-buffer 'ignore)
-               (defalias 'spam-check-BBDB 'ignore)
-               (defalias 'spam-BBDB-register-routine 'ignore)
-               (defalias 'spam-enter-ham-BBDB 'ignore)
-               (defalias 'bbdb-create-internal 'ignore)
-               (defalias 'bbdb-delete-record-internal 'ignore)
-               (defalias 'bbdb-records 'ignore))))
+(eval-when-compile
+  (autoload 'bbdb-buffer "bbdb")
+  (autoload 'bbdb-create-internal "bbdb")
+  (autoload 'bbdb-search-simple "bbdb"))
+
+(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))
+
+    ;; when the BBDB changes, we want to clear out our cache
+    (defun spam-clear-cache-BBDB (&rest immaterial)
+      (spam-clear-cache 'spam-use-BBDB))
+
+    (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
+
+    (defun spam-enter-ham-BBDB (addresses &optional remove)
+      "Enter an address into the BBDB; implies ham (non-spam) sender"
+      (dolist (from addresses)
+       (when (stringp from)
+         (let* ((parsed-address (gnus-extract-address-components from))
+                (name (or (nth 0 parsed-address) "Ham Sender"))
+                (remove-function (if remove
+                                     'bbdb-delete-record-internal
+                                   'ignore))
+                (net-address (nth 1 parsed-address))
+                (record (and net-address
+                             (bbdb-search-simple nil net-address))))
+           (when net-address
+             (gnus-message 6 "%s address %s %s BBDB"
+                           (if remove "Deleting" "Adding")
+                           from
+                           (if remove "from" "to"))
+             (if record
+                 (funcall remove-function record)
+               (bbdb-create-internal name nil net-address nil nil
+                                     "ham sender added by spam.el")))))))
+
+    (defun spam-BBDB-register-routine (articles &optional unregister)
+      (let (addresses)
+       (dolist (article articles)
+         (when (stringp (spam-fetch-field-from-fast article))
+           (push (spam-fetch-field-from-fast article) addresses)))
+       ;; now do the register/unregister action
+       (spam-enter-ham-BBDB addresses unregister)))
+
+    (defun spam-BBDB-unregister-routine (articles)
+      (spam-BBDB-register-routine articles t))
+
+    (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))
+             t
+           (if spam-use-BBDB-exclusive
+               spam-split-group
+             nil)))))))
 
 ;;}}}
 
@@ -2074,65 +2196,60 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 
 ;;{{{ spam-stat
 
-(condition-case nil
-    (progn
-      (let ((spam-stat-install-hooks 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)))
+(eval-when-compile
+  (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
+  (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
+  (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
+  (autoload 'spam-stat-buffer-is-spam "spam-stat")
+  (autoload 'spam-stat-load "spam-stat")
+  (autoload 'spam-stat-save "spam-stat")
+  (autoload 'spam-stat-split-fancy "spam-stat"))
 
-      (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)
+(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))))))
 
-      (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)
+    (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-maybe-spam-stat-load ()
-       (when spam-use-stat (spam-stat-load)))
-
-      (defun spam-maybe-spam-stat-save ()
-       (when spam-use-stat (spam-stat-save))))
-
-  (file-error (progn
-               (defalias 'spam-stat-load 'ignore)
-               (defalias 'spam-stat-save 'ignore)
-               (defalias 'spam-maybe-spam-stat-load 'ignore)
-               (defalias 'spam-maybe-spam-stat-save 'ignore)
-               (defalias 'spam-stat-register-ham-routine 'ignore)
-               (defalias 'spam-stat-unregister-ham-routine 'ignore)
-               (defalias 'spam-stat-register-spam-routine 'ignore)
-               (defalias 'spam-stat-unregister-spam-routine 'ignore)
-               (defalias 'spam-stat-buffer-is-spam 'ignore)
-               (defalias 'spam-stat-buffer-change-to-spam 'ignore)
-               (defalias 'spam-stat-buffer-is-non-spam 'ignore)
-               (defalias 'spam-stat-buffer-change-to-non-spam 'ignore)
-               (defalias 'spam-stat-split-fancy 'ignore)
-               (defalias 'spam-check-stat 'ignore))))
+    (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)))))
 
 ;;}}}
 
@@ -2357,7 +2474,7 @@ 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 
@@ -2784,6 +2901,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))
 ;;}}}