* spam.el (spam-list-of-processors): use nil for nonexistent processors
[gnus] / lisp / spam.el
index 07c3651..4d4c9f0 100644 (file)
@@ -55,7 +55,8 @@
 
 ;; autoload spam-report
 (eval-and-compile
-  (autoload 'spam-report-gmane "spam-report"))
+  (autoload 'spam-report-gmane "spam-report")
+  (autoload 'spam-report-resend "spam-report"))
 
 ;; autoload gnus-registry
 (eval-and-compile
@@ -275,6 +276,11 @@ them."
   :type 'boolean
   :group 'spam)
 
+(defcustom spam-use-crm114 nil
+  "Whether the CRM114 Mailfilter should be used by `spam-split'."
+  :type 'boolean
+  :group 'spam)
+
 (defcustom spam-install-hooks (or
                               spam-use-dig
                               spam-use-gmane-xref
@@ -295,7 +301,8 @@ them."
                               spam-use-BBDB-exclusive
                               spam-use-ifile
                               spam-use-stat
-                              spam-use-spamoracle)
+                              spam-use-spamoracle
+                              spam-use-crm114)
   "Whether the spam hooks should be installed.
 Default to t if one of the spam-use-* variables is set."
   :group 'spam
@@ -576,6 +583,53 @@ order for SpamAssassin to recognize the new registered spam."
   :type 'string
   :group 'spam-spamassassin)
 
+(defgroup spam-crm114 nil
+  "Spam CRM114 Mailfilter configuration."
+  :group 'spam)
+
+(defcustom spam-crm114-program (executable-find "mailfilter.crm")
+  "File path of the CRM114 Mailfilter executable program."
+  :type '(choice (file :tag "Location of CRM114 Mailfilter")
+        (const :tag "CRM114 Mailfilter is not installed"))
+  :group 'spam-crm114)
+
+(defcustom spam-crm114-header "X-CRM114-Status"
+  "The header that CRM114 Mailfilter inserts in messages."
+  :type 'string
+  :group 'spam-crm114)
+
+(defcustom spam-crm114-spam-switch "--learnspam"
+  "The switch that CRM114 Mailfilter uses to register spam messages."
+  :type 'string
+  :group 'spam-crm114)
+
+(defcustom spam-crm114-ham-switch "--learnnonspam"
+  "The switch that CRM114 Mailfilter uses to register ham messages."
+  :type 'string
+  :group 'spam-crm114)
+
+(defcustom spam-crm114-spam-strong-switch "--UNKNOWN"
+  "The switch that CRM114 Mailfilter uses to unregister ham messages."
+  :type 'string
+  :group 'spam-crm114)
+
+(defcustom spam-crm114-ham-strong-switch "--UNKNOWN"
+  "The switch that CRM114 Mailfilter uses to unregister spam messages."
+  :type 'string
+  :group 'spam-crm114)
+
+(defcustom spam-crm114-positive-spam-header "^SPAM"
+  "The regex on `spam-crm114-header' for positive spam identification."
+  :type 'regexp
+  :group 'spam-crm114)
+
+(defcustom spam-crm114-database-directory nil
+  "Directory path of the CRM114 Mailfilter databases."
+  :type '(choice (directory
+         :tag "Location of the CRM114 Mailfilter database directory")
+        (const :tag "Use the default"))
+  :group 'spam-crm114)
+
 ;;; Key bindings for spam control.
 
 (gnus-define-keys gnus-summary-mode-map
@@ -659,13 +713,16 @@ finds ham or spam.")
     nil))
 
 (defvar spam-list-of-processors
-  '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
+  ;; note the nil processors are not defined in gnus.el
+  '((nil spam spam-use-gmane)
+    (nil spam spam-use-resend)
     (gnus-group-spam-exit-processor-bogofilter   spam spam-use-bogofilter)
     (gnus-group-spam-exit-processor-bsfilter    spam spam-use-bsfilter)
     (gnus-group-spam-exit-processor-blacklist    spam spam-use-blacklist)
     (gnus-group-spam-exit-processor-ifile        spam spam-use-ifile)
     (gnus-group-spam-exit-processor-stat         spam spam-use-stat)
     (gnus-group-spam-exit-processor-spamoracle   spam spam-use-spamoracle)
+    (nil spam spam-use-crm114)
     (gnus-group-spam-exit-processor-spamassassin spam spam-use-spamassassin)
     (gnus-group-ham-exit-processor-ifile         ham spam-use-ifile)
     (gnus-group-ham-exit-processor-bogofilter    ham spam-use-bogofilter)
@@ -675,80 +732,55 @@ finds ham or spam.")
     (gnus-group-ham-exit-processor-BBDB          ham spam-use-BBDB)
     (gnus-group-ham-exit-processor-copy          ham spam-use-ham-copy)
     (gnus-group-ham-exit-processor-spamassassin  ham spam-use-spamassassin)
-    (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle))
+    (gnus-group-ham-exit-processor-spamoracle    ham spam-use-spamoracle)
+    (nil ham spam-use-crm114))
   "The `spam-list-of-processors' list.
-This list contains pairs associating a ham/spam exit processor
-variable with a classification and a spam-use-* variable.")
-
-(defun spam-group-processor-p (group processor)
+This list contains pairs associating the obsolete ham/spam exit
+processor variables with a classification and a spam-use-*
+variable.  When the processor variable is nil, just the
+classification and spam-use-* check variable are used.")
+
+(defun spam-group-processor-p (group check &optional classification)
+  "Checks if GROUP has a CHECK with CLASSIFICATION registered.
+Also accepts the obsolete processors, which can be found in
+gnus.el and in spam-list-of-processors."
   (if (and (stringp group)
-          (symbolp processor))
-      (or (member processor (nth 0 (gnus-parameter-spam-process group)))
-         (spam-group-processor-multiple-p
-          group
-          (cdr-safe (assoc processor spam-list-of-processors))))
+          (symbolp check))
+      (let ((old-style (assq check spam-list-of-processors))
+           (parameters (nth 0 (gnus-parameter-spam-process group)))
+           found)
+       (if old-style  ; old-style processor
+           (spam-group-processor-p group (nth 2 old-style) (nth 1 old-style))
+         ;; now search for the parameter
+         (dolist (parameter parameters)
+           (when (and (null found)
+                      (listp parameter)
+                      (eq classification (nth 0 parameter))
+                      (eq check (nth 1 parameter)))
+             (setq found t)))
+         found))
     nil))
 
-(defun spam-group-processor-multiple-p (group processor-info)
-  (let* ((classification (nth 0 processor-info))
-        (check (nth 1 processor-info))
-        (parameters (nth 0 (gnus-parameter-spam-process group)))
-        found)
-    (dolist (parameter parameters)
-      (when (and (null found)
-                (listp parameter)
-                (eq classification (nth 0 parameter))
-                (eq check (nth 1 parameter)))
-       (setq found t)))
-    found))
-
-(defun spam-group-spam-processor-report-gmane-p (group)
-  (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
-
-(defun spam-group-spam-processor-bogofilter-p (group)
-  (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
-
-(defun spam-group-spam-processor-blacklist-p (group)
-  (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
-
-(defun spam-group-spam-processor-ifile-p (group)
-  (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
-
-(defun spam-group-ham-processor-ifile-p (group)
-  (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
-
-(defun spam-group-spam-processor-spamoracle-p (group)
-  (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
-
-(defun spam-group-ham-processor-bogofilter-p (group)
-  (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
-
-(defun spam-group-spam-processor-stat-p (group)
-  (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
-
-(defun spam-group-ham-processor-stat-p (group)
-  (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
-
-(defun spam-group-ham-processor-whitelist-p (group)
-  (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
-
-(defun spam-group-ham-processor-BBDB-p (group)
-  (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
-
-(defun spam-group-ham-processor-copy-p (group)
-  (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
-
-(defun spam-group-ham-processor-spamoracle-p (group)
-  (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
-
 (defun spam-report-articles-gmane (n)
-  "Report the current message as spam.
+  "Report the current message as spam via Gmane.
 Respects the process/prefix convention."
   (interactive "P")
   (dolist (article (gnus-summary-work-articles n))
     (gnus-summary-remove-process-mark article)
     (spam-report-gmane article)))
 
+(defun spam-report-articles-resend (n)
+  "Report the current message as spam by resending it.
+Respects the process/prefix convention.  Also see
+`spam-report-resend-to'."
+  (interactive "P")
+  (let ((spam-report-resend-to 
+        (gnus-parameter-spam-resend-to gnus-newsgroup-name))
+       (articles (gnus-summary-work-articles n)))
+    (spam-report-resend articles)
+    (dolist (article articles)
+      (gnus-summary-remove-process-mark article))))
+
 (defun spam-necessary-extra-headers ()
   "Return the extra headers spam.el thinks are necessary."
   (let (list)
@@ -781,6 +813,9 @@ Respects the process/prefix convention."
        (string-to-number (gnus-replace-in-string
                           (gnus-extra-header header headers)
                           ".*hits=" "")))
+       ;; 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))
        (t nil))
     nil))
 
@@ -807,6 +842,8 @@ Will not return a nil score."
     (spam-spamassassin-score recheck))
    ((or spam-use-bsfilter spam-use-bsfilter-headers)
     (spam-bsfilter-score recheck))
+   (spam-use-crm114
+    (spam-crm114-score))
    (t (spam-bogofilter-score recheck))))
 
 ;;; Summary entry and exit processing.
@@ -856,7 +893,7 @@ Will not return a nil score."
            (classification (nth 1 processor-param))
            (check (nth 2 processor-param)))
        (when (and (eq 'spam classification)
-                  (spam-group-processor-p gnus-newsgroup-name processor))
+                  (spam-group-processor-p gnus-newsgroup-name check classification))
          (spam-register-routine classification check))))
 
     (unless (and spam-move-spam-nonspam-groups-only
@@ -887,10 +924,10 @@ Will not return a nil score."
              (classification (nth 1 processor-param))
              (check (nth 2 processor-param)))
          (when (and (eq 'ham classification)
-                    (spam-group-processor-p gnus-newsgroup-name processor))
+                    (spam-group-processor-p gnus-newsgroup-name check classification))
            (spam-register-routine classification check)))))
 
-    (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
+    (when (spam-group-processor-p gnus-newsgroup-name 'ham 'spam-use-ham-copy)
       (let ((num
             (spam-ham-copy-routine
              (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
@@ -1134,7 +1171,8 @@ When either list is nil, the other is returned."
     (spam-use-bogofilter-headers       .       spam-check-bogofilter-headers)
     (spam-use-bogofilter               .       spam-check-bogofilter)
     (spam-use-bsfilter-headers         .       spam-check-bsfilter-headers)
-    (spam-use-bsfilter                 .       spam-check-bsfilter))
+    (spam-use-bsfilter                 .       spam-check-bsfilter)
+    (spam-use-crm114                   .       spam-check-crm114))
   "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,
@@ -1157,7 +1195,8 @@ definitely a spam.")
     spam-use-bsfilter
     spam-use-blackholes
     spam-use-spamassassin
-    spam-use-spamoracle)
+    spam-use-spamoracle
+    spam-use-crm114)
   "The spam-list-of-statistical-checks list contains all the mail
 splitters that need to have the full message body available.
 Note that you should fetch extra headers if you don't like this,
@@ -1325,12 +1364,16 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
                         spam-stat-register-spam-routine
                         spam-stat-unregister-ham-routine
                         spam-stat-unregister-spam-routine)
-    ;; note that spam-use-gmane is not a legitimate check
+    ;; note that spam-use-gmane and spam-use-resend are not legitimate checks
     (spam-use-gmane      nil
                         spam-report-gmane-register-routine
                         ;; does Gmane support unregistration?
                         nil
                         nil)
+    (spam-use-resend     nil
+                        spam-report-resend-register-routine
+                        nil
+                        nil)
     (spam-use-spamassassin spam-spamassassin-register-ham-routine
                           spam-spamassassin-register-spam-routine
                           spam-spamassassin-unregister-ham-routine
@@ -1342,7 +1385,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
     (spam-use-bsfilter  spam-bsfilter-register-ham-routine
                         spam-bsfilter-register-spam-routine
                         spam-bsfilter-unregister-ham-routine
-                        spam-bsfilter-unregister-spam-routine))
+                        spam-bsfilter-unregister-spam-routine)
+    (spam-use-crm114 spam-crm114-register-ham-routine
+                    spam-crm114-register-spam-routine
+                    ;; does CRM114 Mailfilter support unregistration?
+                    nil
+                    nil))
   "The spam-registration-functions list contains pairs
 associating a parameter variable with the ham and spam
 registration functions, and the ham and spam unregistration
@@ -2058,6 +2106,10 @@ REMOVE not nil, remove the ADDRESSES."
   (when articles
     (apply 'spam-report-gmane articles)))
 
+(defun spam-report-resend-register-routine (articles)
+  (let ((spam-report-resend-to (gnus-parameter-spam-resend-to gnus-newsgroup-name)))
+       (spam-report-resend articles)))
+
 \f
 ;;;; Bogofilter
 (defun spam-check-bogofilter-headers (&optional score)
@@ -2384,6 +2436,89 @@ REMOVE not nil, remove the ADDRESSES."
 (defun spam-bsfilter-unregister-ham-routine (articles)
   (spam-bsfilter-register-ham-routine articles t))
 
+\f
+;;;; CRM114 Mailfilter
+(defun spam-check-crm114-headers (&optional score)
+  (let ((header (message-fetch-field spam-crm114-header))
+       (spam-split-group (if spam-split-symbolic-return
+                             'spam
+                           spam-split-group)))
+    (when header                       ; return nil when no header
+      (if score                                ; scoring mode
+         (if (string-match "( pR: \\([0-9.-]+\\)" header)
+             (match-string 1 header)
+           "0")
+       ;; spam detection mode
+       (when (string-match spam-crm114-positive-spam-header
+                           header)
+         spam-split-group)))))
+
+;; return something sensible if the score can't be determined
+(defun spam-crm114-score ()
+  "Get the CRM114 Mailfilter pR"
+  (interactive)
+  (save-window-excursion
+    (gnus-summary-show-article t)
+    (set-buffer gnus-article-buffer)
+    (let ((score (or (spam-check-crm114-headers t)
+                    (spam-check-crm114 t))))
+      (gnus-summary-show-article)
+      (message "pR: %s" score)
+      (or score "0"))))
+
+(defun spam-check-crm114 (&optional score)
+  "Check the CRM114 Mailfilter backend for the classification of this message"
+  (let ((article-buffer-name (buffer-name))
+       (db spam-crm114-database-directory)
+       return)
+    (with-temp-buffer
+      (let ((temp-buffer-name (buffer-name)))
+       (save-excursion
+         (set-buffer article-buffer-name)
+         (apply 'call-process-region
+                (point-min) (point-max)
+                spam-crm114-program
+                nil temp-buffer-name nil
+                 (when db (list (concat "--fileprefix=" db)))))
+       (setq return (spam-check-crm114-headers score))))
+    return))
+
+(defun spam-crm114-register-with-crm114 (articles
+                                        spam
+                                        &optional unregister)
+  "Register an article, given as a string, as spam or non-spam."
+  (dolist (article articles)
+    (let ((article-string (spam-get-article-as-string article))
+         (db spam-crm114-database-directory)
+         (switch (if unregister
+                     (if spam
+                         spam-crm114-spam-strong-switch
+                       spam-crm114-ham-strong-switch)
+                   (if spam
+                       spam-crm114-spam-switch
+                     spam-crm114-ham-switch))))
+      (when (stringp article-string)
+       (with-temp-buffer
+         (insert article-string)
+
+         (apply 'call-process-region
+                (point-min) (point-max)
+                spam-crm114-program
+                nil nil nil
+                 (when db (list switch (concat "--fileprefix=" db)))))))))
+
+(defun spam-crm114-register-spam-routine (articles &optional unregister)
+  (spam-crm114-register-with-crm114 articles t unregister))
+
+(defun spam-crm114-unregister-spam-routine (articles)
+  (spam-crm114-register-spam-routine articles t))
+
+(defun spam-crm114-register-ham-routine (articles &optional unregister)
+  (spam-crm114-register-with-crm114 articles nil unregister))
+
+(defun spam-crm114-unregister-ham-routine (articles)
+  (spam-crm114-register-ham-routine articles t))
+
 \f
 ;;;; Hooks