;;; -*- Scheme -*-

;;; This is a sample rules file for spmr.scm.  Most of these examples
;;; wouldn't make anything useful to you as they are.  The language is
;;; Scheme so anything that is valid in a Scheme program can be
;;; written in here.  This config file path should be ~/.spmr.conf

;;; There are a few expressions you should be aware of:
;;;   - when test body ...
;;;     it's like an if statement without an else (see CLtL)
;;;   - header name
;;;     returns the value associated to that header in the message
;;;   - h~ key regex
;;;     matches mail header key with regular expression regex
;;;   - answer msg
;;;     send an answer to sender quoting original message
;;;   - answer-once db msg
;;;     send an answer to sender quoting original message.  The
;;;     message is sent only once saving the address in db.  Se
;;;     blacklist and blacklisted? functions.
;;;   - answer-mime msg att
;;;     answer sender quoting original and including an attachment
;;;   - forward addr ...
;;;     forward untouched message to a list of addresses
;;;   - save file
;;;     save message to file
;;;   - blacklist db
;;;     save sender address in db for later use
;;;   - blacklisted? db
;;;     check if sender is in db
;;;
;;; There is a bunch of other procedures of less importance.  Have a
;;; look in spmr.scm before starting to write your own.


;; a shortcut
(define (junk)
  (save "junk")
  (exit))

;; This is not properly spam; just people I don't care about
(when (blacklisted? "blacklist")
  (junk))

(define (spam?)
  (or (h~ x-spam-status "yes")
      (h~ x-spam-flag "yes")
      (zero? (forward-to-program "/usr/local/bin/bmf"))))

(when (spam?)
  (save "spam")
  (exit))

;; This is to automatically inform that they should use another
;; address
(when (h~ to "my@old.address.org")
      (answer-once "old-address.bounces"
		   "This is an automatically generated message to
inform you that this address is invalid or has
been discontinued."))

;; Sometime I lend the mail address to friends
(when (h~ to "my.friend@my-domain")
      (forward "my.friend@somewhere.else.com")
      (exit))

;; Document server via e-mail (Majordomo style)
(when (h~ to "retrieve@my.domain")
      ;; this needs mpack
      (answer-mime "Herewith is a copy of the document you requested."
		   (string-append "~/doc/pub/" (header subject)))
      (save "doc-requests")
      (exit))

;; Store messages from a mailing list to a file for later reading
(when (h~ sender "that-mailing-list")
      (save "mailing_lists")
      (exit))

;; see below
(define (bad-attachment what)
  (answer (format #f "
This is an automatically generated message.

Your message ~A addressed to

  ~A

happened to contain a ~A.
As such it has been deleted and not put forward for any further
processing or delivery.  I am sorry for the inconvenience this might
have caused.  To avoid incurring again in this problem please avoid
using proprietary or non-standard attachments.

This filtering service has been set up in the effort to cut down on
diffusion of potentially dangerous contents (viruses), waste of
bandwidth, and the attempt to enforce an ethical use of the
Internet.

If you believe this action has been taken by mistake, please contact
the administrator of this domain and report the problem.
Don not try to resend the original message as this can only worsen the
waste of bandwidth." (header message-id) (header to) what))
  (junk))

;; educate MS-brainwashed people
(for-each-mime-part
 (lambda (encoding file)
   (cond ((regexp-search? (rx bos (| (: "video/" (| "x-ms" "ms"))
				     (: "application/" (| "vnd.ms" "x-ms" "ms")))) encoding)
	  (bad-attachment (format #f "banned attachment (~a)" encoding)))
	 ((and (regexp-search? (rx bos "application/octet-stream") encoding)
	       (regexp-search? (rx (| ".pps" ".xls" ".doc" ".exe" ".com") eos) file))
	  (bad-attachment (format #f "virus (M$-BlödeKuh)"))))))