smecontribs/smeserver-mailsorting
7
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

* Sat Oct 11 2025 Brian Read <brianr@koozali.org> 11.0.0-5.sme

Browse Source 
- Add Dovecot Sieve generation and application [SME: 13232]
This commit is contained in:
Brian Read
2025-10-20 16:31:41 +01:00
parent 1f26e43d09
commit 61ec02df1f
25 changed files with 1228 additions and 188 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
root/etc/e-smith/events/actions/mailsorting-update-user
View File

@@ -63,7 +63,7 @@ foreach my $userName (@users)
next;
}
for my $dotfile ( qw(.procmailrc .mailfilter) )
for my $dotfile ( qw(.procmailrc .mailfilter .sievefilter) )
{
my $pathtohome = ($userName eq 'admin')? "/home/e-smith":"/home/e-smith/files/users/$userName";
@@ -87,4 +87,4 @@ foreach my $userName (@users)
};
}
exit (0);
exit (0);

122
root/etc/e-smith/templates-user/.mailfilter/40global
View File

@@ -2,45 +2,48 @@
use esmith::config;
use esmith::db;
use constant REGEX_DELIM => '/';
sub quote_regex {
my ($pattern) = @_;
my $delim = REGEX_DELIM;
# Escape delimiter characters inside pattern
$pattern =~ s/\Q$delim\E/\\$delim/g;
return $delim . $pattern . $delim;
}
my %conf;
tie %conf, 'esmith::config';
my %accounts;
tie %accounts, 'esmith::config', '/home/e-smith/db/accounts';
die "Username missing." unless defined ($USERNAME);
die "Username missing." unless defined($USERNAME);
my $type = db_get_type(\%accounts, $USERNAME);
die
"Account $USERNAME is not a user account; "
. "update email forwarding failed.\n"
unless $type eq 'user' || $USERNAME eq 'admin';
unless $type eq 'user' || $USERNAME eq 'admin';
my %processmail;
tie %processmail, 'esmith::config', '/home/e-smith/db/processmail';
# the syntax of imap folder names keeps changing
my $sep = '.';
#get Global rules
my @pmGlobRules = ();
foreach (sort keys %processmail)
{
push (@pmGlobRules, $_)
foreach (sort keys %processmail) {
push(@pmGlobRules, $_)
if (db_get_type(\%processmail, $_) eq 'pmGlobalRule');
}
#if they have rules add them to the templete
my $pmGlobRules = @pmGlobRules || '0';
if ($pmGlobRules > 0)
{
if ($pmGlobRules > 0) {
$OUT .= "\n";
$OUT .= "# ----start of Global rules--------\n";
my $pmGlobRule;
foreach $pmGlobRule (sort {$a <=> $b} @pmGlobRules)
{
foreach my $pmGlobRule (sort { $a <=> $b } @pmGlobRules) {
my $basis = db_get_prop(\%processmail, $pmGlobRule, "basis") || '';
my $criterion = db_get_prop(\%processmail, $pmGlobRule, "criterion") || '';
my $basis2 = db_get_prop(\%processmail, $pmGlobRule, "basis2") || '';
@@ -52,113 +55,86 @@
my $action = db_get_prop(\%processmail, $pmGlobRule, "action") || '';
my $action2 = db_get_prop(\%processmail, $pmGlobRule, "action2") || '';
## headers include the basis in the criterion
if ($basis eq 'headers')
{
if ($basis eq 'headers') {
$basis = $criterion;
$criterion = '';
}
if ($basis2 eq 'headers')
{
if ($basis2 eq 'headers') {
$basis2 = $criterion2;
$criterion2 = '';
}
## convert to procmail 'TO_' macro equivalent ??
foreach ($basis, $basis2)
{
if ($_ eq 'TO_')
{
#$_ = '((Original-)?(Resent-)?(To|Cc|Bcc)|(X-Envelope|Apparently(-Resent)?)-To)';
foreach ($basis, $basis2) {
if ($_ eq 'TO_') {
$_ = '(To|Cc)';
}
}
## construct the deliver line
if ($action eq 'sort')
{
# to a folder
$deliver1 = "to \"Maildir/"."$sep"."$deliver"."/\"";
my $deliver1 = '';
if ($action eq 'sort') {
$deliver1 = "to \"Maildir/" . "$sep" . "$deliver" . "/\"";
}
elsif ($action eq 'forward')
{
# to an email
$deliver1 = "to "."\"!$deliver\"";
elsif ($action eq 'forward') {
$deliver1 = "to " . "\"!$deliver\"";
}
elsif ($action eq 'delete')
{
# delete it, report, and add a blank line
elsif ($action eq 'delete') {
$deliver1 = "log \" --deleted --\" \n log \"\" \n exit";
#$deliver1 = "log \"--- deleted --\" \n log \"From: $From \" \n log \"Subject: $Subject \" \n log \"\" \n exit";
}
else
{
# freeform
else {
$deliver1 = "$deliver";
}
## construct the 2nd deliver line
if ($action2 eq 'sort')
{
# to a folder
$deliver2 = "\"Maildir/"."$sep"."$deliver2"."/\"";
my $deliver2 = '';
if ($action2 eq 'sort') {
$deliver2 = "\"Maildir/" . "$sep" . "$deliver2" . "/\"";
}
elsif ($action2 eq 'forward')
{
# to an email
elsif ($action2 eq 'forward') {
$deliver2 = "\"!$deliver2\"";
}
$OUT .= "\n";
if ($secondtest eq '')
{
if ($basis =~ /(>|<)/)
{
if ($secondtest eq '') {
if ($basis =~ /(>|<)/) {
$OUT .= "if ( \$SIZE $basis $criterion )\n";
}
else
{
$OUT .= "if ( /^"."$basis".".*$criterion/ )\n";
else {
my $regex = quote_regex("^$basis.*$criterion");
$OUT .= "if ( $regex )\n";
}
$OUT .= "\{\n";
$OUT .= "log \"--------- match user rule -- \"\n";
$OUT .= "log \"--------- $basis $criterion -- \"\n";
}
#basis2 can't test on size
else
{
if ($basis =~ /(>|<)/)
{
$OUT .= "if (( \$SIZE $basis $criterion ) && ( /^"."$basis2".".*$criterion2/ ))\n";
else {
if ($basis =~ /(>|<)/) {
$OUT .= "if (( \$SIZE $basis $criterion ) && ( /^" . "$basis2" . ".*$criterion2/ ))\n";
}
else
{
$OUT .= "if (( /^"."$basis".".*$criterion/) && (/^"."$basis2".".*$criterion2/ ))\n";
else {
my $regex1 = quote_regex("^$basis.*$criterion");
my $regex2 = quote_regex("^$basis2.*$criterion2");
$OUT .= "if (( $regex1 ) && ( $regex2 ))\n";
}
$OUT .= "\{\n";
$OUT .= "log \"--- match user rule ------------- \"\n";
$OUT .= "log \"--- $basis $criterion & $basis2 $criterion2 -- \"\n";
}
if ($copy eq 'no')
{
if ($copy eq 'no') {
$OUT .= "$deliver1\n";
$OUT .= "\}\n";
}
elsif ($copy eq 'yes' && $action2 eq 'inbox')
{
elsif ($copy eq 'yes' && $action2 eq 'inbox') {
$OUT .= "cc Maildir\n";
$OUT .= "$deliver1\n";
$OUT .= "\}\n";
}
else
{
else {
$OUT .= "cc $deliver2\n";
$OUT .= "$deliver1\n";
$OUT .= "\}\n";
}
}#foreach rule
}#if rules exist
}
}
}
}

5
root/etc/e-smith/templates-user/.mailfilter/60user
View File

@@ -111,6 +111,8 @@
}
$OUT .= "\n";
$OUT .= "# User rule $pmRule\n";
if ($secondtest eq '')
{
if ($basis =~ /(>|<)/)
@@ -159,6 +161,7 @@
$OUT .= "$deliver1\n";
$OUT .= "\}\n";
}
$OUT .= "# End of User rule $pmRule\n";
}#foreach rule
}#if rules exist
}
}

6
root/etc/e-smith/templates-user/.procmailrc/60user
View File

@@ -132,6 +132,9 @@
$secondtest = "* "."$basis2"."$criterion2"."\n";
}
$OUT .= "\n";
$OUT .= "# User rule $pmRule";
if ($copy eq 'no')
{
$OUT .= "\n";
@@ -162,6 +165,7 @@
$OUT .= " $deliver2\n";
$OUT .= "\}\n";
}
$OUT .= "# End of User rule $pmRule\n";
}#foreach rule
}#if rules exist
}
}

19
root/etc/e-smith/templates-user/.qmail/50Filter
View File

@@ -18,15 +18,12 @@
if ($EmailForward eq 'forward');
}
if ($qmail{FilterType})
{
return '| /usr/bin/procmail ~/.procmailrc ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;'
if ($qmail{FilterType} eq 'procmail');
return '| /usr/bin/maildrop ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;'
if ($qmail{FilterType} eq 'maildrop' );
}
return '# Procmail/Maildrop disabled for all users'
}
if ($qmail{FilterType})
{
return '| /usr/bin/procmail ~/.procmailrc ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;' if ($qmail{FilterType} eq 'procmail');
return '| /usr/bin/maildrop ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;' if ($qmail{FilterType} eq 'maildrop');
return '| /var/qmail/bin/preline -f /usr/libexec/dovecot/dovecot-lda -a "$RECIPIENT" -d "$USER" ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;' if ($qmail{FilterType} eq 'sieve');
}
return '# Procmail/Maildrop/sieve disabled for all users'
}
}

19
root/etc/e-smith/templates-user/.qmail/76Filter
View File

@@ -22,15 +22,12 @@
if ($EmailForward eq 'forward');
}
if ($qmail{FilterType})
{
return '| /usr/bin/procmail ~/.procmailrc ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;'
if ($qmail{FilterType} eq 'procmail');
return '| /usr/bin/maildrop ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;'
if ($qmail{FilterType} eq 'maildrop' );
}
return '# Procmail/Maildrop disabled for all users'
if ($qmail{FilterType})
{
return '| /usr/bin/procmail ~/.procmailrc ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;' if ($qmail{FilterType} eq 'procmail');
return '| /usr/bin/maildrop ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;' if ($qmail{FilterType} eq 'maildrop');
return '| /var/qmail/bin/preline -f /usr/libexec/dovecot/dovecot-lda -a "$RECIPIENT" -d "$USER" ; if [ $? -ne 0 ] ; then exit -1; else exit 99; fi;' if ($qmail{FilterType} eq 'sieve');
}
return '# Procmail/Maildrop/Sieve disabled for all users'
}
}
}

