Implementation of Sieve "reject" action.

+;;;; GNU mailutils - a suite of utilities for electronic mail
+;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;;;;
+;;;; 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, 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.  
+
+;;;; This module provides sieve's "reject" action.
+
+(define sieve-option-quote #t)
+
+(define (action-reject reason)
+  (let ((mime (mu-mime-create 0))
+	(datestr (strftime "%a, %b %d %H:%M:%S %Y %Z"
+			   (localtime (current-time))))
+	(sender (mu-message-get-sender sieve-current-message)))
+    (let* ((mesg (mu-message-create))
+	   (port (mu-message-get-port mesg "w")))
+
+      (display "The original message was received at " port)
+      (display datestr port)
+      (newline port)
+      (display "from " port)
+      (display sender port)
+      (display ".\n" port)
+
+      (display "Message was refused by recipient's mail filtering program.\n"
+	       port)
+      (display "Reason given was as follows:\n" port)
+      (newline port)
+      (display reason port)
+
+      (close-output-port port)
+      (mu-mime-add-part mime mesg))
+
+    ;; message/delivery-status
+    (let* ((mesg (mu-message-create))
+	   (port (mu-message-get-port mesg "w")))
+      (mu-message-set-header mesg "Content-Type" "message/delivery-status")
+
+      (display "Reporting-UA: guimb; GNU Mailutils 0.0.9\n" port)
+      (display (string-append "Arrival-Date: " datestr "\n") port)
+      (newline port)
+      
+      (display (string-append "Final-Recipient: RFC822; " sieve-my-email "\n")
+	       port)
+
+      (display "Action: deleted\n" port);
+      (display "Disposition: automatic-action/MDN-sent-automatically;deleted\n"
+	       port)
+      (display (string-append
+		"Last-Attempt-Date: " datestr "\n") port)
+      
+      (close-output-port port)
+      (mu-mime-add-part mime mesg))
+
+    ;; Quote original message
+    (let* ((mesg (mu-message-create))
+	   (port (mu-message-get-port mesg "w"))
+	   (in-port (mu-message-get-port sieve-current-message "r" #t)))
+      (mu-message-set-header mesg "Content-Type" "message/rfc822")
+
+      (do ((line (read-line in-port) (read-line in-port)))
+	  ((eof-object? line) #f)
+	(display line port)
+	(newline port))
+
+      (close-input-port in-port)
+      (close-output-port port)
+      (mu-mime-add-part mime mesg))
+
+    (let ((mesg (mu-mime-get-message mime)))
+      (sieve-message-bounce mesg (list sender)))))
+
+;;; Register action
+(if sieve-parser
+    (sieve-register-action "reject" action-reject 'string))
+      
+      
+
+      
+