diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2006-04-21 22:03:28 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2006-04-21 22:03:28 +0000 |
commit | 59c262ad3411069e9998d088ba89441a84df2e1a (patch) | |
tree | bfde6b538d1a01f50f8196bedbeb57e5c9689011 /guimb/scm | |
parent | f6006384efb56b029b942512f81c1734df386f8e (diff) | |
download | mailutils-59c262ad3411069e9998d088ba89441a84df2e1a.tar.gz mailutils-59c262ad3411069e9998d088ba89441a84df2e1a.tar.bz2 |
Use handle-exception where necessary
Diffstat (limited to 'guimb/scm')
-rw-r--r-- | guimb/scm/redirect.scm | 26 | ||||
-rw-r--r-- | guimb/scm/reject.scm | 124 | ||||
-rw-r--r-- | guimb/scm/vacation.scm | 3 |
3 files changed, 79 insertions, 74 deletions
diff --git a/guimb/scm/redirect.scm b/guimb/scm/redirect.scm index f28f677bf..ce804d932 100644 --- a/guimb/scm/redirect.scm +++ b/guimb/scm/redirect.scm @@ -1,5 +1,5 @@ ;;;; GNU Mailutils -- a suite of utilities for electronic mail -;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; GNU Mailutils is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -37,17 +37,19 @@ ;;; redirect action (define (action-redirect address) - (if sieve-my-email - (cond - ((sent-from-me? sieve-current-message) - (runtime-message SIEVE-WARNING "Redirection loop detected")) - (else - (let ((out-msg (mu-message-copy sieve-current-message)) - (sender (mu-message-get-sender sieve-current-message))) - (mu-message-set-header out-msg "X-Sender" sieve-my-email) - (mu-message-send out-msg #f sender address) - (mu-message-destroy out-msg)) - (mu-message-delete sieve-current-message))))) + (sieve-verbose-print "REDIRECT" "to address " address) + (handle-exception + (if sieve-my-email + (cond + ((sent-from-me? sieve-current-message) + (runtime-message SIEVE-WARNING "Redirection loop detected")) + (else + (let ((out-msg (mu-message-copy sieve-current-message)) + (sender (mu-message-get-sender sieve-current-message))) + (mu-message-set-header out-msg "X-Sender" sieve-my-email) + (mu-message-send out-msg #f sender address) + (mu-message-destroy out-msg)) + (mu-message-delete sieve-current-message)))))) ;;; Register action (if sieve-parser diff --git a/guimb/scm/reject.scm b/guimb/scm/reject.scm index bc90a43a4..2e45070a8 100644 --- a/guimb/scm/reject.scm +++ b/guimb/scm/reject.scm @@ -1,5 +1,5 @@ ;;;; GNU Mailutils -- a suite of utilities for electronic mail -;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; GNU Mailutils is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -20,68 +20,70 @@ (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"))) + (sieve-verbose-print "REJECT") + (handle-exception + (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) - (display "The original message was received at " port) - (display datestr port) - (newline port) - (display "from " port) - (display sender port) - (display ".\n" port) + (close-output-port port) + (mu-mime-add-part mime mesg)) - (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 (string-append "Reporting-UA: sieve; GNU " - mu-package-string "\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)) - - (mu-message-send (mu-mime-get-message mime) #f sieve-daemon-email sender) - (mu-message-delete sieve-current-message))) + ;; 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 (string-append "Reporting-UA: sieve; GNU " + mu-package-string "\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)) + + (mu-message-send (mu-mime-get-message mime) #f sieve-daemon-email sender) + (mu-message-delete sieve-current-message)))) ;;; Register action (if sieve-parser diff --git a/guimb/scm/vacation.scm b/guimb/scm/vacation.scm index a66dfc1a8..8fe7ed31c 100644 --- a/guimb/scm/vacation.scm +++ b/guimb/scm/vacation.scm @@ -1,5 +1,5 @@ ;;;; GNU Mailutils -- a suite of utilities for electronic mail -;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc. ;;;; ;;;; GNU Mailutils is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -160,6 +160,7 @@ (mu-message-send mesg #f #f sender))) (define (action-vacation text . opt) + (sieve-verbose-print "VACATION") (set! vacation-debug (member #:debug opt)) (if vacation-debug (begin |