;;;===========================================================================
;;;
;;; spam-killer.lisp
;;;
;;; Eduardo Muņoz
;;; Time-stamp: "Sunday, 31 December 2006 - 14:40:52"
;;; 
;;;===========================================================================
;;;
;;; This code is in the public domain
;;; 
;;;===========================================================================


#+cmu
(require :gray-streams)


(eval-when (:compile-toplevel :execute :load-toplevel)
  (asdf:operate 'asdf:load-op :postoffice)
  (asdf:operate 'asdf:load-op :cl-ppcre))


;; too long to type every time so add a nickname
(rename-package :net.post-office :net.post-office ; hacky?
                (adjoin :pop (package-nicknames :net.post-office)))


(defvar *usual-suspects*
  '(("From" "MS (Corporation|Technical|Customer)")
    ("Subject" "(Microsoft|Network|Security|Net|Critical) (Pack|Patch)")))


;; 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 list-mail (file &key (server (ask-for "Server"))
                  (user (ask-for "User"))
                  (password (ask-for "Password")))
  (let* ((mbox (pop:make-pop-connection server :user user :password password))
         (num (pop:mailbox-message-count mbox)))
    (if (> num 0)
        (with-open-file (o file :direction :output :if-exists :supersede)
          (loop for i from 1 to num do
                (let ((headers (pop:parse-mail-header
                                (pop:top-lines mbox i 0))))
                  (format o "~A~%~A~%~%"
                          (get-header "From" headers)
                          (get-header "Subject" headers)))
                )
          (format t "Stored ~D messages~%" num))
        (format t "No messages~%"))))


(defun spam-kill (&key (server (ask-for "Server"))
                  (user (ask-for "User"))
                  (password (ask-for "Password")))
  (let* ((mbox (pop:make-pop-connection server
                                        :user user
                                        :password password))
         (num (pop: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 (pop:parse-mail-header
                            (pop: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*))
    (pop:close-connection mbox)))


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


(defun delete-message (mbox num headers)
  (pop: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)
  (loop for (header . scanners) in matchers do
        (loop for scanner in scanners do
              (when (cl-ppcre:scan scanner (get-header header headers))
                (return-from match-message 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)))