Code review time (or dinner time for Kenny): for other poor
souls who have to post via Google groups and cannot obfuscate
their mailbox : (tested and works on SBCL/Win32).
Serves several purposes at once: anti-spam weapon, giving
back to comp.lang.lisp, and demonstration of the usefulness
of the cld (where I found cl-pop) and the extant body of lisp
libraries.
(asdf:oos 'asdf:load-op 'cl-pop)
;; any mail with these things in the headers are not spam
(defparameter *whitelist*
'("Tyneside" "mcclim" "omega" "sbcl" "johnc" "llvm"
"gamasutra" "deaf" "algorithms" "lispbuilder"
"sourceforge" "slashdot" "omega"))
(defun collect-headers ()
;; obviously these are not real and you need
to change them ;-)
(let* ((pop-connection
(cl-pop:open-pop-connection :host "lispoid.morelisp.com"
:username "lambda"
:password "barking79"))
(message-count (cl-pop::message-count pop-connection))
(pop-headers (loop
for message from 0 below message-count
collect (cl-pop:message-headers pop-connection
message))))
(cl-pop:close-pop-connection pop-connection)
pop-headers))
(defun whitelist-keyword-in-header (header)
(loop
for keyword in *whitelist*
thereis (search (string-upcase keyword) (string-upcase
header))))
(defun headers-not-spam-p (headers)
(loop
for header in headers
thereis (whitelist-keyword-in-header (cdr header))))
(defun extract-spam-message-numbers (header-list)
(let ((message-index 0))
(mapcar #'(lambda (headers)
(progn
(format t "Filtering message ~A~&" message-index)
(let ((result
(when headers
(if (not (headers-not-spam-p headers))
message-index
nil))))
(incf message-index)
result)))
header-list)))
(defparameter *my-headers* (collect-headers))
(defparameter *my-spam-list*
(extract-spam-message-numbers *my-headers*))
(defun delete-the-spam (spam-list)
(let ((pop-connection
(cl-pop:open-pop-connection :host "lispoid.morelisp.com"
:username "lambda"
:password "barking79")))
(loop for spam in spam-list
when (numberp spam)
do
(cl-pop:delete-pop-message pop-connection spam))
(cl-pop:close-pop-connection pop-connection)))
(delete-the-spam *my-spam-list*)
--------------------
John Connors
http://badbyteblues.blogspot.com