From 5d790e6b813c2c2b5408c49a28a927387bf9c201 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Thu, 16 May 2002 11:17:59 +0000 Subject: (sieve-expand-filename): New function. Expands ~ in the given pathname, using geteuid. (action-fileinto): Use sieve-expand-filename. Be more robust in error handling. --- guimb/scm/sieve-core.scm | 40 +++++++++++++++++++++++++++++++++++----- 1 file changed, 35 insertions(+), 5 deletions(-) (limited to 'guimb') diff --git a/guimb/scm/sieve-core.scm b/guimb/scm/sieve-core.scm index 67c849fb2..193558648 100644 --- a/guimb/scm/sieve-core.scm +++ b/guimb/scm/sieve-core.scm @@ -62,6 +62,29 @@ sieve-mailbox-list) (set! sieve-mailbox-list '())) +(define (sieve-expand-filename filename) + (case (string-ref filename 0) + ((#\~) + (let ((pw (mu_getpwuid (geteuid)))) + (if (and (vector? pw) + (let ((dir (vector-ref pw 5))) + (and + (access? dir W_OK) + (eq? (vector-ref (stat (vector-ref pw 5)) 13) 'directory)))) + (string-append (vector-ref pw 5) + (substring filename + 1 (string-length filename))) + #f))) + ((#\/) + filename) + (else + (let ((pw (getpwuid (geteuid)))) + (if (vector? pw) + (string-append (vector-ref pw 5) + "/" + filename) + filename))))) + ;;; Comparators (cond (sieve-parser @@ -80,11 +103,18 @@ ;;; fileinto (define (action-fileinto filename) - (let ((outbox (sieve-mailbox-open filename "cw"))) - (cond - (outbox - (mu-mailbox-append-message outbox sieve-current-message) - (mu-message-delete sieve-current-message))))) + (let ((name (sieve-expand-filename filename))) + (if (string? name) + (let ((outbox (sieve-mailbox-open name "cw"))) + (cond + (outbox + (mu-mailbox-append-message outbox sieve-current-message) + (mu-message-delete sieve-current-message)) + (else + (runtime-message SIEVE-ERROR + "Could not open mailbox " name)))) + (runtime-message SIEVE-ERROR + "Could not expand mailbox name " filename)))) ;;; redirect is defined in redirect.scm -- cgit v1.2.1