summaryrefslogtreecommitdiff
path: root/guimb/scm
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2006-04-21 22:03:28 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2006-04-21 22:03:28 +0000
commit59c262ad3411069e9998d088ba89441a84df2e1a (patch)
treebfde6b538d1a01f50f8196bedbeb57e5c9689011 /guimb/scm
parentf6006384efb56b029b942512f81c1734df386f8e (diff)
downloadmailutils-59c262ad3411069e9998d088ba89441a84df2e1a.tar.gz
mailutils-59c262ad3411069e9998d088ba89441a84df2e1a.tar.bz2
Use handle-exception where necessary
Diffstat (limited to 'guimb/scm')
-rw-r--r--guimb/scm/redirect.scm26
-rw-r--r--guimb/scm/reject.scm124
-rw-r--r--guimb/scm/vacation.scm3
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

Return to:

Send suggestions and report system problems to the System administrator.