Update copyright statement.
[gnus] / lisp / spam.el
index 8719c10..ffecadf 100644 (file)
@@ -1,5 +1,5 @@
 ;;; spam.el --- Identifying spam
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: network
@@ -100,6 +100,13 @@ The regular expression is matched against the address."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-use-whitelist-exclusive nil
+  "Whether whitelist-exclusive should be used by spam-split.
+Exclusive whitelisting means that all messages from senders not in the whitelist
+are considered spam."
+  :type 'boolean
+  :group 'spam)
+
 (defcustom spam-use-blackholes nil
   "Whether blackholes should be used by spam-split."
   :type 'boolean
@@ -128,6 +135,13 @@ Enable this if you want Gnus to invoke Bogofilter on new messages."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-use-BBDB-exclusive nil
+  "Whether BBDB-exclusive should be used by spam-split.
+Exclusive BBDB means that all messages from senders not in the BBDB are 
+considered spam."
+  :type 'boolean
+  :group 'spam)
+
 (defcustom spam-use-ifile nil
   "Whether ifile should be used by spam-split."
   :type 'boolean
@@ -155,6 +169,11 @@ All unmarked article in such group receive the spam mark on group entry."
   :type '(repeat (string :tag "Server"))
   :group 'spam)
 
+(defcustom spam-blackhole-good-server-regex nil
+  "String matching IP addresses that should not be checked in the blackholes"
+  :type 'regexp
+  :group 'spam)
+
 (defcustom spam-ham-marks (list 'gnus-del-mark 'gnus-read-mark 
                                'gnus-killed-mark 'gnus-kill-file-mark 
                                'gnus-low-score-mark)
@@ -243,6 +262,11 @@ your main source of newsgroup names."
   :type 'string
   :group 'spam-bogofilter)
 
+(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
+  "The regex on `spam-bogofilter-header' for positive spam identification."
+  :type 'regexp
+  :group 'spam-bogofilter)
+
 (defcustom spam-bogofilter-database-directory nil
   "Directory path of the Bogofilter databases."
   :type '(choice (directory :tag "Location of the Bogofilter database directory")
@@ -321,24 +345,30 @@ your main source of newsgroup names."
 
 (defun spam-summary-prepare-exit ()
   ;; The spam processors are invoked for any group, spam or ham or neither
+  (gnus-message 6 "Exiting summary buffer and applying spam rules")
   (when (and spam-bogofilter-path
             (spam-group-spam-processor-bogofilter-p gnus-newsgroup-name))
+    (gnus-message 5 "Registering spam with bogofilter")
     (spam-bogofilter-register-spam-routine))
   
   (when (and spam-ifile-path
             (spam-group-spam-processor-ifile-p gnus-newsgroup-name))
+    (gnus-message 5 "Registering spam with ifile")
     (spam-ifile-register-spam-routine))
   
   (when (spam-group-spam-processor-stat-p gnus-newsgroup-name)
+    (gnus-message 5 "Registering spam with spam-stat")
     (spam-stat-register-spam-routine))
 
   (when (spam-group-spam-processor-blacklist-p gnus-newsgroup-name)
+    (gnus-message 5 "Registering spam with the blacklist")
     (spam-blacklist-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
         (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
+    (gnus-message 5 "Marking spam as expired and moving it")
     (spam-mark-spam-as-expired-and-move-routine 
      (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
 
@@ -348,18 +378,24 @@ your main source of newsgroup names."
 
   (when (spam-group-ham-contents-p gnus-newsgroup-name)
     (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering ham with the whitelist")
       (spam-whitelist-register-routine))
     (when (spam-group-ham-processor-ifile-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering ham with ifile")
       (spam-ifile-register-ham-routine))
     (when (spam-group-ham-processor-bogofilter-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering ham with Bogofilter")
       (spam-bogofilter-register-ham-routine))
     (when (spam-group-ham-processor-stat-p gnus-newsgroup-name)
+      (gnus-message 5 "Registering ham with spam-stat")
       (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)))
 
   ;; now move all ham articles out of spam groups
   (when (spam-group-spam-contents-p gnus-newsgroup-name)
+    (gnus-message 5 "Moving ham messages from spam group")
     (spam-ham-move-routine
      (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
 
@@ -369,6 +405,7 @@ your main source of newsgroup names."
   ;; 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
@@ -390,15 +427,15 @@ your main source of newsgroup names."
 (defun spam-ham-move-routine (&optional group)
   (let ((articles gnus-newsgroup-articles)
        article ham-mark-values mark)
+
     (dolist (mark spam-ham-marks)
       (push (symbol-value mark) ham-mark-values))
-
-    (while articles
-      (setq article (pop articles))
-      (when (and (memq mark ham-mark-values)
+    
+    (dolist (article articles)
+      (when (and (memq (gnus-summary-article-mark article) ham-mark-values)
                 (stringp group))
-         (let ((gnus-current-article article))
-           (gnus-summary-move-article nil group))))))
+       (let ((gnus-current-article article))
+         (gnus-summary-move-article nil group))))))
  
 (defun spam-generic-register-routine (spam-func ham-func)
   (let ((articles gnus-newsgroup-articles)
@@ -491,9 +528,9 @@ your main source of newsgroup names."
 "The spam-list-of-checks list contains pairs associating a parameter
 variable with a spam checking function.  If the parameter variable is
 true, then the checking function is called, and its value decides what
-happens.  Each individual check may return `nil', `t', or a mailgroup
-name.  The value `nil' means that the check does not yield a decision,
-and so, that further checks are needed.  The value `t' means that the
+happens.  Each individual check may return nil, t, or a mailgroup
+name.  The value nil means that the check does not yield a decision,
+and so, that further checks are needed.  The value t means that the
 message is definitely not spam, and that further spam checks should be
 inhibited.  Otherwise, a mailgroup name is returned where the mail
 should go, and further checks are also inhibited.  The usual mailgroup
@@ -516,6 +553,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (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
@@ -551,26 +589,30 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (with-temp-buffer
        (insert headers)
        (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)
-         (message "Blackhole search found host IP %s." (match-string 1))
+         (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
          (push (mapconcat 'identity
                           (nreverse (split-string (match-string 1) "\\."))
                           ".")
                ips)))
       (dolist (server spam-blackhole-servers)
        (dolist (ip ips)
-         (let ((query-string (concat ip "." server)))
-           (if spam-use-dig
-               (let ((query-result (query-dig query-string)))
-                 (when query-result
-                   (message "spam: positive blackhole check '%s'" query-result)
-                   (push (list ip server query-result)
-                         matches)))
-             ;; else, if not using dig.el
-             (when (query-dns query-string)
-               (push (list ip server (query-dns query-string 'TXT))
-                     matches)))))))
+         (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))))))))
     (when matches
       spam-split-group)))
 \f
@@ -592,7 +634,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
       (let* ((parsed-address (gnus-extract-address-components from))
             (name (or (car parsed-address) "Ham Sender"))
             (net-address (car (cdr parsed-address))))
-       (message "Adding address %s to BBDB" from)
+       (gnus-message 5 "Adding address %s to BBDB" from)
        (when (and net-address
                   (not (bbdb-search-simple nil net-address)))
          (bbdb-create-internal name nil net-address nil nil 
@@ -607,13 +649,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
        (spam-enter-ham-BBDB (spam-fetch-field-from-fast article)))))
 
   (defun spam-check-BBDB ()
-    "Mail from people in the BBDB is never considered spam"
+    "Mail from people in the BBDB is classified as ham or non-spam"
     (let ((who (message-fetch-field "from")))
       (when who
-       (setq who (regexp-quote (cadr
-                                (gnus-extract-address-components who))))
+       (setq who (cadr (gnus-extract-address-components who)))
        (if (bbdb-search-simple nil who)
-           nil spam-split-group)))))
+           t 
+         (if spam-use-BBDB-exclusive
+             spam-split-group
+           nil))))))
 
   (file-error (progn
                (defalias 'bbdb-search-simple 'ignore)
@@ -767,12 +811,16 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
     (insert address "\n")
     (save-buffer)))
 
-;;; returns nil if the sender is in the whitelist, spam-split-group otherwise
+;;; returns t if the sender is in the whitelist, nil or spam-split-group otherwise
 (defun spam-check-whitelist ()
   ;; FIXME!  Should it detect when file timestamps change?
   (unless spam-whitelist-cache
     (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
-  (if (spam-from-listed-p spam-whitelist-cache) nil spam-split-group))
+  (if (spam-from-listed-p spam-whitelist-cache) 
+      t
+    (if spam-use-whitelist-exclusive
+       spam-split-group
+      nil)))
 
 (defun spam-check-blacklist ()
   ;; FIXME!  Should it detect when file timestamps change?
@@ -830,12 +878,12 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 (defun spam-check-bogofilter-headers (&optional score)
   (let ((header (message-fetch-field spam-bogofilter-header)))
       (when (and header
-              (string-match "^Yes" 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))))
-         
 
 ;; return something sensible if the score can't be determined
 (defun spam-bogofilter-score ()