;;; Guile bindings for Mutt
;;; Copyright (C) 2003  Ludovic Courtès

;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;; 
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


(mutt-module (mutt spam)
	     #:documentation
"Spam checking and learning module.

Run a spam filter (typically Bogofilter -- SpamAssassin could make it
but is too slow) on each viewed message and allow the user to teach
it what spam is.")



(define-public spam-check-enabled? #f)

(register-boolean-option!
 "spam-check-enabled?"
 "Tells whether messages should be checked before being displayed.")

(define-public spam-check-command      "bogofilter")
(define-public spam-learn-ham-command  "bogofilter -n")
(define-public spam-learn-spam-command "bogofilter -s")
(define-public spam-checker-positive-exit-value 0)

; Example config for SpamAssassin:
; (define-public spam-check-command "spamassassin -e --local > /dev/null")


(register-option! "spam-check-command" #f #f
		  "Command to pipe messages through when checking spamity.")

(register-option! "spam-learn-ham-command" #f #f
		  "Command to tell the spam filter that an email is non-spam.")

(register-option! "spam-learn-spam-command" #f #f
		  "Command to tell the spam filter that an email is spam.")

(register-integer-option!
 "spam-checker-positive-exit-value"
 "The exit value of the spam filter for messages considered as spam.")


(define (exit-value-means-spam? exit-val)
  "Return true if exit value @var{exit-val} (from Bogofilter) means spam."
  (= spam-checker-positive-exit-value exit-val))
		
(define-public (check-message-spamicity message-filename)
  "Return true if message @var{message} is considered as spam."
  (ui-message "Running spam filter...")
  (let* ((status (pipe-file-through-command
		  message-filename spam-check-command)))
    (if status
	(if (exit-value-means-spam? (status:exit-val status))
	    (and (ui-message "Spam!") #t)
	    (and (ui-message "Not spam.") #f))
	(and (ui-message "SIGPIPE or some such?")
	     #f))))
	
(define-public learn-spam? #f)
(define-public learn-ham?  #t)

(register-boolean-option!
 "learn-spam?"
 "Each time a mail is considered as ham, ask the user whether it
really is ham.")

(register-boolean-option!
 "learn-ham?"
 "Each time a mail is considered as spam, ask the user whether it
really is spam.")

(define-aspect (display-message message)
  "Spam checking and learning aspect."
  (let ((delete-and-skip? #f))
    (if spam-check-enabled?
	(let* ((message-filename (string-append "/tmp/mutt-spam-"
						(cuserid)))
	       (sender-mailbox (address-mailbox (envelope-from
						 (message-envelope
						  message)))))
	  (if (save-message message message-filename #f #f #f)
	      
	      ; Check whether this is spam and learn from confirmations
	      (if (check-message-spamicity message-filename)
		  (if learn-ham?
		      (if (ui-yes-or-no?
			   (format #f
				   "Mail from ~a seems to be spam, confirm?"
				   sender-mailbox)
			   #f)
			  (and
			   (pipe-file-through-command message-filename
						      spam-learn-spam-command)
			   (set! delete-and-skip? #t))
			  (pipe-file-through-command message-filename
						     spam-learn-ham-command)))
		  (if learn-spam?
		      (if (ui-yes-or-no?
			   (format
			    #f
			    "Mail from ~a is NOT considered as spam, confirm?"
			    sender-mailbox)
			   #t)
			  (pipe-file-through-command message-filename
						     spam-learn-ham-command)
			  (pipe-file-through-command message-filename
						     spam-learn-spam-command))))
	      ; `save-message' failed
	      (ui-message (string-append "Unable to save message to "
					 message-filename)))

	  ; Delete the message
	  (false-if-exception (delete-file message-filename))))

    (if delete-and-skip?
	(and (message-delete! message)
	     (execute-function "refresh")
	     #f)  ; Don't launch the pager
	(next-aspect message))))
