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
1 ;;;; GNU Mailutils -- a suite of utilities for electronic mail 1 ;;;; GNU Mailutils -- a suite of utilities for electronic mail
2 ;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. 2 ;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
3 ;;;; 3 ;;;;
4 ;;;; GNU Mailutils is free software; you can redistribute it and/or modify 4 ;;;; GNU Mailutils is free software; you can redistribute it and/or modify
5 ;;;; it under the terms of the GNU General Public License as published by 5 ;;;; it under the terms of the GNU General Public License as published by
...@@ -37,17 +37,19 @@ ...@@ -37,17 +37,19 @@
37 37
38 ;;; redirect action 38 ;;; redirect action
39 (define (action-redirect address) 39 (define (action-redirect address)
40 (if sieve-my-email 40 (sieve-verbose-print "REDIRECT" "to address " address)
41 (cond 41 (handle-exception
42 ((sent-from-me? sieve-current-message) 42 (if sieve-my-email
43 (runtime-message SIEVE-WARNING "Redirection loop detected")) 43 (cond
44 (else 44 ((sent-from-me? sieve-current-message)
45 (let ((out-msg (mu-message-copy sieve-current-message)) 45 (runtime-message SIEVE-WARNING "Redirection loop detected"))
46 (sender (mu-message-get-sender sieve-current-message))) 46 (else
47 (mu-message-set-header out-msg "X-Sender" sieve-my-email) 47 (let ((out-msg (mu-message-copy sieve-current-message))
48 (mu-message-send out-msg #f sender address) 48 (sender (mu-message-get-sender sieve-current-message)))
49 (mu-message-destroy out-msg)) 49 (mu-message-set-header out-msg "X-Sender" sieve-my-email)
50 (mu-message-delete sieve-current-message))))) 50 (mu-message-send out-msg #f sender address)
51 (mu-message-destroy out-msg))
52 (mu-message-delete sieve-current-message))))))
51 53
52 ;;; Register action 54 ;;; Register action
53 (if sieve-parser 55 (if sieve-parser
......
1 ;;;; GNU Mailutils -- a suite of utilities for electronic mail 1 ;;;; GNU Mailutils -- a suite of utilities for electronic mail
2 ;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. 2 ;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
3 ;;;; 3 ;;;;
4 ;;;; GNU Mailutils is free software; you can redistribute it and/or modify 4 ;;;; GNU Mailutils is free software; you can redistribute it and/or modify
5 ;;;; it under the terms of the GNU General Public License as published by 5 ;;;; it under the terms of the GNU General Public License as published by
...@@ -20,68 +20,70 @@ ...@@ -20,68 +20,70 @@
20 (define sieve-option-quote #t) 20 (define sieve-option-quote #t)
21 21
22 (define (action-reject reason) 22 (define (action-reject reason)
23 (let ((mime (mu-mime-create 0)) 23 (sieve-verbose-print "REJECT")
24 (datestr (strftime "%a, %b %d %H:%M:%S %Y %Z" 24 (handle-exception
25 (localtime (current-time)))) 25 (let ((mime (mu-mime-create 0))
26 (sender (mu-message-get-sender sieve-current-message))) 26 (datestr (strftime "%a, %b %d %H:%M:%S %Y %Z"
27 (let* ((mesg (mu-message-create)) 27 (localtime (current-time))))
28 (port (mu-message-get-port mesg "w"))) 28 (sender (mu-message-get-sender sieve-current-message)))
29 (let* ((mesg (mu-message-create))
30 (port (mu-message-get-port mesg "w")))
31
32 (display "The original message was received at " port)
33 (display datestr port)
34 (newline port)
35 (display "from " port)
36 (display sender port)
37 (display ".\n" port)
38
39 (display "Message was refused by recipient's mail filtering program.\n"
40 port)
41 (display "Reason given was as follows:\n" port)
42 (newline port)
43 (display reason port)
29 44
30 (display "The original message was received at " port) 45 (close-output-port port)
31 (display datestr port) 46 (mu-mime-add-part mime mesg))
32 (newline port)
33 (display "from " port)
34 (display sender port)
35 (display ".\n" port)
36 47
37 (display "Message was refused by recipient's mail filtering program.\n" 48 ;; message/delivery-status
38 port) 49 (let* ((mesg (mu-message-create))
39 (display "Reason given was as follows:\n" port) 50 (port (mu-message-get-port mesg "w")))
40 (newline port) 51 (mu-message-set-header mesg "Content-Type" "message/delivery-status")
41 (display reason port) 52
42 53 (display (string-append "Reporting-UA: sieve; GNU "
43 (close-output-port port) 54 mu-package-string "\n") port)
44 (mu-mime-add-part mime mesg)) 55 (display (string-append "Arrival-Date: " datestr "\n") port)
45 56 (newline port)
46 ;; message/delivery-status 57
47 (let* ((mesg (mu-message-create)) 58 (display (string-append "Final-Recipient: RFC822; " sieve-my-email "\n")
48 (port (mu-message-get-port mesg "w"))) 59 port)
49 (mu-message-set-header mesg "Content-Type" "message/delivery-status") 60
50 61 (display "Action: deleted\n" port);
51 (display (string-append "Reporting-UA: sieve; GNU " 62 (display "Disposition: automatic-action/MDN-sent-automatically;deleted\n"
52 mu-package-string "\n") port) 63 port)
53 (display (string-append "Arrival-Date: " datestr "\n") port) 64 (display (string-append
54 (newline port) 65 "Last-Attempt-Date: " datestr "\n") port)
55 66
56 (display (string-append "Final-Recipient: RFC822; " sieve-my-email "\n") 67 (close-output-port port)
57 port) 68 (mu-mime-add-part mime mesg))
58 69
59 (display "Action: deleted\n" port); 70 ;; Quote original message
60 (display "Disposition: automatic-action/MDN-sent-automatically;deleted\n" 71 (let* ((mesg (mu-message-create))
61 port) 72 (port (mu-message-get-port mesg "w"))
62 (display (string-append 73 (in-port (mu-message-get-port sieve-current-message "r" #t)))
63 "Last-Attempt-Date: " datestr "\n") port) 74 (mu-message-set-header mesg "Content-Type" "message/rfc822")
64 75
65 (close-output-port port) 76 (do ((line (read-line in-port) (read-line in-port)))
66 (mu-mime-add-part mime mesg)) 77 ((eof-object? line) #f)
67 78 (display line port)
68 ;; Quote original message 79 (newline port))
69 (let* ((mesg (mu-message-create)) 80
70 (port (mu-message-get-port mesg "w")) 81 (close-input-port in-port)
71 (in-port (mu-message-get-port sieve-current-message "r" #t))) 82 (close-output-port port)
72 (mu-message-set-header mesg "Content-Type" "message/rfc822") 83 (mu-mime-add-part mime mesg))
73 84
74 (do ((line (read-line in-port) (read-line in-port))) 85 (mu-message-send (mu-mime-get-message mime) #f sieve-daemon-email sender)
75 ((eof-object? line) #f) 86 (mu-message-delete sieve-current-message))))
76 (display line port)
77 (newline port))
78
79 (close-input-port in-port)
80 (close-output-port port)
81 (mu-mime-add-part mime mesg))
82
83 (mu-message-send (mu-mime-get-message mime) #f sieve-daemon-email sender)
84 (mu-message-delete sieve-current-message)))
85 87
86 ;;; Register action 88 ;;; Register action
87 (if sieve-parser 89 (if sieve-parser
......
1 ;;;; GNU Mailutils -- a suite of utilities for electronic mail 1 ;;;; GNU Mailutils -- a suite of utilities for electronic mail
2 ;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. 2 ;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
3 ;;;; 3 ;;;;
4 ;;;; GNU Mailutils is free software; you can redistribute it and/or modify 4 ;;;; GNU Mailutils is free software; you can redistribute it and/or modify
5 ;;;; it under the terms of the GNU General Public License as published by 5 ;;;; it under the terms of the GNU General Public License as published by
...@@ -160,6 +160,7 @@ ...@@ -160,6 +160,7 @@
160 (mu-message-send mesg #f #f sender))) 160 (mu-message-send mesg #f #f sender)))
161 161
162 (define (action-vacation text . opt) 162 (define (action-vacation text . opt)
163 (sieve-verbose-print "VACATION")
163 (set! vacation-debug (member #:debug opt)) 164 (set! vacation-debug (member #:debug opt))
164 (if vacation-debug 165 (if vacation-debug
165 (begin 166 (begin
......