diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2001-08-18 17:32:38 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2001-08-18 17:32:38 +0000 |
commit | 129949c78c0af81d715d32b21f3ee5ad12a7887a (patch) | |
tree | 466afe6668ba35f2fbbb6229c50dadcd8073c32b /guimb/scm | |
parent | 4943e83c209699cbb9e0880a777e66d2ccfef44d (diff) | |
download | mailutils-129949c78c0af81d715d32b21f3ee5ad12a7887a.tar.gz mailutils-129949c78c0af81d715d32b21f3ee5ad12a7887a.tar.bz2 |
New function sieve-message-bounce.
Diffstat (limited to 'guimb/scm')
-rw-r--r-- | guimb/scm/sieve-core.scm | 84 |
1 files changed, 41 insertions, 43 deletions
diff --git a/guimb/scm/sieve-core.scm b/guimb/scm/sieve-core.scm index d1c14fdfe..a5d344074 100644 --- a/guimb/scm/sieve-core.scm +++ b/guimb/scm/sieve-core.scm @@ -17,6 +17,8 @@ ;;;; This module provides core functionality for the sieve scripts. +(define sieve-my-email "") + ;;; List of open mailboxes. ;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX) (define sieve-mailbox-list '()) @@ -48,6 +50,44 @@ sieve-mailbox-list) (set! sieve-mailbox-list '())) +(use-modules (ice-9 popen)) + +(define PATH-SENDMAIL "/usr/lib/sendmail") + +;;; Bounce a message. +;;; Current mailutils API does not provide a way to send a message +;;; specifying its recipients (like "sendmail -t foo@bar.org" does), +;;; hence the need for this function. +(define (sieve-message-bounce message addr-list) + (catch #t + (lambda () + (let ((port (open-output-pipe + (apply string-append + (append + (list + PATH-SENDMAIL + " -oi -t ") + (map + (lambda (addr) + (string-append addr " ")) + addr-list)))))) + ;; Write headers + (for-each + (lambda (hdr) + (display (string-append (car hdr) ": " (cdr hdr)) port) + (newline port)) + (mu-message-get-header-fields message)) + (newline port) + ;; Write body + (let ((body (mu-message-get-body message))) + (do ((line (mu-body-read-line body) (mu-body-read-line body))) + ((eof-object? line) #f) + (display line port))) + (close-output-port port))) + (lambda args + (runtime-error LOG_ERR "redirect: Can't send message") + (write args)))) + ;;; Comparators (cond (sieve-parser @@ -61,47 +101,7 @@ ;;; Basic five actions: -;;; reject - -(define sieve-option-quote #t) -(define sieve-indent-prefix "\t") - -(define (action-reject reason) - (let* ((out-msg (mu-message-create)) - (out-port (mu-message-get-port out-msg "w")) - (in-port (mu-message-get-port sieve-current-message "r"))) - (mu-message-set-header out-msg "To" - (mu-message-get-header sieve-current-message - "From")) - (mu-message-set-header out-msg "Cc" - (mu-message-get-header sieve-current-message "Cc")) - (mu-message-set-header out-msg "Subject" - (string-append - "Re: " - (mu-message-get-header sieve-current-message - "Subject"))) - (display reason out-port) - - (cond - (sieve-option-quote - (display "\n\nThe rejected message follows:\n" out-port) - (do ((hdr (mu-message-get-header-fields sieve-current-message) - (cdr hdr))) - ((null? hdr) #f) - (let ((s (car hdr))) - (display (string-append - sieve-indent-prefix - (car s) ": " (cdr s) "\n") out-port))) - (display sieve-indent-prefix out-port) - (newline out-port) - (do ((line (read-line in-port) (read-line in-port))) - ((eof-object? line) #f) - (display (string-append sieve-indent-prefix line "\n") out-port)))) - (close-input-port in-port) - (close-output-port out-port) - - (mu-message-send out-msg)) - (mu-message-delete sieve-current-message)) +;;; reject is defined in reject.scm ;;; fileinto @@ -129,10 +129,8 @@ (sieve-parser (sieve-register-action "keep" action-keep) (sieve-register-action "discard" action-discard) - (sieve-register-action "reject" action-reject 'string) (sieve-register-action "fileinto" action-fileinto 'string))) - ;;; Some utilities. (define (find-comp opt-args) |