22
root/etc/e-smith/templates-user/.sievefilter/00setup Normal file
View File

@@ -0,0 +1,22 @@
{
# vim: ft=perl:
use esmith::AccountsDB;
use esmith::ConfigDB;
our $adb = esmith::AccountsDB->open_ro or die "Couldn't open AccountsDB";
our $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB";
$user = $adb->get($USERNAME) or die "No user $USERNAME in AccountsDB";
%props = $user->props;
our $sievesupport = $cdb->get_prop('sieve','status') || 'disabled';
our $sieveuser = $props{Sieve} || 'enabled';
our $zarafa1 = $props{zarafa} || 'disabled1';
our $zarafa2 = ${'zarafa-server'}{GlobalForward} || 'disabled2';
our $EmailForward = $props{EmailForward} || '';
our $ForwardAddress = $props{ForwardAddress} || '';
$OUT = '';
}

6
root/etc/e-smith/templates-user/.sievefilter/10header Normal file
View File

@@ -0,0 +1,6 @@
{
$OUT .= "# ---- Dovecot Sieve: Defaults and requirements --------\n";
$OUT .= "# Generated for user: $USERNAME\n";
$OUT .= "# Sieve support (system): $sievesupport, Sieve (user): $sieveuser\n";
$OUT .= "require [\"fileinto\", \"copy\", \"regex\", \"relational\", \"comparator-i;ascii-numeric\", \"duplicate\", \"envelope\", \"mime\"];\n";
}

