17 |
|
|
18 |
;;;; This module provides core functionality for the sieve scripts. |
;;;; This module provides core functionality for the sieve scripts. |
19 |
|
|
20 |
(define sieve-my-email "") |
;;; The email address for originator of error messages. Should be <> |
21 |
|
;;; but current mailutils API is unable to parse and handle it. |
22 |
|
;;; Site administrators are supposed to replace it with the |
23 |
|
;;; actual value. |
24 |
|
(define sieve-daemon-email "MAILER-DAEMON@localhost") |
25 |
|
|
26 |
|
;;; The email address of the user whose mailbox is being processed. |
27 |
|
;;; If #f, it will be set by sieve-main |
28 |
|
(define sieve-my-email #f) |
29 |
|
|
30 |
;;; List of open mailboxes. |
;;; List of open mailboxes. |
31 |
;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX) |
;;; Each entry is: (list MAILBOX-NAME OPEN-FLAGS MBOX) |
58 |
sieve-mailbox-list) |
sieve-mailbox-list) |
59 |
(set! sieve-mailbox-list '())) |
(set! sieve-mailbox-list '())) |
60 |
|
|
|
(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-pipe port))) |
|
|
(lambda args |
|
|
(runtime-error LOG_ERR "redirect: Can't send message") |
|
|
(write args)))) |
|
|
|
|
61 |
;;; Comparators |
;;; Comparators |
62 |
(cond |
(cond |
63 |
(sieve-parser |
(sieve-parser |
366 |
(let ((count (mu-mailbox-messages-count current-mailbox))) |
(let ((count (mu-mailbox-messages-count current-mailbox))) |
367 |
(do ((n 1 (1+ n))) |
(do ((n 1 (1+ n))) |
368 |
((> n count) #f) |
((> n count) #f) |
|
(display n)(newline) |
|
369 |
(set! sieve-current-message |
(set! sieve-current-message |
370 |
(mu-mailbox-get-message current-mailbox n)) |
(mu-mailbox-get-message current-mailbox n)) |
371 |
(catch 'sieve-stop |
(catch 'sieve-stop |