* gnus.el (spam-process-destination, ham-process-destination):
[gnus] / lisp / spam.el
index ab12dac..a7d84ee 100644 (file)
@@ -80,6 +80,16 @@ spam groups."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-process-ham-in-nonham-groups nil
+  "Whether ham should be processed in non-ham groups."
+  :type 'boolean
+  :group 'spam)
+
+(defcustom spam-process-ham-in-spam-groups nil
+  "Whether ham should be processed in spam groups."
+  :type 'boolean
+  :group 'spam)
+
 (defcustom spam-mark-only-unseen-as-spam t
   "Whether only unseen articles should be marked as spam in spam
 groups.  When nil, all unread articles in a spam group are marked as
@@ -148,6 +158,12 @@ Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-use-regex-body nil
+  "Whether a body regular expression match should be used by spam-split.
+Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
+  :type 'boolean
+  :group 'spam)
+
 (defcustom spam-use-bogofilter-headers nil
   "Whether bogofilter headers should be used by spam-split.
 Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
@@ -195,6 +211,7 @@ considered spam."
                               spam-use-blackholes 
                               spam-use-hashcash 
                               spam-use-regex-headers 
+                              spam-use-regex-body 
                               spam-use-bogofilter-headers 
                               spam-use-bogofilter 
                               spam-use-BBDB 
@@ -212,6 +229,7 @@ the spam-use-* variables is set."
   :type 'string
   :group 'spam)
 
+;;; TODO: deprecate this variable, it's confusing since it's a list of strings, not regular expressions
 (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel"))
   "Mailgroups with spam contents.
 All unmarked article in such group receive the spam mark on group entry."
@@ -226,7 +244,8 @@ All unmarked article in such group receive the spam mark on group entry."
 
 (defcustom spam-blackhole-good-server-regex nil
   "String matching IP addresses that should not be checked in the blackholes"
-  :type 'regexp
+  :type '(radio (const nil)
+               (regexp :format "%t: %v\n" :size 0))
   :group 'spam)
 
 (defcustom spam-face 'gnus-splash-face
@@ -244,6 +263,16 @@ All unmarked article in such group receive the spam mark on group entry."
   :type '(repeat (regexp :tag "Regular expression to match ham header"))
   :group 'spam)
 
+(defcustom spam-regex-body-spam '()
+  "Regular expression for positive body spam matches"
+  :type '(repeat (regexp :tag "Regular expression to match spam body"))
+  :group 'spam)
+
+(defcustom spam-regex-body-ham '()
+  "Regular expression for positive body ham matches"
+  :type '(repeat (regexp :tag "Regular expression to match ham body"))
+  :group 'spam)
+
 (defgroup spam-ifile nil
   "Spam ifile configuration."
   :group 'spam)
@@ -341,13 +370,6 @@ spamoracle database."
   "Msx" gnus-summary-mark-as-spam
   "\M-d" gnus-summary-mark-as-spam)
 
-;;; How to highlight a spam summary line.
-
-;; TODO: How do we redo this every time spam-face is customized?
-
-(push '((eq mark gnus-spam-mark) . spam-face)
-      gnus-summary-highlight)
-
 ;; convenience functions
 (defun spam-group-ham-mark-p (group mark &optional spam)
   (when (stringp group)
@@ -478,7 +500,10 @@ spamoracle database."
     (gnus-message 5 "Marking spam as expired without moving it")
     (spam-mark-spam-as-expired-and-move-routine nil)
 
-    (when (spam-group-ham-contents-p gnus-newsgroup-name)
+    (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
+             (and (spam-group-spam-contents-p gnus-newsgroup-name)
+                  spam-process-ham-in-spam-groups)
+             spam-process-ham-in-nonham-groups)
       (when (spam-group-ham-processor-whitelist-p gnus-newsgroup-name)
        (gnus-message 5 "Registering ham with the whitelist")
        (spam-whitelist-register-routine))
@@ -500,8 +525,8 @@ spamoracle database."
 
     (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
       (gnus-message 5 "Copying ham")
-      (spam-ham-move-routine
-       (gnus-parameter-ham-process-destination gnus-newsgroup-name) t))
+      (spam-ham-copy-routine
+       (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
 
     ;; now move all ham articles out of spam groups
     (when (spam-group-spam-contents-p gnus-newsgroup-name)
@@ -523,7 +548,7 @@ spamoracle database."
       (dolist (article articles)
        (gnus-summary-mark-article article gnus-spam-mark)))))
 
-(defun spam-mark-spam-as-expired-and-move-routine (&optional group)
+(defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
   (gnus-summary-kill-process-mark)
   (let ((articles gnus-newsgroup-articles)
        article tomove)
@@ -532,36 +557,55 @@ spamoracle database."
        (gnus-summary-mark-article article gnus-expirable-mark)
        (push article tomove)))
 
-    ;; now do the actual move
-    (when (and tomove
-              (stringp group))
-      (dolist (article tomove)
-       (gnus-summary-set-process-mark article))
-      (when tomove (gnus-summary-move-article nil group))))
+    ;; now do the actual copies
+    (dolist (group groups)
+      (when (and tomove
+                (stringp group))
+       (dolist (article tomove)
+         (gnus-summary-set-process-mark article))
+       (when tomove
+         (gnus-summary-copy-article nil group))))
+
+    ;; now delete the articles
+    (dolist (article tomove)
+      (gnus-summary-set-process-mark article))
+    (when tomove
+      (gnus-summary-delete-article nil)))
+
   (gnus-summary-yank-process-mark))
  
-(defun spam-ham-move-routine (&optional group copy)
+(defun spam-ham-copy-or-move-routine (copy &rest groups)
   (gnus-summary-kill-process-mark)
   (let ((articles gnus-newsgroup-articles)
-       article mark tomove)
-    (when (stringp group)              ; this routine will do nothing
-                                       ; without a valid group
-      (dolist (article articles)
-       (when (spam-group-ham-mark-p gnus-newsgroup-name
-                                    (gnus-summary-article-mark article))
-         (push article tomove)))
+       article mark todo)
+    (dolist (article articles)
+      (when (spam-group-ham-mark-p gnus-newsgroup-name
+                                  (gnus-summary-article-mark article))
+       (push article todo)))
 
-      ;; now do the actual move
-      (when tomove
-       (dolist (article tomove)
+    ;; now do the actual move
+    (dolist (group groups)
+      (when todo
+       (dolist (article todo)
          (when spam-mark-ham-unread-before-move-from-spam-group
-           (gnus-summary-mark-article article gnus-unread-mark))           
+           (gnus-summary-mark-article article gnus-unread-mark))
          (gnus-summary-set-process-mark article))
-       (if copy
-           (gnus-summary-copy-article nil group)
-         (gnus-summary-move-article nil group)))))
+       (gnus-summary-copy-article nil group)))
+  
+    ;; now delete the articles
+    (dolist (article todo)
+      (gnus-summary-set-process-mark article))
+    (when todo
+      (gnus-summary-delete-article nil)))
+  
   (gnus-summary-yank-process-mark))
  
+(defun spam-ham-copy-routine (&rest groups)
+  (spam-ham-copy-or-move-routine t groups))
+(defun spam-ham-move-routine (&rest groups)
+  (spam-ham-copy-or-move-routine nil groups))
 (defun spam-generic-register-routine (spam-func ham-func)
   (let ((articles gnus-newsgroup-articles)
        article mark ham-articles spam-articles)
@@ -637,6 +681,7 @@ spamoracle database."
 (defvar spam-list-of-checks
   '((spam-use-blacklist                .       spam-check-blacklist)
     (spam-use-regex-headers            .       spam-check-regex-headers)
+    (spam-use-regex-body               .       spam-check-regex-body)
     (spam-use-whitelist                .       spam-check-whitelist)
     (spam-use-BBDB                     .       spam-check-BBDB)
     (spam-use-ifile                    .       spam-check-ifile)
@@ -659,10 +704,11 @@ name is the value of `spam-split-group', meaning that the message is
 definitely a spam.")
 
 (defvar spam-list-of-statistical-checks
-  '(spam-use-ifile spam-use-stat spam-use-bogofilter spam-use-spamoracle)
+  '(spam-use-ifile spam-use-regex-body spam-use-stat spam-use-bogofilter spam-use-spamoracle)
 "The spam-list-of-statistical-checks list contains all the mail
 splitters that need to have the full message body available.")
 
+;;;TODO: modify to invoke self with each specific check if invoked without specific checks
 (defun spam-split (&rest specific-checks)
   "Split this message into the `spam' group if it is spam.
 This function can be used as an entry in `nnmail-split-fancy', for
@@ -697,22 +743,31 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (when (symbol-value check)
       (setq nnimap-split-download-body-default t))))
 
+\f
+;;;; Regex body
+
+(defun spam-check-regex-body ()
+  (let ((spam-regex-headers-ham spam-regex-body-ham)
+       (spam-regex-headers-spam spam-regex-body-spam))
+    (spam-check-regex-headers t)))
+
 \f
 ;;;; Regex headers
 
-(defun spam-check-regex-headers ()
-  (let (ret found)
+(defun spam-check-regex-headers (&optional body)
+  (let ((type (if body "body" "header"))
+        ret found)
     (dolist (h-regex spam-regex-headers-ham)
       (unless found
        (goto-char (point-min))
        (when (re-search-forward h-regex nil t)
-         (message "Ham regex header search positive.")
+         (message "Ham regex %s search positive." type)
          (setq found t))))
     (dolist (s-regex spam-regex-headers-spam)
       (unless found
        (goto-char (point-min))
        (when (re-search-forward s-regex nil t)
-         (message "Spam regex header search positive." (match-string 1))
+         (message "Spam regex %s search positive." type)
          (setq found t)
          (setq ret spam-split-group))))
     ret))
@@ -720,9 +775,15 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 \f
 ;;;; Blackholes.
 
+(defun spam-reverse-ip-string (ip)
+  (when (stringp ip)
+    (mapconcat 'identity
+              (nreverse (split-string ip "\\."))
+              ".")))
+
 (defun spam-check-blackholes ()
   "Check the Received headers for blackholed relays."
-  (let ((headers (message-fetch-field "received"))
+  (let ((headers (nnmail-fetch-field "received"))
        ips matches)
     (when headers
       (with-temp-buffer
@@ -730,29 +791,31 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
        (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)
+               "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
          (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
-         (push (mapconcat 'identity
-                          (nreverse (split-string (match-string 1) "\\."))
-                          ".")
+         (push (spam-reverse-ip-string (match-string 1))
                ips)))
       (dolist (server spam-blackhole-servers)
        (dolist (ip ips)
          (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))))))))
+                      ;; match the good-server-regex against the reversed (again) IP string
+                      (string-match 
+                       spam-blackhole-good-server-regex
+                       (spam-reverse-ip-string ip)))
+           (unless matches
+             (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
@@ -804,7 +867,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 
   (defun spam-check-BBDB ()
     "Mail from people in the BBDB is classified as ham or non-spam"
-    (let ((who (message-fetch-field "from")))
+    (let ((who (nnmail-fetch-field "from")))
       (when who
        (setq who (cadr (gnus-extract-address-components who)))
        (if (bbdb-search-simple nil who)
@@ -1005,7 +1068,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
       (nreverse contents))))
 
 (defun spam-from-listed-p (cache)
-  (let ((from (message-fetch-field "from"))
+  (let ((from (nnmail-fetch-field "from"))
        found)
     (while cache
       (let ((address (pop cache)))
@@ -1049,7 +1112,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 \f
 ;;;; Bogofilter
 (defun spam-check-bogofilter-headers (&optional score)
-  (let ((header (message-fetch-field spam-bogofilter-header)))
+  (let ((header (nnmail-fetch-field spam-bogofilter-header)))
     (when header                       ; return nil when no header
       (if score                                ; scoring mode
          (if (string-match "spamicity=\\([0-9.]+\\)" header)
@@ -1179,9 +1242,14 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
 \f
 ;;;; Hooks
 
-(defun spam-install-hooks-function ()
-  "Install the spam.el hooks"
+;;;###autoload
+(defun spam-initialize ()
+  "Install the spam.el hooks and do other initialization"
   (interactive)
+  (setq spam-install-hooks t)
+  ;; TODO: How do we redo this every time spam-face is customized?
+  (push '((eq mark gnus-spam-mark) . spam-face)
+       gnus-summary-highlight)
   ;; Add hooks for loading and saving the spam stats
   (when spam-use-stat
     (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
@@ -1202,7 +1270,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
   (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening))
 
 (when spam-install-hooks
-  (spam-install-hooks-function))
+  (spam-initialize))
 
 (provide 'spam)