28
root/etc/e-smith/templates-user/.sievefilter/15log Normal file
View File

@@ -0,0 +1,28 @@
{
use esmith::config;
use esmith::db;
my %processmail;
tie %processmail, 'esmith::config', '/home/e-smith/db/processmail';
$OUT = '';
# control level of logging (comments only; Sieve has no direct logging)
my $loglevel = db_get_prop(\%processmail, $USERNAME, "loglevel") || 'some';
if ($loglevel eq 'none')
{
$OUT .= "\n";
$OUT .= "# ---- logging: none ------------------\n";
}
elsif ($loglevel eq 'some')
{
$OUT .= "\n";
$OUT .= "# ---- logging: some ------------------\n";
}
else
{
$OUT .= "\n";
$OUT .= "# ---- logging: verbose (debug) --------------\n";
}
}

9
root/etc/e-smith/templates-user/.sievefilter/25options Normal file
View File

@@ -0,0 +1,9 @@
{
$OUT .= "\n";
$OUT .= "# ---- delete duplicates (by Message-ID) -------\n";
$OUT .= "if duplicate {\n";
$OUT .= " discard;\n";
$OUT .= " stop;\n";
$OUT .= "}\n";
}

236
root/etc/e-smith/templates-user/.sievefilter/40global Normal file
View File

