/[mailutils]/mailutils/guimb/scm/sieve-core.scm
ViewVC logotype

Diff of /mailutils/guimb/scm/sieve-core.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by gray, Tue Oct 23 22:31:09 2001 UTC revision 1.6 by gray, Fri Dec 28 22:33:55 2001 UTC
# Line 17  Line 17 
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)
# Line 50  Line 58 
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
# Line 396  Line 366 
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

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26