line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mail::FilterXML; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
#(c)2000-2002 Matthew MacKenzie |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
584
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
34
|
|
6
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
45
|
|
7
|
1
|
|
|
1
|
|
1840
|
use Mail::Audit; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use XML::Parser; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
$VERSION = '0.3'; |
11
|
|
|
|
|
|
|
sub new { |
12
|
|
|
|
|
|
|
my $class = shift; |
13
|
|
|
|
|
|
|
my %args = @_; my $self = \%args; |
14
|
|
|
|
|
|
|
bless($self, $class); |
15
|
|
|
|
|
|
|
return $self; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
## NOTE - 0.1 is the initial port of this script from being a script to being a module. |
19
|
|
|
|
|
|
|
## I expect to make it a little bit smarter in future releases. |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Setup the filter structures. Maybe in future versions these could be hidden in the object. |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my @recip_ig = (); |
24
|
|
|
|
|
|
|
my @subj_ig = (); |
25
|
|
|
|
|
|
|
my %to_lists = (); |
26
|
|
|
|
|
|
|
my %from_lists = (); |
27
|
|
|
|
|
|
|
my %conf = (); |
28
|
|
|
|
|
|
|
my %action = (); |
29
|
|
|
|
|
|
|
my %subject_lists = (); |
30
|
|
|
|
|
|
|
my %current_rule = (); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub process { |
33
|
|
|
|
|
|
|
my $self = shift; |
34
|
|
|
|
|
|
|
my $rulesf = $self->{rules_file}; |
35
|
|
|
|
|
|
|
$self->{message} = new Mail::Audit(); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Parse rules from the XML File.. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $xmlp = new XML::Parser(Handlers => {Start => \&Mail::FilterXML::filtFileStartEl }); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
print "Rules file is: $self->{rules}\n"; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
$xmlp->parsefile($self->{rules}); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
print "Parsed the rules\n"; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# Run the filters. |
48
|
|
|
|
|
|
|
$self->cleanup_config(); |
49
|
|
|
|
|
|
|
$self->recipIg(); |
50
|
|
|
|
|
|
|
$self->subjIg(); |
51
|
|
|
|
|
|
|
$self->fromLists(); |
52
|
|
|
|
|
|
|
$self->toLists(); |
53
|
|
|
|
|
|
|
$self->subjectLists(); |
54
|
|
|
|
|
|
|
$self->defaultFilter(); |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub cleanup_config { |
58
|
|
|
|
|
|
|
# If the maildir in not defined then set it to the user's home directory |
59
|
|
|
|
|
|
|
if ( !defined $conf{maildir} ) { |
60
|
|
|
|
|
|
|
$conf{maildir} = "$ENV{HOME}/mail/"; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# make sure that maildir ends in a '/' |
64
|
|
|
|
|
|
|
if ( $conf{maildir} !~ m|/$| ) { |
65
|
|
|
|
|
|
|
$conf{maildir} .= "/"; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
# make sure we have a sane logfile |
69
|
|
|
|
|
|
|
if ( !defined $conf{logfile} ) { |
70
|
|
|
|
|
|
|
$conf{logfile} = $conf{maildir} . "FilterXML.log"; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub defaultFilter { |
75
|
|
|
|
|
|
|
my $self = shift; |
76
|
|
|
|
|
|
|
logger("INBOX", "DEFAULT"); |
77
|
|
|
|
|
|
|
if ( defined $conf{mailbox} ) { |
78
|
|
|
|
|
|
|
my $mailbox = $conf{maildir} . $conf{mailbox}; |
79
|
|
|
|
|
|
|
$self->{message}->accept($mailbox); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
else { |
82
|
|
|
|
|
|
|
$self->{message}->accept(); |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub filtFileStartEl { |
87
|
|
|
|
|
|
|
my ($p,$el,%att) = @_; |
88
|
|
|
|
|
|
|
if ($el =~ /Rule/i) { |
89
|
|
|
|
|
|
|
$current_rule{type} = $att{type}; |
90
|
|
|
|
|
|
|
$current_rule{content} = $att{content}; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
if ($att{type} =~ /from/i) { |
93
|
|
|
|
|
|
|
$from_lists{$att{content}} = $att{folder}; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
if ($att{type} =~ /to/i) { |
96
|
|
|
|
|
|
|
$to_lists{$att{content}} = $att{folder}; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
if ($att{type} =~ /subject/i) { |
99
|
|
|
|
|
|
|
$subject_lists{$att{content}} = $att{folder}; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
if ($att{type} =~ /subj-ignore/i) { |
102
|
|
|
|
|
|
|
push(@subj_ig, $att{content}); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
if ($att{type} =~ /recip-ignore/i) { |
105
|
|
|
|
|
|
|
push(@recip_ig, $att{content}); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
if ( defined $att{action_cmd} and defined $att{action_params} ) { |
108
|
|
|
|
|
|
|
my $action_string = "$att{type}:$att{content}"; |
109
|
|
|
|
|
|
|
my $new_action = { action_cmd => $att{action_cmd}, |
110
|
|
|
|
|
|
|
action_params => $att{action_params} |
111
|
|
|
|
|
|
|
}; |
112
|
|
|
|
|
|
|
push(@{$action{$action_string}}, $new_action); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
elsif ( $el =~ /Action/i){ |
116
|
|
|
|
|
|
|
my $action_string = "$current_rule{type}:$current_rule{content}"; |
117
|
|
|
|
|
|
|
my $new_action = { action_cmd => $att{action_cmd}, |
118
|
|
|
|
|
|
|
action_params => $att{action_params} |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
push(@{$action{$action_string}}, $new_action); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
elsif ($el =~ /Config/i) { |
123
|
|
|
|
|
|
|
foreach my $k (keys %att) { |
124
|
|
|
|
|
|
|
$conf{$k} = $att{$k}; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub doAction { |
130
|
|
|
|
|
|
|
my $self = shift; |
131
|
|
|
|
|
|
|
my $key = shift; |
132
|
|
|
|
|
|
|
if ( defined $action{$key} ) { |
133
|
|
|
|
|
|
|
# We have an action for the specified rule lets do some checks |
134
|
|
|
|
|
|
|
# and run the specified action |
135
|
|
|
|
|
|
|
# we can not use Mail::Audit::pipe since that would not allow us to accept the message |
136
|
|
|
|
|
|
|
# instead we will make a call to system and check the return code. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
my $to = $self->{message}->to; |
139
|
|
|
|
|
|
|
my $from = $self->{message}->from; |
140
|
|
|
|
|
|
|
my $subject = $self->{message}->subject; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# |
143
|
|
|
|
|
|
|
# $action{$key} is actually an arrayref to anonymous hashes. We need to |
144
|
|
|
|
|
|
|
# iterate through all of them for this to work. |
145
|
|
|
|
|
|
|
# |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
my @actions = @{$action{$key}}; |
148
|
|
|
|
|
|
|
foreach my $task ( @actions ) { |
149
|
|
|
|
|
|
|
$task->{action_params} =~ s/#to#/$to/g; |
150
|
|
|
|
|
|
|
$task->{action_params} =~ s/#subject#/$subject/g; |
151
|
|
|
|
|
|
|
$task->{action_params} =~ s/#from#/$from/g; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
my $result = 0xffff & system "$task->{action_cmd} $task->{action_params}"; |
154
|
|
|
|
|
|
|
if ( $result == 0xffff ) { |
155
|
|
|
|
|
|
|
$self->logger($task->{action_cmd}, "Action failed with result : $!"); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
elsif ( $result > 0x80 ) { |
158
|
|
|
|
|
|
|
my $fixed_result = $result >> 8; |
159
|
|
|
|
|
|
|
$self->logger($task->{action_cmd}, "Action ran with non-zero exit status : $fixed_result"); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
else { |
162
|
|
|
|
|
|
|
$self->logger($task->{action_cmd}, "Action"); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub toLists { |
169
|
|
|
|
|
|
|
my $self = shift; |
170
|
|
|
|
|
|
|
foreach my $key (keys %to_lists) { |
171
|
|
|
|
|
|
|
if ($self->{message}->to() =~ /$key/i or $self->{message}->cc() =~ /$key/i) { |
172
|
|
|
|
|
|
|
# if we have an action attributed to this rule then lets do it |
173
|
|
|
|
|
|
|
$self->doAction("to:$key"); |
174
|
|
|
|
|
|
|
$self->logger($to_lists{$key}, "TO-FILTER"); |
175
|
|
|
|
|
|
|
$self->{message}->accept("$conf{maildir}".$to_lists{$key}); |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub subjectLists { |
181
|
|
|
|
|
|
|
my $self = shift; |
182
|
|
|
|
|
|
|
foreach my $key (keys %subject_lists) { |
183
|
|
|
|
|
|
|
if ($self->{message}->subject() =~ /$key/i) { |
184
|
|
|
|
|
|
|
# if we have an action attributed to this rule then lets do it |
185
|
|
|
|
|
|
|
$self->doAction("subject:$key"); |
186
|
|
|
|
|
|
|
# log the results to the log |
187
|
|
|
|
|
|
|
$self->logger($subject_lists{$key}, "SUBJECT-FILTER"); |
188
|
|
|
|
|
|
|
# accept the mail to the specified mail folder |
189
|
|
|
|
|
|
|
$self->{message}->accept("$conf{maildir}".$subject_lists{$key}); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub fromLists { |
195
|
|
|
|
|
|
|
my $self = shift; |
196
|
|
|
|
|
|
|
foreach my $key (keys %from_lists) { |
197
|
|
|
|
|
|
|
if ($self->{message}->from() =~ /$key/i) { |
198
|
|
|
|
|
|
|
# if we have an action attributed to this rule then lets do it |
199
|
|
|
|
|
|
|
$self->doAction("from:$key"); |
200
|
|
|
|
|
|
|
$self->logger($from_lists{$key}, "FROM-FILTER"); |
201
|
|
|
|
|
|
|
$self->{message}->accept("$conf{maildir}".$from_lists{$key}); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub recipIg { |
207
|
|
|
|
|
|
|
my $self = shift; |
208
|
|
|
|
|
|
|
foreach my $r (@recip_ig) { |
209
|
|
|
|
|
|
|
if ($self->{message}->to() =~ /$r/ or $self->{message}->cc() =~ /$r/) { |
210
|
|
|
|
|
|
|
$self->logger("JUNK", "RECIP-IG"); |
211
|
|
|
|
|
|
|
$self->{message}->accept($conf{maildir}.$conf{junkfolder}); |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub subjIg { |
217
|
|
|
|
|
|
|
my $self = shift; |
218
|
|
|
|
|
|
|
foreach my $s (@subj_ig) { |
219
|
|
|
|
|
|
|
if ($self->{message}->subject() =~ /$s/) { |
220
|
|
|
|
|
|
|
$self->logger("JUNK", "SUBJ-IG"); |
221
|
|
|
|
|
|
|
$self->{message}->accept($conf{maildir}.$conf{junkfolder}); |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub logger { |
227
|
|
|
|
|
|
|
my ($self, $folder, $filter) = @_; |
228
|
|
|
|
|
|
|
open(LOG, ">>$conf{logfile}"); |
229
|
|
|
|
|
|
|
flock(LOG,2); |
230
|
|
|
|
|
|
|
my $from = $self->{message}->from(); |
231
|
|
|
|
|
|
|
my $subj = $self->{message}->subject(); |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
chomp($from); |
234
|
|
|
|
|
|
|
chomp($subj); |
235
|
|
|
|
|
|
|
my $time = scalar(localtime()); |
236
|
|
|
|
|
|
|
print LOG "$time> $from : $subj -> $folder ($filter)\n"; |
237
|
|
|
|
|
|
|
close(LOG); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
1; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
__END__ |