@@ -0,0 +1,236 @@
{
use esmith::config;
use esmith::db;
my %processmail;
tie %processmail, 'esmith::config', '/home/e-smith/db/processmail';
#get Global rules
my @pmGlobRules = ();
foreach (sort keys %processmail)
{
push (@pmGlobRules, $_)
if (db_get_type(\%processmail, $_) eq 'pmGlobalRule');
}
#if they have rules add them to the templete
my $pmGlobRules = @pmGlobRules || '0';
if ($pmGlobRules > 0)
{
$OUT .= "\n";
$OUT .= "# --- start of Global Sieve rules ---------\n";
my $pmGlobRule;
foreach $pmGlobRule (sort {$a <=> $b} @pmGlobRules)
{
my $basis = db_get_prop(\%processmail, $pmGlobRule, "basis") || '';
my $criterion = db_get_prop(\%processmail, $pmGlobRule, "criterion") || '';
my $basis2 = db_get_prop(\%processmail, $pmGlobRule, "basis2") || '';
my $secondtest = db_get_prop(\%processmail, $pmGlobRule, "basis2") || '';
my $criterion2 = db_get_prop(\%processmail, $pmGlobRule, "criterion2") || '';
my $deliver = db_get_prop(\%processmail, $pmGlobRule, "deliver") || '';
my $deliver2 = db_get_prop(\%processmail, $pmGlobRule, "deliver2") || '';
my $copy = db_get_prop(\%processmail, $pmGlobRule, "copy") || '';
my $action = db_get_prop(\%processmail, $pmGlobRule, "action") || '';
my $action2 = db_get_prop(\%processmail, $pmGlobRule, "action2") || '';
# prepare/escape criteria for Sieve strings
my $crit1 = $criterion; $crit1 =~ s/\\/\\\\/g; $crit1 =~ s/"/\\"/g;
my $crit2 = $criterion2; $crit2 =~ s/\\/\\\\/g; $crit2 =~ s/"/\\"/g;
# build condition 1
my $cond1 = '';
if ($basis eq '<' || $basis eq '>')
{
my $num = $criterion; $num =~ s/\s+//g;
$cond1 = ($basis eq '<') ? "size :under $num" : "size :over $num";
}
elsif ($basis eq 'TO_')
{
$cond1 = "anyof (address :all :contains [\"to\",\"cc\",\"bcc\"] \"$crit1\")";
}
elsif ($basis eq 'headers')
{
my $h = $criterion;
if ($h =~ /^\s*\^?([A-Za-z0-9\-]+)\s*:\s*(.*)$/s)
{
my $hn = $1; my $hv = $2; $hv =~ s/\\/\\\\/g; $hv =~ s/"/\\"/g;
$cond1 = "header :regex \"$hn\" \"$hv\"";
}
else
{
$cond1 = "anyof (header :regex \"Subject\" \"$crit1\", address :all :regex [\"from\",\"to\",\"cc\"] \"$crit1\")";
}
}
else
{
my %addr = map { $_ => 1 } qw(From To Cc Bcc Sender Reply-To Resent-From Resent-To Resent-Cc);
if ($addr{$basis})
{
my $lb = lc $basis;
$cond1 = "address :all :contains \"$lb\" \"$crit1\"";
}
else
{
$cond1 = "header :contains \"$basis\" \"$crit1\"";
}
}
# build condition 2 if present
my $cond2 = '';
if ($secondtest ne '')
{
if ($basis2 eq '<' || $basis2 eq '>')
{
my $num2 = $criterion2; $num2 =~ s/\s+//g;
$cond2 = ($basis2 eq '<') ? "size :under $num2" : "size :over $num2";
}
elsif ($basis2 eq 'TO_')
{
$cond2 = "anyof (address :all :contains [\"to\",\"cc\",\"bcc\"] \"$crit2\")";
}
elsif ($basis2 eq 'headers')
{
my $hh = $criterion2;
if ($hh =~ /^\s*\^?([A-Za-z0-9\-]+)\s*:\s*(.*)$/s)
{
my $hn2 = $1; my $hv2 = $2; $hv2 =~ s/\\/\\\\/g; $hv2 =~ s/"/\\"/g;
$cond2 = "header :regex \"$hn2\" \"$hv2\"";
}
else
{
$cond2 = "anyof (header :regex \"Subject\" \"$crit2\", address :all :regex [\"from\",\"to\",\"cc\"] \"$crit2\")";
}
}
else
{
my %addr2 = map { $_ => 1 } qw(From To Cc Bcc Sender Reply-To Resent-From Resent-To Resent-Cc);
if ($addr2{$basis2})
{
my $lb2 = lc $basis2;
$cond2 = "address :all :contains \"$lb2\" \"$crit2\"";
}
else
{
$cond2 = "header :contains \"$basis2\" \"$crit2\"";
}
}
}
# mailbox names for sort/create
my $mb1 = $deliver; $mb1 =~ s/"/\\"/g;
my $mb2 = $deliver2; $mb2 =~ s/"/\\"/g;
my $mbox1 = ($mb1 eq 'junkmail') ? "INBOX.Junk" : "INBOX.$mb1";
my $mbox2 = ($mb2 eq 'junkmail') ? "INBOX.Junk" : "INBOX.$mb2";
# begin rule
$OUT .= "\n";
$OUT .= "# Global rule $pmGlobRule\n";
if ($cond2 ne '')
{
$OUT .= "if allof ($cond1, $cond2) \{\n";
}
else
{
$OUT .= "if $cond1 \{\n";
}
# actions
if ($copy eq 'no')
{
if ($action eq 'sort' || $action eq 'create')
{
$OUT .= " fileinto \"$mbox1\";\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'forward')
{
my $addr = $deliver; $addr =~ s/"/\\"/g;
$OUT .= " redirect \"$addr\";\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'delete')
{
$OUT .= " discard;\n";
$OUT .= " stop;\n";
}
else
{
$OUT .= " # unsupported action \"$action\"; keeping in INBOX\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
}
elsif ($copy eq 'yes' && $action2 eq 'inbox')
{
if ($action eq 'sort' || $action eq 'create')
{
$OUT .= " fileinto :copy \"$mbox1\";\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'forward')
{
my $addr = $deliver; $addr =~ s/"/\\"/g;
$OUT .= " redirect :copy \"$addr\";\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'delete')
{
$OUT .= " discard;\n";
$OUT .= " stop;\n";
}
else
{
$OUT .= " # unsupported action \"$action\"; keeping in INBOX\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
}
else
{
# two deliveries (copy + second action)
if ($action eq 'sort' || $action eq 'create')
{
$OUT .= " fileinto :copy \"$mbox1\";\n";
}
elsif ($action eq 'forward')
{
my $addr = $deliver; $addr =~ s/"/\\"/g;
$OUT .= " redirect :copy \"$addr\";\n";
}
elsif ($action eq 'delete')
{
$OUT .= " discard;\n";
}
else
{
$OUT .= " # unsupported primary action \"$action\"\n";
}
if ($action2 eq 'sort')
{
$OUT .= " fileinto \"$mbox2\";\n";
}
elsif ($action2 eq 'forward')
{
my $addr2 = $deliver2; $addr2 =~ s/"/\\"/g;
$OUT .= " redirect \"$addr2\";\n";
}
elsif ($action2 eq 'inbox')
{
$OUT .= " keep;\n";
}
else
{
$OUT .= " # unsupported secondary action \"$action2\"\n";
}
$OUT .= " stop;\n";
}
$OUT .= "\}\n";
}#foreach rule
}#if rules exist
}

436
root/etc/e-smith/templates-user/.sievefilter/60user Normal file
View File

@@ -0,0 +1,436 @@
{
use esmith::config;
use esmith::db;
# Quote for Sieve string literals (escape " and \ for Sieve)
sub sieve_quote {
my ($s) = @_;
$s //= '';
$s =~ s/\\/\\\\/g; # backslash -> double backslash
$s =~ s/"/\\"/g; # quote -> escaped quote
return $s;
}
# Prepare a regex pattern for embedding in a Sieve string (legacy fallback)
sub sieve_regex_quote_basic {
my ($s) = @_;
$s //= '';
$s =~ s/([\[\]\.])/\\$1/g; # make [ ] . literal in regex
$s =~ s/\\/\\\\/g; # escape backslashes for Sieve string
$s =~ s/"/\\"/g; # escape quotes for Sieve string
return $s;
}
# Pass through a true regex pattern but escape for Sieve string literal.
sub sieve_regex_passthrough {
my ($s) = @_;
$s //= '';
$s =~ s/\\/\\\\/g; # escape backslashes for Sieve string
$s =~ s/"/\\"/g; # escape quotes for Sieve string
return $s;
}
# Normalize DB input for non-regex (contains) tests:
# - remove user-added escapes for many common punctuation
# - strip a leading "Subject.*" (case-insensitive) if present
sub normalize_db_pattern {
my ($s) = @_;
$s //= '';
$s =~ s/\\([\[\]\.\-\(\)\{\}\+\?\^\$\|])/$1/g; # unescape common punctuation
$s =~ s/^\s*subject\s*\.\*\s*//i; # drop leading Subject.*
$s =~ s/^\s+|\s+$//g; # trim
return $s;
}
# Simplify an email-like pattern to a plain substring for address tests.
# Example: ".*user@domain\.tld" -> "user@domain.tld".
sub simplify_email_value {
my ($s) = @_;
$s //= '';
$s =~ s/^\s+|\s+$//g;
return '' if $s eq '';
$s =~ s/\.\*//g; # remove wildcard segments
# unescape common punctuation including @
$s =~ s/\\([@\[\]\.\-\(\)\{\}\+\?\^\$\|])/$1/g;
$s =~ s/^\s+|\s+$//g;
return $s;
}
# Extract a domain from a simplified email-like string.
# Returns '' if no clear domain found.
sub extract_domain {
my ($s) = @_;
$s //= '';
$s =~ s/^\s+|\s+$//g;
return '' if $s eq '';
if ($s =~ /@([^@\s<>"',;]+)/) {
my $d = $1;
$d =~ s/^[<"]+|[>"]+$//g;
$d =~ s/[,"';].*$//;
return lc $d;
}
# bare domain case (no @)
if ($s =~ /^[A-Za-z0-9](?:[A-Za-z0-9\.\-]*[A-Za-z0-9])?\.[A-Za-z0-9\-]{2,}$/) {
return lc $s;
}
return '';
}
# Build a robust Subject contains test:
# - raw header :contains "Subject" original
# - MIME-decoded header :mime :contains "Subject" underscore->space variant
sub build_subject_contains_anyof {
my ($p) = @_;
my $p_us2sp = $p; $p_us2sp =~ s/_/ /g;
return "anyof (header :contains \"Subject\" \"$p\", header :mime :contains \"Subject\" \"$p_us2sp\")";
}
# Build Subject+addresses fallback anyof clause
sub build_subject_addr_contains_anyof {
my ($p) = @_;
my $p_us2sp = $p; $p_us2sp =~ s/_/ /g;
return "anyof (header :contains \"Subject\" \"$p\", header :mime :contains \"Subject\" \"$p_us2sp\", address :all :contains [\"from\",\"to\",\"cc\"] \"$p\")";
}
my %processmail;
tie %processmail, 'esmith::config', '/home/e-smith/db/processmail';
# get users rules
my @pmRules = ();
foreach (sort keys %processmail)
{
push (@pmRules, $_)
if (db_get_type(\%processmail, $_) eq $USERNAME);
}
# if they have rules add them to the template
my $pmRules = @pmRules || '0';
if ($pmRules > 0)
{
$OUT .= "\n";
$OUT .= "# ---- user Sieve rules (".$pmRules.")------------------\n";
my $pmRule;
foreach $pmRule (sort @pmRules)
{
my $basis = db_get_prop(\%processmail, $pmRule, "basis") || '';
my $criterion = db_get_prop(\%processmail, $pmRule, "criterion") || '';
my $basis2 = db_get_prop(\%processmail, $pmRule, "basis2") || '';
my $secondtest = db_get_prop(\%processmail, $pmRule, "basis2") || '';
my $criterion2 = db_get_prop(\%processmail, $pmRule, "criterion2") || '';
my $deliver = db_get_prop(\%processmail, $pmRule, "deliver") || '';
my $deliver2 = db_get_prop(\%processmail, $pmRule, "deliver2") || '';
my $copy = db_get_prop(\%processmail, $pmRule, "copy") || '';
my $action = db_get_prop(\%processmail, $pmRule, "action") || '';
my $action2 = db_get_prop(\%processmail, $pmRule, "action2") || '';
# Normalize DB criteria (for contains/fallback paths)
my $norm1 = normalize_db_pattern($criterion);
my $norm2 = normalize_db_pattern($criterion2);
# Prepare strings for contains tests
my $crit1 = sieve_quote($norm1);
my $crit2 = sieve_quote($norm2);
# build condition 1
my $cond1 = '';
if ($basis eq '<' || $basis eq '>')
{
my $num = $criterion; $num =~ s/\s+//g;
$cond1 = ($basis eq '<') ? "size :under $num" : "size :over $num";
}
elsif ($basis eq 'TO_')
{
$cond1 = "anyof (address :all :contains [\"to\",\"cc\",\"bcc\"] \"$crit1\")";
}
elsif ($basis eq 'headers')
{
# Use raw DB value to preserve regex meta (.*, [], \., etc.) for parsing
my $raw = $criterion // '';
my $h = $raw; $h =~ s/^\s+|\s+$//g;
# Parse "HeaderName(s): value" (accept (From|To):... or \(From\|To\):...)
if ($h =~ /^\s*\^?\s*(.*?)\s*:\s*(.*)$/s)
{
my ($names, $hv) = ($1, $2);
$names =~ s/^\s*(?:\\?\()\s*//; # optional leading ( or \(
$names =~ s/\s*(?:\\?\))\s*$//; # optional trailing ) or \)
$names =~ s/\\\|/|/g; # treat \| as |
my @hn = split /\|/, $names;
@hn = grep { defined $_ && $_ ne '' } @hn;
if (@hn) {
my %addr = map { $_ => 1 } qw(From To Cc Bcc Sender Reply-To Resent-From Resent-To Resent-Cc);
my $all_addr = 1; for my $n (@hn) { $all_addr &&= exists $addr{$n}; }
my $hv_simple = simplify_email_value($hv);
my $hv_domain = extract_domain($hv_simple);
if ($all_addr && $hv_domain ne '') {
my @lb = map { lc $_ } @hn;
my $hn_list = join '","', @lb;
my $dom_q = sieve_quote($hv_domain);
$cond1 = "address :domain :is [\"$hn_list\"] \"$dom_q\"";
} else {
# Fall back to true regex against listed headers
my @hn_q = map { sieve_quote($_) } @hn;
my $hn_list = join '","', @hn_q;
my $hv_re = sieve_regex_passthrough($hv);
$cond1 = "header :regex [\"$hn_list\"] \"$hv_re\"";
}
}
else {
# No valid header names extracted: prefer address match only if email/domain-like
my $hv_simple = simplify_email_value($h);
my $hv_domain = extract_domain($hv_simple);
if ($hv_domain ne '') {
my $dq = sieve_quote($hv_domain);
$cond1 = "address :domain :is [\"from\",\"to\",\"cc\"] \"$dq\"";
} else {
my $p = sieve_quote($norm1);
$cond1 = build_subject_addr_contains_anyof($p);
}
}
}
else
{
# No "Header: value" structure: prefer address match only if email/domain-like
my $hv_simple = simplify_email_value($h);
my $hv_domain = extract_domain($hv_simple);
if ($hv_domain ne '') {
my $dq = sieve_quote($hv_domain);
$cond1 = "address :domain :is [\"from\",\"to\",\"cc\"] \"$dq\"";
} else {
my $p = sieve_quote($norm1);
$cond1 = build_subject_addr_contains_anyof($p);
}
}
}
else
{
# Non-"headers" basis (explicit header names)
if (lc($basis) eq 'subject') {
my $p = $crit1;
$cond1 = build_subject_contains_anyof($p);
} else {
my %addr = map { $_ => 1 } qw(From To Cc Bcc Sender Reply-To Resent-From Resent-To Resent-Cc);
if ($addr{$basis})
{
my $lb = lc $basis;
$cond1 = "address :all :contains \"$lb\" \"$crit1\"";
}
else
{
$cond1 = "header :contains \"$basis\" \"$crit1\"";
}
}
}
# build condition 2 if present
my $cond2 = '';
if ($secondtest ne '')
{
if ($basis2 eq '<' || $basis2 eq '>')
{
my $num2 = $criterion2; $num2 =~ s/\s+//g;
$cond2 = ($basis2 eq '<') ? "size :under $num2" : "size :over $num2";
}
elsif ($basis2 eq 'TO_')
{
$cond2 = "anyof (address :all :contains [\"to\",\"cc\",\"bcc\"] \"$crit2\")";
}
elsif ($basis2 eq 'headers')
{
my $raw2 = $criterion2 // '';
my $hh = $raw2; $hh =~ s/^\s+|\s+$//g;
if ($hh =~ /^\s*\^?\s*(.*?)\s*:\s*(.*)$/s)
{
my ($names2, $hv2) = ($1, $2);
$names2 =~ s/^\s*(?:\\?\()\s*//;
$names2 =~ s/\s*(?:\\?\))\s*$//;
$names2 =~ s/\\\|/|/g;
my @hn2 = split /\|/, $names2;
@hn2 = grep { defined $_ && $_ ne '' } @hn2;
if (@hn2) {
my %addr2 = map { $_ => 1 } qw(From To Cc Bcc Sender Reply-To Resent-From Resent-To Resent-Cc);
my $all_addr2 = 1; for my $n2 (@hn2) { $all_addr2 &&= exists $addr2{$n2}; }
my $hv2_simple = simplify_email_value($hv2);
my $hv2_domain = extract_domain($hv2_simple);
if ($all_addr2 && $hv2_domain ne '') {
my @lb2 = map { lc $_ } @hn2;
my $hn2_list = join '","', @lb2;
my $dq2 = sieve_quote($hv2_domain);
$cond2 = "address :domain :is [\"$hn2_list\"] \"$dq2\"";
} else {
my @hn2_q = map { sieve_quote($_) } @hn2;
my $hn2_list = join '","', @hn2_q;
my $hv2_re = sieve_regex_passthrough($hv2);
$cond2 = "header :regex [\"$hn2_list\"] \"$hv2_re\"";
}
}
else {
# No valid header names: prefer address match only if email/domain-like
my $hv2_simple = simplify_email_value($hh);
my $hv2_domain = extract_domain($hv2_simple);
if ($hv2_domain ne '') {
my $dq2 = sieve_quote($hv2_domain);
$cond2 = "address :domain :is [\"from\",\"to\",\"cc\"] \"$dq2\"";
} else {
my $p2 = sieve_quote($norm2);
$cond2 = build_subject_addr_contains_anyof($p2);
}
}
}
else
{
# No "Header: value" structure: prefer address match only if email/domain-like
my $hv2_simple = simplify_email_value($hh);
my $hv2_domain = extract_domain($hv2_simple);
if ($hv2_domain ne '') {
my $dq2 = sieve_quote($hv2_domain);
$cond2 = "address :domain :is [\"from\",\"to\",\"cc\"] \"$dq2\"";
} else {
my $p2 = sieve_quote($norm2);
$cond2 = build_subject_addr_contains_anyof($p2);
}
}
}
else
{
if (lc($basis2) eq 'subject') {
my $p2 = $crit2;
$cond2 = build_subject_contains_anyof($p2);
} else {
my %addr2 = map { $_ => 1 } qw(From To Cc Bcc Sender Reply-To Resent-From Resent-To Resent-Cc);
if ($addr2{$basis2})
{
my $lb2 = lc $basis2;
$cond2 = "address :all :contains \"$lb2\" \"$crit2\"";
}
else
{
$cond2 = "header :contains \"$basis2\" \"$crit2\"";
}
}
}
}
# mailbox names for sort/create (sanitize: turn "/" into "." to avoid invalid names)
my $mb1 = $deliver; $mb1 =~ s/"/\\"/g; $mb1 =~ s|/|.|g;
my $mb2 = $deliver2; $mb2 =~ s/"/\\"/g; $mb2 =~ s|/|.|g;
my $mbox1 = ($mb1 eq 'junkmail') ? "Junk" : "$mb1";
my $mbox2 = ($mb2 eq 'junkmail') ? "Junk" : "$mb2";
# begin rule
$OUT .= "\n";
$OUT .= "# User rule $pmRule\n";
if ($cond2 ne '')
{
$OUT .= "if allof ($cond1, $cond2) \{\n";
}
else
{
$OUT .= "if $cond1 \{\n";
}
# actions
if ($copy eq 'no')
{
if ($action eq 'sort' || $action eq 'create')
{
$OUT .= " fileinto \"$mbox1\";\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'forward')
{
my $addr = $deliver; $addr =~ s/"/\\"/g;
$OUT .= " redirect \"$addr\";\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'delete')
{
$OUT .= " discard;\n";
$OUT .= " stop;\n";
}
else
{
$OUT .= " # unsupported action \"$action\"; keeping in INBOX\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
}
elsif ($copy eq 'yes' && $action2 eq 'inbox')
{
if ($action eq 'sort' || $action eq 'create')
{
$OUT .= " fileinto :copy \"$mbox1\";\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'forward')
{
my $addr = $deliver; $addr =~ s/"/\\"/g;
$OUT .= " redirect :copy \"$addr\";\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
elsif ($action eq 'delete')
{
$OUT .= " discard;\n";
$OUT .= " stop;\n";
}
else
{
$OUT .= " # unsupported action \"$action\"; keeping in INBOX\n";
$OUT .= " keep;\n";
$OUT .= " stop;\n";
}
}
else
{
# two deliveries (copy + second action)
if ($action eq 'sort' || $action eq 'create')
{
$OUT .= " fileinto :copy \"$mbox1\";\n";
}
elsif ($action eq 'forward')
{
my $addr = $deliver; $addr =~ s/"/\\"/g;
$OUT .= " redirect :copy \"$addr\";\n";
}
elsif ($action eq 'delete')
{
$OUT .= " discard;\n";
}
else
{
$OUT .= " # unsupported primary action \"$action\"\n";
}
if ($action2 eq 'sort')
{
$OUT .= " fileinto \"$mbox2\";\n";
}
elsif ($action2 eq 'forward')
{
my $addr2 = $deliver2; $addr2 =~ s/"/\\"/g;
$OUT .= " redirect \"$addr2\";\n";
}
elsif ($action2 eq 'inbox')
{
$OUT .= " keep;\n";
}
else
{
$OUT .= " # unsupported secondary action \"$action2\"\n";
}
$OUT .= " stop;\n";
}
$OUT .= "\}\n";
$OUT .= "# End of User rule $pmRule\n";
}#foreach rule
}#if rules exist
}

7
root/etc/e-smith/templates-user/.sievefilter/90default Normal file
View File

@@ -0,0 +1,7 @@
{
$OUT .= "\n";
$OUT .= "# ---- to the inbox (implicit keep if no rules matched) ------------------\n";
$OUT .= "keep;\n";
$OUT .= "\n";
$OUT .= "# ---- end of rules ------------------\n";
}

9
root/etc/e-smith/templates/etc/dovecot/dovecot.conf/30SieveName Normal file
View File

@@ -0,0 +1,9 @@
{
$OUT .=<<"END"
plugin {
sieve = file:/home/e-smith/files/users/%u/.sievefilter
}
END
}

9
root/etc/e-smith/templates/etc/dovecot/dovecot.conf/35SieveExtensions Normal file
View File

@@ -0,0 +1,9 @@
{
$OUT .=<<"END"
plugin {
sieve_extensions = +fileinto +copy +regex +mime +body +duplicate
}
END
}