Skip to content

John McEleney / mailutils

Go to a project
Toggle navigation
Toggle navigation pinning
Commit 59c262ad 59c262ad3411069e9998d088ba89441a84df2e1a by Sergey Poznyakoff
Options

Use handle-exception where necessary

1 parent f6006384
Inline Side-by-side
Showing 3 changed files with 79 additions and 74 deletions
;;;; 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
......
;;;; 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
......
;;;; 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
......