;;;===========================================================================
;;;
;;; spam-killer.lisp
;;;
;;; Eduardo Muņoz
;;; Time-stamp: "Wednesday, 08 December 2004 - 17:27:43"
;;; 
;;;===========================================================================
;;;
;;; This code is in the public domain
;;; 
;;;===========================================================================

(eval-when (:compile-toplevel :execute :load-toplevel)
  (require :postoffice)
  (require :cl-ppcre))


(use-package :net.post-office) ;; too long to type every time

(defparameter *usual-suspects*
  ;; (?i) -> case insensitive
  '(("From" . "(?i)\(Storage\|Delivery\) \(Service\|System\)")
    ("From" . "MS \(Corporation\|Technical\|Customer\)")
    ("Subject" . "\(Microsoft\|Network\|Security\|Net\|Critical\) \(Pack\|Patch\)")
    ("Subject" . "Security \(Upgrade\|Update\|Departament\)")))

;; spam-rules.lisp pushes more rules into *usual-suspects*
(load (merge-pathnames (make-pathname :name "spam-rules" :type "lisp")
                       *load-truename*))

(defconstant +check-interval+ 7200
  "Interval betwen spam checks. In seconds")

(defun continuous-spam-kill ()
  (let ((server (ask-for "Server"))
        (user (ask-for "User"))
        ;; Take a look at tcsetattr and (run-program "stty .." output t)
        (password (ask-for "Password")))
    (mp:make-process (lambda ()
                       (loop 
                        (spam-kill :server server
                                   :user user
                                   :password password)
                        (sleep +check-interval+)))
                     :name "Spam Killer")))


(defun spam-kill (&key (server (ask-for "Server"))
                  (user (ask-for "User"))
                  (password (ask-for "Password")))
  (handler-case
      (let* ((mbox (make-pop-connection server
                                        :user user
                                        :password password))
             (num (mailbox-message-count mbox))
             (deleted 0))
        (format t "~%;; [~A] Checking ~D messages." (time-string) num)
        (force-output *standard-output*)
        (when (> num 0)
          (format t "~%;; --")
          (loop for i from 1 to num do
                (let ((headers (parse-mail-header (top-lines mbox i 0))))
                  (when (match-message headers *usual-suspects*)
                    (delete-message mbox i headers)
                    (incf deleted))))
          (format t "~%;; [~A] ~D messages deleted.~%"
                  (time-string) deleted)
          (force-output *standard-output*))
        (close-connection mbox))
    (error (e) (format t ";;; ~A~%" e))))


(defun ask-for (thing)
  (format t "~&~A: " thing)
  (force-output *standard-output*)
  (read-line))


(defun delete-message (mbox num headers)
  (delete-letter mbox num)
  (format t "~%;; Deleting message: ~D~%;; Subject: ~A~%;; From: ~A"
          num (get-header "Subject" headers) (get-header "From" headers))
  (format t "~%;; --")
  (force-output *standard-output*))


(defun match-message (headers matchers)
  (dolist (matcher matchers nil)
    (when (cl-ppcre:scan (cdr matcher)
                         (get-header (car matcher) headers))
      (return t))))


(defun get-header (header headers)
  (cdr (assoc header headers :test #'string-equal)))

(defun time-string ()
  (multiple-value-bind (second minute hour day month year)
      (get-decoded-time)
    (format nil
            "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D"
            year month day hour minute second)))