line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# <@LICENSE> |
2
|
|
|
|
|
|
|
# Licensed to the Apache Software Foundation (ASF) under one or more |
3
|
|
|
|
|
|
|
# contributor license agreements. See the NOTICE file distributed with |
4
|
|
|
|
|
|
|
# this work for additional information regarding copyright ownership. |
5
|
|
|
|
|
|
|
# The ASF licenses this file to you under the Apache License, Version 2.0 |
6
|
|
|
|
|
|
|
# (the "License"); you may not use this file except in compliance with |
7
|
|
|
|
|
|
|
# the License. You may obtain a copy of the License at: |
8
|
|
|
|
|
|
|
# |
9
|
|
|
|
|
|
|
# http://www.apache.org/licenses/LICENSE-2.0 |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# Unless required by applicable law or agreed to in writing, software |
12
|
|
|
|
|
|
|
# distributed under the License is distributed on an "AS IS" BASIS, |
13
|
|
|
|
|
|
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
14
|
|
|
|
|
|
|
# See the License for the specific language governing permissions and |
15
|
|
|
|
|
|
|
# limitations under the License. |
16
|
|
|
|
|
|
|
# </@LICENSE> |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
Mail::SpamAssassin::Conf::Parser - parse SpamAssassin configuration |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
(see Mail::SpamAssassin) |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 DESCRIPTION |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Mail::SpamAssassin is a module to identify spam using text analysis and |
29
|
|
|
|
|
|
|
several internet-based realtime blacklists. |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
This class is used internally by SpamAssassin to parse its configuration files. |
32
|
|
|
|
|
|
|
Please refer to the C<Mail::SpamAssassin> documentation for public interfaces. |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 STRUCTURE OF A CONFIG BLOCK |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
This is the structure of a config-setting block. Each is a hashref which may |
37
|
|
|
|
|
|
|
contain these keys: |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=over 4 |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=item setting |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
the name of the setting it modifies, e.g. "required_score". this also doubles |
44
|
|
|
|
|
|
|
as the default for 'command' (below). THIS IS REQUIRED. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=item command |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
The command string used in the config file for this setting. Optional; |
49
|
|
|
|
|
|
|
'setting' will be used for the command if this is omitted. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=item aliases |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
An [aryref] of other aliases for the same command. optional. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=item type |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
The type of this setting: |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
- $CONF_TYPE_NOARGS: must not have any argument, like "clear_headers" |
60
|
|
|
|
|
|
|
- $CONF_TYPE_STRING: string |
61
|
|
|
|
|
|
|
- $CONF_TYPE_NUMERIC: numeric value (float or int) |
62
|
|
|
|
|
|
|
- $CONF_TYPE_BOOL: boolean (0/no or 1/yes) |
63
|
|
|
|
|
|
|
- $CONF_TYPE_TEMPLATE: template, like "report" |
64
|
|
|
|
|
|
|
- $CONF_TYPE_ADDRLIST: list of mail addresses, like "whitelist_from" |
65
|
|
|
|
|
|
|
- $CONF_TYPE_HASH_KEY_VALUE: hash key/value pair, like "describe" or tflags |
66
|
|
|
|
|
|
|
- $CONF_TYPE_STRINGLIST list of strings, stored as an array |
67
|
|
|
|
|
|
|
- $CONF_TYPE_IPADDRLIST list of IP addresses, stored as an array of SA::NetSet |
68
|
|
|
|
|
|
|
- $CONF_TYPE_DURATION a nonnegative time interval in seconds - a numeric value |
69
|
|
|
|
|
|
|
(float or int), optionally suffixed by a time unit (s, m, |
70
|
|
|
|
|
|
|
h, d, w), seconds are implied if unit is missing |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
If this is set, and a 'code' block does not already exist, a 'code' block is |
73
|
|
|
|
|
|
|
assigned based on the type. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
In addition, the SpamAssassin test suite will validate that the settings |
76
|
|
|
|
|
|
|
do not 'leak' between users. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Note that C<$CONF_TYPE_HASH_KEY_VALUE>-type settings require that the |
79
|
|
|
|
|
|
|
value be non-empty, otherwise they'll produce a warning message. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=item code |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
A subroutine to deal with the setting. ONE OF B<code> OR B<type> IS REQUIRED. |
84
|
|
|
|
|
|
|
The arguments passed to the function are C<($self, $key, $value, $line)>, |
85
|
|
|
|
|
|
|
where $key is the setting (*not* the command), $value is the value string, |
86
|
|
|
|
|
|
|
and $line is the entire line. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
There are two special return values that the B<code> subroutine may return |
89
|
|
|
|
|
|
|
to signal that there is an error in the configuration: |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
C<$Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE> -- this setting requires |
92
|
|
|
|
|
|
|
that a value be set, but one was not provided. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
C<$Mail::SpamAssassin::Conf::INVALID_VALUE> -- this setting requires a value |
95
|
|
|
|
|
|
|
from a set of 'valid' values, but the user provided an invalid one. |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
C<$Mail::SpamAssassin::Conf::INVALID_HEADER_FIELD_NAME> -- this setting |
98
|
|
|
|
|
|
|
requires a syntactically valid header field name, but the user provided |
99
|
|
|
|
|
|
|
an invalid one. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Any other values -- including C<undef> -- returned from the subroutine are |
102
|
|
|
|
|
|
|
considered to mean 'success'. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
It is good practice to set a 'type', if possible, describing how your settings |
105
|
|
|
|
|
|
|
are stored on the Conf object; this allows the SpamAssassin test suite to |
106
|
|
|
|
|
|
|
validate that the settings do not 'leak' between users. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=item default |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
The default value for the setting. may be omitted if the default value is a |
111
|
|
|
|
|
|
|
non-scalar type, which should be set in the Conf ctor. note for path types: |
112
|
|
|
|
|
|
|
using "__userstate__" is recommended for defaults, as it allows |
113
|
|
|
|
|
|
|
Mail::SpamAssassin module users who set that configuration setting, to receive |
114
|
|
|
|
|
|
|
the correct values. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=item is_priv |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Set to 1 if this setting requires 'allow_user_rules' when run from spamd. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=item is_admin |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Set to 1 if this setting can only be set in the system-wide config when run |
123
|
|
|
|
|
|
|
from spamd. (All settings can be used by local programs run directly by the |
124
|
|
|
|
|
|
|
user.) |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item is_frequent |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Set to 1 if this value occurs frequently in the config. this means it's looked |
129
|
|
|
|
|
|
|
up first for speed. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=back |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
use Mail::SpamAssassin::Conf; |
137
|
41
|
|
|
41
|
|
270
|
use Mail::SpamAssassin::Constants qw(:sa); |
|
41
|
|
|
|
|
75
|
|
|
41
|
|
|
|
|
1401
|
|
138
|
41
|
|
|
41
|
|
191
|
use Mail::SpamAssassin::Logger; |
|
41
|
|
|
|
|
81
|
|
|
41
|
|
|
|
|
4876
|
|
139
|
41
|
|
|
41
|
|
262
|
use Mail::SpamAssassin::Util qw(untaint_var compile_regexp); |
|
41
|
|
|
|
|
72
|
|
|
41
|
|
|
|
|
2067
|
|
140
|
41
|
|
|
41
|
|
228
|
use Mail::SpamAssassin::NetSet; |
|
41
|
|
|
|
|
75
|
|
|
41
|
|
|
|
|
3356
|
|
141
|
41
|
|
|
41
|
|
309
|
|
|
41
|
|
|
|
|
88
|
|
|
41
|
|
|
|
|
942
|
|
142
|
|
|
|
|
|
|
use strict; |
143
|
41
|
|
|
41
|
|
264
|
use warnings; |
|
41
|
|
|
|
|
77
|
|
|
41
|
|
|
|
|
911
|
|
144
|
41
|
|
|
41
|
|
195
|
# use bytes; |
|
41
|
|
|
|
|
60
|
|
|
41
|
|
|
|
|
1417
|
|
145
|
|
|
|
|
|
|
use re 'taint'; |
146
|
41
|
|
|
41
|
|
219
|
|
|
41
|
|
|
|
|
76
|
|
|
41
|
|
|
|
|
94414
|
|
147
|
|
|
|
|
|
|
our @ISA = qw(); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
my $ARITH_EXPRESSION_LEXER = ARITH_EXPRESSION_LEXER; |
150
|
|
|
|
|
|
|
my $META_RULES_MATCHING_RE = META_RULES_MATCHING_RE; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
########################################################################### |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
my $class = shift; |
155
|
|
|
|
|
|
|
$class = ref($class) || $class; |
156
|
92
|
|
|
92
|
0
|
261
|
my ($conf) = @_; |
157
|
92
|
|
33
|
|
|
588
|
|
158
|
92
|
|
|
|
|
272
|
my $self = { |
159
|
|
|
|
|
|
|
'conf' => $conf |
160
|
92
|
|
|
|
|
330
|
}; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
$self->{command_luts} = { }; |
163
|
|
|
|
|
|
|
$self->{command_luts}->{frequent} = { }; |
164
|
92
|
|
|
|
|
310
|
$self->{command_luts}->{remaining} = { }; |
165
|
92
|
|
|
|
|
347
|
|
166
|
92
|
|
|
|
|
357
|
bless ($self, $class); |
167
|
|
|
|
|
|
|
$self; |
168
|
92
|
|
|
|
|
408
|
} |
169
|
92
|
|
|
|
|
713
|
|
170
|
|
|
|
|
|
|
########################################################################### |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my($self, $arrref) = @_; |
173
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
174
|
|
|
|
|
|
|
|
175
|
1647
|
|
|
1647
|
0
|
3252
|
$self->set_defaults_from_command_list($arrref); |
176
|
1647
|
|
|
|
|
2819
|
$self->build_command_luts($arrref); |
177
|
|
|
|
|
|
|
push(@{$conf->{registered_commands}}, @{$arrref}); |
178
|
1647
|
|
|
|
|
4076
|
} |
179
|
1647
|
|
|
|
|
4701
|
|
180
|
1647
|
|
|
|
|
2291
|
my ($self, $arrref) = @_; |
|
1647
|
|
|
|
|
2979
|
|
|
1647
|
|
|
|
|
7115
|
|
181
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
182
|
|
|
|
|
|
|
foreach my $cmd (@{$arrref}) { |
183
|
|
|
|
|
|
|
# note! exists, not defined -- we want to be able to set |
184
|
1647
|
|
|
1647
|
0
|
2758
|
# "undef" default values. |
185
|
1647
|
|
|
|
|
2177
|
if (exists($cmd->{default})) { |
186
|
1647
|
|
|
|
|
2053
|
$conf->{$cmd->{setting}} = $cmd->{default}; |
|
1647
|
|
|
|
|
3804
|
|
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
18638
|
100
|
|
|
|
30127
|
} |
190
|
9922
|
|
|
|
|
28540
|
|
191
|
|
|
|
|
|
|
my ($self, $arrref) = @_; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
my $set; |
196
|
1647
|
|
|
1647
|
0
|
2751
|
foreach my $cmd (@{$arrref}) { |
197
|
|
|
|
|
|
|
# first off, decide what set this is in. |
198
|
1647
|
|
|
|
|
2327
|
if ($cmd->{is_frequent}) { $set = 'frequent'; } |
199
|
|
|
|
|
|
|
else { $set = 'remaining'; } |
200
|
1647
|
|
|
|
|
2048
|
|
201
|
1647
|
|
|
|
|
2234
|
# next, its priority (used to ensure frequently-used params |
|
1647
|
|
|
|
|
2888
|
|
202
|
|
|
|
|
|
|
# are parsed first) |
203
|
18638
|
100
|
|
|
|
24268
|
my $cmdname = $cmd->{command} || $cmd->{setting}; |
|
736
|
|
|
|
|
981
|
|
204
|
17902
|
|
|
|
|
18796
|
$self->{command_luts}->{$set}->{$cmdname} = $cmd; |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
if ($cmd->{aliases} && scalar @{$cmd->{aliases}} > 0) { |
207
|
|
|
|
|
|
|
foreach my $name (@{$cmd->{aliases}}) { |
208
|
18638
|
|
66
|
|
|
37368
|
$self->{command_luts}->{$set}->{$name} = $cmd; |
209
|
18638
|
|
|
|
|
36710
|
} |
210
|
|
|
|
|
|
|
} |
211
|
18638
|
100
|
66
|
|
|
35601
|
} |
|
184
|
|
|
|
|
652
|
|
212
|
184
|
|
|
|
|
287
|
} |
|
184
|
|
|
|
|
474
|
|
213
|
184
|
|
|
|
|
700
|
|
214
|
|
|
|
|
|
|
########################################################################### |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
my ($self, undef, $scoresonly) = @_; # leave $rules in $_[1] |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
219
|
|
|
|
|
|
|
$self->{scoresonly} = $scoresonly; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
# Language selection: |
222
|
91
|
|
|
91
|
0
|
447
|
# See http://www.gnu.org/manual/glibc-2.2.5/html_node/Locale-Categories.html |
223
|
|
|
|
|
|
|
# and http://www.gnu.org/manual/glibc-2.2.5/html_node/Using-gettextized-software.html |
224
|
91
|
|
|
|
|
295
|
my $lang = $ENV{'LANGUAGE'}; # LANGUAGE has the highest precedence but has a |
225
|
91
|
|
|
|
|
434
|
if ($lang) { # special format: The user may specify more than |
226
|
|
|
|
|
|
|
$lang =~ s/:.*$//; # one language here, colon separated. We use the |
227
|
|
|
|
|
|
|
} # first one only (lazy bums we are :o) |
228
|
|
|
|
|
|
|
$lang ||= $ENV{'LC_ALL'}; |
229
|
|
|
|
|
|
|
$lang ||= $ENV{'LC_MESSAGES'}; |
230
|
91
|
|
|
|
|
313
|
$lang ||= $ENV{'LANG'}; |
231
|
91
|
50
|
|
|
|
306
|
$lang ||= 'C'; # Nothing set means C/POSIX |
232
|
0
|
|
|
|
|
0
|
|
233
|
|
|
|
|
|
|
if ($lang =~ /^(C|POSIX)$/) { |
234
|
91
|
|
33
|
|
|
703
|
$lang = 'en_US'; # Our default language |
235
|
91
|
|
33
|
|
|
563
|
} else { |
236
|
91
|
|
33
|
|
|
432
|
$lang =~ s/[@.+,].*$//; # Strip codeset, modifier/audience, etc. |
237
|
91
|
|
50
|
|
|
527
|
} # (eg. .utf8 or @euro) |
238
|
|
|
|
|
|
|
|
239
|
91
|
50
|
|
|
|
729
|
# get fast-access handles on the command lookup tables |
240
|
91
|
|
|
|
|
378
|
my $lut_frequent = $self->{command_luts}->{frequent}; |
241
|
|
|
|
|
|
|
my $lut_remaining = $self->{command_luts}->{remaining}; |
242
|
0
|
|
|
|
|
0
|
my %migrated_keys = map { $_ => 1 } |
243
|
|
|
|
|
|
|
@Mail::SpamAssassin::Conf::MIGRATED_SETTINGS; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
$self->{currentfile} = '(no file)'; |
246
|
91
|
|
|
|
|
304
|
my $skip_parsing = 0; |
247
|
91
|
|
|
|
|
204
|
my @curfile_stack; |
248
|
91
|
|
|
|
|
436
|
my @if_stack; |
|
91
|
|
|
|
|
708
|
|
249
|
|
|
|
|
|
|
my @conf_lines = split (/\n/, $_[1]); |
250
|
|
|
|
|
|
|
my $line; |
251
|
91
|
|
|
|
|
462
|
$self->{if_stack} = \@if_stack; |
252
|
91
|
|
|
|
|
183
|
$self->{file_scoped_attrs} = { }; |
253
|
91
|
|
|
|
|
201
|
|
254
|
|
|
|
|
|
|
my $keepmetadata = $conf->{main}->{keep_config_parsing_metadata}; |
255
|
91
|
|
|
|
|
72651
|
|
256
|
91
|
|
|
|
|
511
|
while (defined ($line = shift @conf_lines)) { |
257
|
91
|
|
|
|
|
324
|
local ($1); # bug 3838: prevent random taint flagging of $1 |
258
|
91
|
|
|
|
|
305
|
|
259
|
|
|
|
|
|
|
if (index($line,'#') > -1) { |
260
|
91
|
|
|
|
|
262
|
# bug 5545: used to support testing rules in the ruleqa system |
261
|
|
|
|
|
|
|
if ($keepmetadata && $line =~ /^\#testrules/) { |
262
|
91
|
|
|
|
|
536
|
$self->{file_scoped_attrs}->{testrules}++; |
263
|
140874
|
|
|
|
|
250811
|
next; |
264
|
|
|
|
|
|
|
} |
265
|
140874
|
100
|
|
|
|
357309
|
|
266
|
|
|
|
|
|
|
# bug 6800: let X-Spam-Checker-Version also show what sa-update we are at |
267
|
51386
|
50
|
33
|
|
|
82077
|
if ($line =~ /^\# UPDATE version (\d+)$/) { |
268
|
0
|
|
|
|
|
0
|
for ($self->{currentfile}) { # just aliasing, not a loop |
269
|
0
|
|
|
|
|
0
|
$conf->{update_version}{$_} = $1 if defined $_ && $_ ne '(no file)'; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
|
273
|
51386
|
50
|
|
|
|
75313
|
$line =~ s/(?<!\\)#.*$//; # remove comments |
274
|
0
|
|
|
|
|
0
|
$line =~ s/\\#/#/g; # hash chars are escaped, so unescape them |
275
|
0
|
0
|
0
|
|
|
0
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
$line =~ s/^\s+//; # remove leading whitespace |
278
|
|
|
|
|
|
|
$line =~ s/\s+$//; # remove tailing whitespace |
279
|
51386
|
|
|
|
|
126931
|
next unless($line); # skip empty lines |
280
|
51386
|
|
|
|
|
72093
|
|
281
|
|
|
|
|
|
|
# handle i18n |
282
|
|
|
|
|
|
|
if ($line =~ s/^lang\s+(\S+)\s+//) { next if ($lang !~ /^$1/i); } |
283
|
140874
|
|
|
|
|
236955
|
|
284
|
140874
|
|
|
|
|
232393
|
my($key, $value) = split(/\s+/, $line, 2); |
285
|
140874
|
100
|
|
|
|
325565
|
$key = lc $key; |
286
|
|
|
|
|
|
|
# convert all dashes in setting name to underscores. |
287
|
|
|
|
|
|
|
$key =~ tr/-/_/; |
288
|
75498
|
0
|
|
|
|
130843
|
$value = '' unless defined($value); |
|
0
|
50
|
|
|
|
0
|
|
289
|
|
|
|
|
|
|
|
290
|
75498
|
|
|
|
|
269475
|
# # Do a better job untainting this info ... |
291
|
75498
|
|
|
|
|
153022
|
# # $value = untaint_var($value); |
292
|
|
|
|
|
|
|
# Do NOT blindly untaint now, do it carefully later when semantics is known! |
293
|
75498
|
|
|
|
|
122530
|
|
294
|
75498
|
100
|
|
|
|
139897
|
my $parse_error; # undef by default, may be overridden |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# File/line number assertions |
297
|
|
|
|
|
|
|
if ($key eq 'file') { |
298
|
|
|
|
|
|
|
if ($value =~ /^start\s+(.+)$/) { |
299
|
|
|
|
|
|
|
push (@curfile_stack, $self->{currentfile}); |
300
|
75498
|
|
|
|
|
81918
|
$self->{currentfile} = $1; |
301
|
|
|
|
|
|
|
next; |
302
|
|
|
|
|
|
|
} |
303
|
75498
|
100
|
|
|
|
289002
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
304
|
3314
|
100
|
|
|
|
9303
|
if ($value =~ /^end\s/) { |
305
|
1657
|
|
|
|
|
3754
|
$self->{file_scoped_attrs} = { }; |
306
|
1657
|
|
|
|
|
3591
|
|
307
|
1657
|
|
|
|
|
6981
|
if (scalar @if_stack > 0) { |
308
|
|
|
|
|
|
|
my $cond = pop @if_stack; |
309
|
|
|
|
|
|
|
|
310
|
1657
|
50
|
|
|
|
5800
|
if ($cond->{type} eq 'if') { |
311
|
1657
|
|
|
|
|
4479
|
my $msg = "config: unclosed 'if' in ". |
312
|
|
|
|
|
|
|
$self->{currentfile}.": if ".$cond->{conditional}."\n"; |
313
|
1657
|
50
|
|
|
|
3861
|
warn $msg; |
314
|
0
|
|
|
|
|
0
|
$self->lint_warn($msg, undef); |
315
|
|
|
|
|
|
|
} |
316
|
0
|
0
|
|
|
|
0
|
else { |
317
|
|
|
|
|
|
|
# die seems a bit excessive here, but this shouldn't be possible |
318
|
0
|
|
|
|
|
0
|
# so I suppose it's okay. |
319
|
0
|
|
|
|
|
0
|
die "config: unknown 'if' type: ".$cond->{type}."\n"; |
320
|
0
|
|
|
|
|
0
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
@if_stack = (); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
$skip_parsing = 0; |
325
|
0
|
|
|
|
|
0
|
|
326
|
|
|
|
|
|
|
my $curfile = pop @curfile_stack; |
327
|
|
|
|
|
|
|
if (defined $curfile) { |
328
|
0
|
|
|
|
|
0
|
$self->{currentfile} = $curfile; |
329
|
|
|
|
|
|
|
} else { |
330
|
1657
|
|
|
|
|
2440
|
$self->{currentfile} = '(no file)'; |
331
|
|
|
|
|
|
|
} |
332
|
1657
|
|
|
|
|
2741
|
next; |
333
|
1657
|
50
|
|
|
|
3089
|
} |
334
|
1657
|
|
|
|
|
3125
|
} |
335
|
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
0
|
# now handle the commands. |
337
|
|
|
|
|
|
|
elsif ($key eq 'include') { |
338
|
1657
|
|
|
|
|
6924
|
$value = $self->fix_path_relative_to_current_file($value); |
339
|
|
|
|
|
|
|
my $text = $conf->{main}->read_cf($value, 'included file'); |
340
|
|
|
|
|
|
|
unshift (@conf_lines, split (/\n/, $text)); |
341
|
|
|
|
|
|
|
next; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
0
|
|
|
|
|
0
|
elsif ($key eq 'ifplugin') { |
345
|
0
|
|
|
|
|
0
|
$self->handle_conditional ($key, "plugin ($value)", |
346
|
0
|
|
|
|
|
0
|
\@if_stack, \$skip_parsing); |
347
|
0
|
|
|
|
|
0
|
next; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
elsif ($key eq 'if') { |
351
|
746
|
|
|
|
|
4583
|
$self->handle_conditional ($key, $value, |
352
|
|
|
|
|
|
|
\@if_stack, \$skip_parsing); |
353
|
746
|
|
|
|
|
5449
|
next; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
elsif ($key eq 'else') { |
357
|
239
|
|
|
|
|
1184
|
# TODO: if/else/else won't get flagged here :( |
358
|
|
|
|
|
|
|
if (!@if_stack) { |
359
|
239
|
|
|
|
|
1750
|
$parse_error = "config: found else without matching conditional"; |
360
|
|
|
|
|
|
|
goto failed_line; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
$skip_parsing = !$skip_parsing; |
364
|
0
|
0
|
|
|
|
0
|
next; |
365
|
0
|
|
|
|
|
0
|
} |
366
|
0
|
|
|
|
|
0
|
|
367
|
|
|
|
|
|
|
# and the endif statement: |
368
|
|
|
|
|
|
|
elsif ($key eq 'endif') { |
369
|
0
|
|
|
|
|
0
|
my $lastcond = pop @if_stack; |
370
|
0
|
|
|
|
|
0
|
if (!defined $lastcond) { |
371
|
|
|
|
|
|
|
$parse_error = "config: found endif without matching conditional"; |
372
|
|
|
|
|
|
|
goto failed_line; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
985
|
|
|
|
|
1771
|
$skip_parsing = $lastcond->{skip_parsing}; |
376
|
985
|
50
|
|
|
|
2089
|
next; |
377
|
0
|
|
|
|
|
0
|
} |
378
|
0
|
|
|
|
|
0
|
|
379
|
|
|
|
|
|
|
# preprocessing? skip all other commands |
380
|
|
|
|
|
|
|
next if $skip_parsing; |
381
|
985
|
|
|
|
|
1651
|
|
382
|
985
|
|
|
|
|
5101
|
if ($key eq 'require_version') { |
383
|
|
|
|
|
|
|
# if it wasn't replaced during install, assume current version ... |
384
|
|
|
|
|
|
|
next if ($value eq "\@\@VERSION\@\@"); |
385
|
|
|
|
|
|
|
|
386
|
70214
|
100
|
|
|
|
109980
|
my $ver = $Mail::SpamAssassin::VERSION; |
387
|
|
|
|
|
|
|
|
388
|
70055
|
50
|
|
|
|
114196
|
# if we want to allow "require_version 3.0" be good for all |
389
|
|
|
|
|
|
|
# "3.0.x" versions: |
390
|
0
|
0
|
|
|
|
0
|
## make sure it's a numeric value |
391
|
|
|
|
|
|
|
#$value += 0.0; |
392
|
0
|
|
|
|
|
0
|
## convert 3.000000 -> 3.0, stay backward compatible ... |
393
|
|
|
|
|
|
|
#$ver =~ s/^(\d+)\.(\d{1,3}).*$/sprintf "%d.%d", $1, $2/e; |
394
|
|
|
|
|
|
|
#$value =~ s/^(\d+)\.(\d{1,3}).*$/sprintf "%d.%d", $1, $2/e; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
if ($ver ne $value) { |
397
|
|
|
|
|
|
|
my $msg = "config: configuration file \"$self->{currentfile}\" requires ". |
398
|
|
|
|
|
|
|
"version $value of SpamAssassin, but this is code version ". |
399
|
|
|
|
|
|
|
"$ver. Maybe you need to use ". |
400
|
|
|
|
|
|
|
"the -C switch, or remove the old config files? ". |
401
|
|
|
|
|
|
|
"Skipping this file"; |
402
|
0
|
0
|
|
|
|
0
|
warn $msg; |
403
|
0
|
|
|
|
|
0
|
$self->lint_warn($msg, undef); |
404
|
|
|
|
|
|
|
$skip_parsing = 1; |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
next; |
407
|
|
|
|
|
|
|
} |
408
|
0
|
|
|
|
|
0
|
|
409
|
0
|
|
|
|
|
0
|
my $cmd = $lut_frequent->{$key}; # check the frequent command set |
410
|
0
|
|
|
|
|
0
|
if (!$cmd) { |
411
|
|
|
|
|
|
|
$cmd = $lut_remaining->{$key}; # no? try the rest |
412
|
0
|
|
|
|
|
0
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# we've either fallen through with no match, in which case this |
415
|
70055
|
|
|
|
|
101379
|
# if() will fail, or we have a match. |
416
|
70055
|
100
|
|
|
|
99769
|
if ($cmd) { |
417
|
61781
|
|
|
|
|
83798
|
if ($self->{scoresonly}) { # reading user config from spamd |
418
|
|
|
|
|
|
|
if ($cmd->{is_priv} && !$conf->{allow_user_rules}) { |
419
|
|
|
|
|
|
|
info("config: not parsing, 'allow_user_rules' is 0: $line"); |
420
|
|
|
|
|
|
|
goto failed_line; |
421
|
|
|
|
|
|
|
} |
422
|
70055
|
100
|
|
|
|
98532
|
if ($cmd->{is_admin}) { |
423
|
70042
|
50
|
|
|
|
111263
|
info("config: not parsing, administrator setting: $line"); |
424
|
0
|
0
|
0
|
|
|
0
|
goto failed_line; |
425
|
0
|
|
|
|
|
0
|
} |
426
|
0
|
|
|
|
|
0
|
} |
427
|
|
|
|
|
|
|
|
428
|
0
|
0
|
|
|
|
0
|
if (!$cmd->{code}) { |
429
|
0
|
|
|
|
|
0
|
if (! $self->setup_default_code_cb($cmd)) { |
430
|
0
|
|
|
|
|
0
|
goto failed_line; |
431
|
|
|
|
|
|
|
} |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
70042
|
100
|
|
|
|
107147
|
my $ret = &{$cmd->{code}} ($conf, $cmd->{setting}, $value, $line); |
435
|
726
|
50
|
|
|
|
2067
|
|
436
|
0
|
|
|
|
|
0
|
if ($ret && $ret eq $Mail::SpamAssassin::Conf::INVALID_VALUE) |
437
|
|
|
|
|
|
|
{ |
438
|
|
|
|
|
|
|
$parse_error = "config: SpamAssassin failed to parse line, ". |
439
|
|
|
|
|
|
|
"\"$value\" is not valid for \"$key\", ". |
440
|
70042
|
|
|
|
|
78814
|
"skipping: $line"; |
|
70042
|
|
|
|
|
137070
|
|
441
|
|
|
|
|
|
|
goto failed_line; |
442
|
70042
|
50
|
66
|
|
|
342611
|
} |
|
|
50
|
66
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
443
|
|
|
|
|
|
|
elsif ($ret && $ret eq $Mail::SpamAssassin::Conf::INVALID_HEADER_FIELD_NAME) |
444
|
0
|
|
|
|
|
0
|
{ |
445
|
|
|
|
|
|
|
$parse_error = "config: SpamAssassin failed to parse line, ". |
446
|
|
|
|
|
|
|
"it does not specify a valid header field name, ". |
447
|
0
|
|
|
|
|
0
|
"skipping: $line"; |
448
|
|
|
|
|
|
|
goto failed_line; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
elsif ($ret && $ret eq $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE) |
451
|
0
|
|
|
|
|
0
|
{ |
452
|
|
|
|
|
|
|
$parse_error = "config: SpamAssassin failed to parse line, ". |
453
|
|
|
|
|
|
|
"no value provided for \"$key\", ". |
454
|
0
|
|
|
|
|
0
|
"skipping: $line"; |
455
|
|
|
|
|
|
|
goto failed_line; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
else { |
458
|
0
|
|
|
|
|
0
|
next; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
} |
461
|
0
|
|
|
|
|
0
|
|
462
|
|
|
|
|
|
|
# last ditch: try to see if the plugins know what to do with it |
463
|
|
|
|
|
|
|
if ($conf->{main}->call_plugins("parse_config", { |
464
|
70042
|
|
|
|
|
339866
|
key => $key, |
465
|
|
|
|
|
|
|
value => $value, |
466
|
|
|
|
|
|
|
line => $line, |
467
|
|
|
|
|
|
|
conf => $conf, |
468
|
|
|
|
|
|
|
user_config => $self->{scoresonly} |
469
|
13
|
50
|
|
|
|
93
|
})) |
470
|
|
|
|
|
|
|
{ |
471
|
|
|
|
|
|
|
# a plugin dealt with it successfully. |
472
|
|
|
|
|
|
|
next; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
failed_line: |
476
|
|
|
|
|
|
|
my $msg = $parse_error; |
477
|
|
|
|
|
|
|
my $is_error = 1; |
478
|
0
|
|
|
|
|
0
|
if (!$msg) { |
479
|
|
|
|
|
|
|
# use a default warning, if a more specific one wasn't output |
480
|
|
|
|
|
|
|
if ($migrated_keys{$key}) { |
481
|
|
|
|
|
|
|
# this key was moved into a plugin; non-fatal for lint |
482
|
13
|
|
|
|
|
49
|
$is_error = 0; |
483
|
13
|
|
|
|
|
17
|
$msg = "config: failed to parse, now a plugin, skipping, in \"$self->{currentfile}\": $line"; |
484
|
13
|
50
|
|
|
|
21
|
} else { |
485
|
|
|
|
|
|
|
# a real syntax error; this is fatal for --lint |
486
|
13
|
50
|
|
|
|
29
|
$msg = "config: failed to parse line, skipping, in \"$self->{currentfile}\": $line"; |
487
|
|
|
|
|
|
|
} |
488
|
0
|
|
|
|
|
0
|
} |
489
|
0
|
|
|
|
|
0
|
|
490
|
|
|
|
|
|
|
$self->lint_warn($msg, undef, $is_error); |
491
|
|
|
|
|
|
|
} |
492
|
13
|
|
|
|
|
40
|
|
493
|
|
|
|
|
|
|
delete $self->{if_stack}; |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
$self->lint_check(); |
496
|
13
|
|
|
|
|
46
|
$self->set_default_scores(); |
497
|
|
|
|
|
|
|
$self->check_for_missing_descriptions(); |
498
|
|
|
|
|
|
|
|
499
|
91
|
|
|
|
|
326
|
delete $self->{scoresonly}; |
500
|
|
|
|
|
|
|
} |
501
|
91
|
|
|
|
|
498
|
|
502
|
91
|
|
|
|
|
368
|
my ($self, $key, $value, $if_stack_ref, $skip_parsing_ref) = @_; |
503
|
91
|
|
|
|
|
590
|
my $conf = $self->{conf}; |
504
|
|
|
|
|
|
|
|
505
|
91
|
|
|
|
|
901
|
my @tokens = ($value =~ /($ARITH_EXPRESSION_LEXER)/og); |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
my $eval = ''; |
508
|
|
|
|
|
|
|
my $bad = 0; |
509
|
985
|
|
|
985
|
0
|
3255
|
foreach my $token (@tokens) { |
510
|
985
|
|
|
|
|
2056
|
if ($token =~ /^(?:\W{1,5}|[+-]?\d+(?:\.\d+)?)$/) { |
511
|
|
|
|
|
|
|
# using tainted subr. argument may taint the whole expression, avoid |
512
|
985
|
|
|
|
|
12398
|
my $u = untaint_var($token); |
513
|
|
|
|
|
|
|
$eval .= $u . " "; |
514
|
985
|
|
|
|
|
2453
|
} |
515
|
985
|
|
|
|
|
1508
|
elsif ($token eq 'plugin') { |
516
|
985
|
|
|
|
|
2078
|
# replace with a method call |
517
|
4021
|
100
|
|
|
|
17415
|
$eval .= '$self->cond_clause_plugin_loaded'; |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
518
|
|
|
|
|
|
|
} |
519
|
2132
|
|
|
|
|
5342
|
elsif ($token eq 'can') { |
520
|
2132
|
|
|
|
|
4651
|
# replace with a method call |
521
|
|
|
|
|
|
|
$eval .= '$self->cond_clause_can'; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
elsif ($token eq 'has') { |
524
|
746
|
|
|
|
|
1713
|
# replace with a method call |
525
|
|
|
|
|
|
|
$eval .= '$self->cond_clause_has'; |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
elsif ($token eq 'version') { |
528
|
158
|
|
|
|
|
451
|
$eval .= $Mail::SpamAssassin::VERSION." "; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
elsif ($token eq 'perl_version') { |
531
|
|
|
|
|
|
|
$eval .= $]." "; |
532
|
0
|
|
|
|
|
0
|
} |
533
|
|
|
|
|
|
|
elsif ($token =~ /^\w[\w\:]+$/) { # class name |
534
|
|
|
|
|
|
|
# Strictly controlled form: |
535
|
81
|
|
|
|
|
357
|
if ($token =~ /^(?:\w+::){0,10}\w+$/) { |
536
|
|
|
|
|
|
|
my $u = untaint_var($token); |
537
|
|
|
|
|
|
|
$eval .= "'$u'"; |
538
|
0
|
|
|
|
|
0
|
} else { |
539
|
|
|
|
|
|
|
warn "config: illegal name '$token' in 'if $value'\n"; |
540
|
|
|
|
|
|
|
$bad++; |
541
|
|
|
|
|
|
|
last; |
542
|
904
|
50
|
|
|
|
4061
|
} |
543
|
904
|
|
|
|
|
2053
|
} |
544
|
904
|
|
|
|
|
2731
|
else { |
545
|
|
|
|
|
|
|
$bad++; |
546
|
0
|
|
|
|
|
0
|
warn "config: unparseable chars in 'if $value': '$token'\n"; |
547
|
0
|
|
|
|
|
0
|
last; |
548
|
0
|
|
|
|
|
0
|
} |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
if ($bad) { |
552
|
0
|
|
|
|
|
0
|
$self->lint_warn("config: bad 'if' line, in \"$self->{currentfile}\"", undef); |
553
|
0
|
|
|
|
|
0
|
return -1; |
554
|
0
|
|
|
|
|
0
|
} |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
push (@{$if_stack_ref}, { |
557
|
|
|
|
|
|
|
type => 'if', |
558
|
985
|
50
|
|
|
|
2074
|
conditional => $value, |
559
|
0
|
|
|
|
|
0
|
skip_parsing => $$skip_parsing_ref |
560
|
0
|
|
|
|
|
0
|
}); |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
if (eval $eval) { |
563
|
985
|
|
|
|
|
1401
|
# leave $skip_parsing as-is; we may not be parsing anyway in this block. |
|
985
|
|
|
|
|
4778
|
|
564
|
|
|
|
|
|
|
# in other words, support nested 'if's and 'require_version's |
565
|
|
|
|
|
|
|
} else { |
566
|
|
|
|
|
|
|
warn "config: error in $key - $eval: $@" if $@ ne ''; |
567
|
|
|
|
|
|
|
$$skip_parsing_ref = 1; |
568
|
|
|
|
|
|
|
} |
569
|
985
|
100
|
|
|
|
63035
|
} |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
# functions supported in the "if" eval: |
572
|
|
|
|
|
|
|
return $_[0]->{conf}->{plugins_loaded}->{$_[1]}; |
573
|
76
|
50
|
|
|
|
315
|
} |
574
|
76
|
|
|
|
|
313
|
|
575
|
|
|
|
|
|
|
my ($self, $method) = @_; |
576
|
|
|
|
|
|
|
if ($self->{currentfile} =~ q!\buser_prefs$! ) { |
577
|
|
|
|
|
|
|
warn "config: 'if can $method' not available in user_prefs"; |
578
|
|
|
|
|
|
|
return 0 |
579
|
|
|
|
|
|
|
} |
580
|
746
|
|
|
746
|
0
|
8859
|
$self->cond_clause_can_or_has('can', $method); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
my ($self, $method) = @_; |
584
|
158
|
|
|
158
|
0
|
529
|
$self->cond_clause_can_or_has('has', $method); |
585
|
158
|
50
|
|
|
|
676
|
} |
586
|
0
|
|
|
|
|
0
|
|
587
|
0
|
|
|
|
|
0
|
my ($self, $fn_name, $method) = @_; |
588
|
|
|
|
|
|
|
|
589
|
158
|
|
|
|
|
621
|
local($1,$2); |
590
|
|
|
|
|
|
|
if (!defined $method) { |
591
|
|
|
|
|
|
|
$self->lint_warn("config: bad 'if' line, no argument to $fn_name(), ". |
592
|
|
|
|
|
|
|
"in \"$self->{currentfile}\"", undef); |
593
|
0
|
|
|
0
|
0
|
0
|
} elsif ($method =~ /^(.*)::([^:]+)$/) { |
594
|
0
|
|
|
|
|
0
|
no strict "refs"; |
595
|
|
|
|
|
|
|
my($module, $meth) = ($1, $2); |
596
|
|
|
|
|
|
|
return 1 if $module->can($meth) && |
597
|
|
|
|
|
|
|
( $fn_name eq 'has' || &{$method}() ); |
598
|
158
|
|
|
158
|
0
|
443
|
} else { |
599
|
|
|
|
|
|
|
$self->lint_warn("config: bad 'if' line, cannot find '::' in $fn_name($method), ". |
600
|
158
|
|
|
|
|
591
|
"in \"$self->{currentfile}\"", undef); |
601
|
158
|
50
|
|
|
|
1265
|
} |
|
|
50
|
|
|
|
|
|
602
|
0
|
|
|
|
|
0
|
return; |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
41
|
|
|
41
|
|
378
|
# Let's do some linting here ... |
|
41
|
|
|
|
|
80
|
|
|
41
|
|
|
|
|
225555
|
|
606
|
158
|
|
|
|
|
598
|
# This is called from _parse(), BTW, so we can check for $conf->{tests} |
607
|
|
|
|
|
|
|
# easily before finish_parsing() is called and deletes it. |
608
|
158
|
50
|
33
|
|
|
2269
|
# |
|
|
|
33
|
|
|
|
|
609
|
|
|
|
|
|
|
my ($self) = @_; |
610
|
0
|
|
|
|
|
0
|
my $conf = $self->{conf}; |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
if ($conf->{lint_rules}) { |
613
|
0
|
|
|
|
|
0
|
# Check for description and score issues in lint fashion |
614
|
|
|
|
|
|
|
while ( my $k = each %{$conf->{descriptions}} ) { |
615
|
|
|
|
|
|
|
if (!exists $conf->{tests}->{$k}) { |
616
|
|
|
|
|
|
|
dbg("config: warning: description exists for non-existent rule $k"); |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
while ( my($sk) = each %{$conf->{scores}} ) { |
621
|
91
|
|
|
91
|
0
|
274
|
if (!exists $conf->{tests}->{$sk}) { |
622
|
91
|
|
|
|
|
251
|
# bug 5514: not a lint warning any more |
623
|
|
|
|
|
|
|
dbg("config: warning: score set for non-existent rule $sk"); |
624
|
91
|
100
|
|
|
|
359
|
} |
625
|
|
|
|
|
|
|
} |
626
|
32
|
|
|
|
|
63
|
} |
|
928
|
|
|
|
|
1851
|
|
627
|
896
|
50
|
|
|
|
1963
|
} |
628
|
0
|
|
|
|
|
0
|
|
629
|
|
|
|
|
|
|
# we should set a default score for all valid rules... Do this here |
630
|
|
|
|
|
|
|
# instead of add_test because mostly 'score' occurs after the rule is |
631
|
|
|
|
|
|
|
# specified, so why set the scores to default, then set them again at |
632
|
32
|
|
|
|
|
68
|
# 'score'? |
|
672
|
|
|
|
|
1327
|
|
633
|
640
|
50
|
|
|
|
1096
|
# |
634
|
|
|
|
|
|
|
my ($self) = @_; |
635
|
0
|
|
|
|
|
0
|
my $conf = $self->{conf}; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
while ( my $k = each %{$conf->{tests}} ) { |
638
|
|
|
|
|
|
|
if ( ! exists $conf->{scores}->{$k} ) { |
639
|
|
|
|
|
|
|
# T_ rules (in a testing probationary period) get low, low scores |
640
|
|
|
|
|
|
|
my $set_score = ($k =~/^T_/) ? 0.01 : 1.0; |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
$set_score = -$set_score if ( ($conf->{tflags}->{$k}||'') =~ /\bnice\b/ ); |
643
|
|
|
|
|
|
|
for my $index (0..3) { |
644
|
|
|
|
|
|
|
$conf->{scoreset}->[$index]->{$k} = $set_score; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
} |
647
|
91
|
|
|
91
|
0
|
266
|
} |
648
|
91
|
|
|
|
|
210
|
} |
649
|
|
|
|
|
|
|
|
650
|
91
|
|
|
|
|
168
|
# loop through all the tests and if we are missing a description with debug |
|
3788
|
|
|
|
|
7641
|
|
651
|
3697
|
100
|
|
|
|
5869
|
# set, throw a warning except for testing T_ or meta __ rules. |
652
|
|
|
|
|
|
|
my ($self) = @_; |
653
|
2458
|
50
|
|
|
|
3676
|
my $conf = $self->{conf}; |
654
|
|
|
|
|
|
|
|
655
|
2458
|
100
|
100
|
|
|
8532
|
while ( my $k = each %{$conf->{tests}} ) { |
656
|
2458
|
|
|
|
|
3811
|
if ($k !~ m/^(?:T_|__)/i) { |
657
|
9832
|
|
|
|
|
16845
|
if ( ! exists $conf->{descriptions}->{$k} ) { |
658
|
|
|
|
|
|
|
dbg("config: warning: no description set for $k"); |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
} |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
########################################################################### |
665
|
|
|
|
|
|
|
|
666
|
91
|
|
|
91
|
0
|
269
|
my ($self, $cmd) = @_; |
667
|
91
|
|
|
|
|
209
|
my $type = $cmd->{type}; |
668
|
|
|
|
|
|
|
|
669
|
91
|
|
|
|
|
163
|
if ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_STRING) { |
|
3788
|
|
|
|
|
6848
|
|
670
|
3697
|
100
|
|
|
|
6711
|
$cmd->{code} = \&set_string_value; |
671
|
3509
|
100
|
|
|
|
6148
|
} |
672
|
1785
|
|
|
|
|
3644
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_BOOL) { |
673
|
|
|
|
|
|
|
$cmd->{code} = \&set_bool_value; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC) { |
676
|
|
|
|
|
|
|
$cmd->{code} = \&set_numeric_value; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_HASH_KEY_VALUE) { |
679
|
|
|
|
|
|
|
$cmd->{code} = \&set_hash_key_value; |
680
|
|
|
|
|
|
|
} |
681
|
726
|
|
|
726
|
0
|
1320
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_ADDRLIST) { |
682
|
726
|
|
|
|
|
1357
|
$cmd->{code} = \&set_addrlist_value; |
683
|
|
|
|
|
|
|
} |
684
|
726
|
100
|
|
|
|
2864
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_TEMPLATE) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
685
|
124
|
|
|
|
|
380
|
$cmd->{code} = \&set_template_append; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_NOARGS) { |
688
|
97
|
|
|
|
|
424
|
$cmd->{code} = \&set_no_value; |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_STRINGLIST) { |
691
|
213
|
|
|
|
|
533
|
$cmd->{code} = \&set_string_list; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_IPADDRLIST) { |
694
|
124
|
|
|
|
|
394
|
$cmd->{code} = \&set_ipaddr_list; |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::CONF_TYPE_DURATION) { |
697
|
0
|
|
|
|
|
0
|
$cmd->{code} = \&set_duration_value; |
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
else { |
700
|
124
|
|
|
|
|
327
|
warn "config: unknown conf type $type!"; |
701
|
|
|
|
|
|
|
return 0; |
702
|
|
|
|
|
|
|
} |
703
|
0
|
|
|
|
|
0
|
return 1; |
704
|
|
|
|
|
|
|
} |
705
|
|
|
|
|
|
|
|
706
|
0
|
|
|
|
|
0
|
my ($conf, $key, $value, $line) = @_; |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
unless (!defined $value || $value eq '') { |
709
|
44
|
|
|
|
|
135
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
} |
712
|
0
|
|
|
|
|
0
|
|
713
|
|
|
|
|
|
|
my ($conf, $key, $value, $line) = @_; |
714
|
|
|
|
|
|
|
|
715
|
0
|
|
|
|
|
0
|
unless (defined $value && $value !~ /^$/) { |
716
|
0
|
|
|
|
|
0
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
717
|
|
|
|
|
|
|
} |
718
|
726
|
|
|
|
|
1885
|
unless ($value =~ /^ [+-]? \d+ (?: \. \d* )? \z/sx) { |
719
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
720
|
|
|
|
|
|
|
} |
721
|
|
|
|
|
|
|
# it is safe to untaint now that we know the syntax is a valid number |
722
|
0
|
|
|
0
|
0
|
0
|
$conf->{$key} = untaint_var($value) + 0; |
723
|
|
|
|
|
|
|
} |
724
|
0
|
0
|
0
|
|
|
0
|
|
725
|
0
|
|
|
|
|
0
|
my ($conf, $key, $value, $line) = @_; |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
local ($1,$2); |
728
|
|
|
|
|
|
|
unless (defined $value && $value !~ /^$/) { |
729
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
730
|
213
|
|
|
213
|
0
|
694
|
} |
731
|
|
|
|
|
|
|
unless ($value =~ /^( \+? \d+ (?: \. \d* )? ) (?: \s* ([smhdw]))? \z/sxi) { |
732
|
213
|
50
|
33
|
|
|
1483
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
733
|
0
|
|
|
|
|
0
|
} |
734
|
|
|
|
|
|
|
$value = $1; |
735
|
213
|
50
|
|
|
|
1093
|
$value *= { s => 1, m => 60, h => 3600, |
736
|
0
|
|
|
|
|
0
|
d => 24*3600, w => 7*24*3600 }->{lc $2} if defined $2; |
737
|
|
|
|
|
|
|
# it is safe to untaint now that we know the syntax is a valid time interval |
738
|
|
|
|
|
|
|
$conf->{$key} = untaint_var($value) + 0; |
739
|
213
|
|
|
|
|
731
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
my ($conf, $key, $value, $line) = @_; |
742
|
|
|
|
|
|
|
|
743
|
0
|
|
|
0
|
0
|
0
|
unless (defined $value && $value !~ /^$/) { |
744
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
745
|
0
|
|
|
|
|
0
|
} |
746
|
0
|
0
|
0
|
|
|
0
|
|
747
|
0
|
|
|
|
|
0
|
# bug 4462: allow yes/1 and no/0 for boolean values |
748
|
|
|
|
|
|
|
$value = lc $value; |
749
|
0
|
0
|
|
|
|
0
|
if ($value eq 'yes' || $value eq '1') { |
750
|
0
|
|
|
|
|
0
|
$value = 1; |
751
|
|
|
|
|
|
|
} |
752
|
0
|
|
|
|
|
0
|
elsif ($value eq 'no' || $value eq '0') { |
753
|
|
|
|
|
|
|
$value = 0; |
754
|
0
|
0
|
|
|
|
0
|
} |
755
|
|
|
|
|
|
|
else { |
756
|
0
|
|
|
|
|
0
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
$conf->{$key} = $value; |
760
|
97
|
|
|
97
|
0
|
602
|
} |
761
|
|
|
|
|
|
|
|
762
|
97
|
50
|
33
|
|
|
1197
|
my ($conf, $key, $value, $line) = @_; |
763
|
0
|
|
|
|
|
0
|
|
764
|
|
|
|
|
|
|
unless (defined $value && $value !~ /^$/) { |
765
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
766
|
|
|
|
|
|
|
} |
767
|
97
|
|
|
|
|
360
|
|
768
|
97
|
100
|
66
|
|
|
1064
|
$conf->{$key} = $value; # keep tainted |
|
|
50
|
33
|
|
|
|
|
769
|
64
|
|
|
|
|
188
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
my ($conf, $key, $value, $line) = @_; |
772
|
33
|
|
|
|
|
79
|
|
773
|
|
|
|
|
|
|
unless (defined $value && $value !~ /^$/) { |
774
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
775
|
0
|
|
|
|
|
0
|
} |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
push(@{$conf->{$key}}, split(' ', $value)); |
778
|
97
|
|
|
|
|
440
|
} |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
my ($conf, $key, $value, $line) = @_; |
781
|
|
|
|
|
|
|
|
782
|
124
|
|
|
124
|
0
|
540
|
unless (defined $value && $value !~ /^$/) { |
783
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
784
|
124
|
50
|
33
|
|
|
1098
|
} |
785
|
0
|
|
|
|
|
0
|
|
786
|
|
|
|
|
|
|
foreach my $net (split(' ', $value)) { |
787
|
|
|
|
|
|
|
$conf->{$key}->add_cidr($net); |
788
|
124
|
|
|
|
|
578
|
} |
789
|
|
|
|
|
|
|
$conf->{$key.'_configured'} = 1; |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
0
|
|
|
0
|
0
|
0
|
my ($conf, $key, $value, $line) = @_; |
793
|
|
|
|
|
|
|
my($k,$v) = split(/\s+/, $value, 2); |
794
|
0
|
0
|
0
|
|
|
0
|
|
795
|
0
|
|
|
|
|
0
|
unless (defined $v && $v ne '') { |
796
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
797
|
|
|
|
|
|
|
} |
798
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
799
|
|
|
|
|
|
|
$conf->{$key}->{$k} = $v; # keep tainted |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
|
802
|
44
|
|
|
44
|
0
|
181
|
my ($conf, $key, $value, $line) = @_; |
803
|
|
|
|
|
|
|
|
804
|
44
|
50
|
33
|
|
|
371
|
unless (defined $value && $value !~ /^$/) { |
805
|
0
|
|
|
|
|
0
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
$conf->{parser}->add_to_addrlist ($key, split (' ', $value)); # keep tainted |
808
|
44
|
|
|
|
|
164
|
} |
809
|
60
|
|
|
|
|
252
|
|
810
|
|
|
|
|
|
|
my ($conf, $key, $value, $line) = @_; |
811
|
44
|
|
|
|
|
199
|
|
812
|
|
|
|
|
|
|
unless (defined $value && $value !~ /^$/) { |
813
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE; |
814
|
|
|
|
|
|
|
} |
815
|
3699
|
|
|
3699
|
0
|
9188
|
$conf->{parser}->remove_from_addrlist ($key, split (' ', $value)); |
816
|
3699
|
|
|
|
|
15228
|
} |
817
|
|
|
|
|
|
|
|
818
|
3699
|
50
|
33
|
|
|
15611
|
my ($conf, $key, $value, $line) = @_; |
819
|
0
|
|
|
|
|
0
|
if ( $value =~ /^"(.*?)"$/ ) { $value = $1; } |
820
|
|
|
|
|
|
|
$conf->{$key} .= $value."\n"; # keep tainted |
821
|
|
|
|
|
|
|
} |
822
|
3699
|
|
|
|
|
14726
|
|
823
|
|
|
|
|
|
|
my ($conf, $key, $value, $line) = @_; |
824
|
|
|
|
|
|
|
unless (!defined $value || $value eq '') { |
825
|
|
|
|
|
|
|
return $Mail::SpamAssassin::Conf::INVALID_VALUE; |
826
|
0
|
|
|
0
|
0
|
0
|
} |
827
|
|
|
|
|
|
|
$conf->{$key} = ''; |
828
|
0
|
0
|
0
|
|
|
0
|
} |
829
|
0
|
|
|
|
|
0
|
|
830
|
|
|
|
|
|
|
########################################################################### |
831
|
0
|
|
|
|
|
0
|
|
832
|
|
|
|
|
|
|
my ($self, $isuserconf) = @_; |
833
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
834
|
|
|
|
|
|
|
|
835
|
0
|
|
|
0
|
0
|
0
|
# note: this function is called once for system-wide configuration |
836
|
|
|
|
|
|
|
# with $isuserconf set to 0, then again for user conf with $isuserconf set to 1. |
837
|
0
|
0
|
0
|
|
|
0
|
if (!$isuserconf) { |
838
|
0
|
|
|
|
|
0
|
$conf->{main}->call_plugins("finish_parsing_start", { conf => $conf }); |
839
|
|
|
|
|
|
|
} else { |
840
|
0
|
|
|
|
|
0
|
$conf->{main}->call_plugins("user_conf_parsing_start", { conf => $conf }); |
841
|
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
$self->trace_meta_dependencies(); |
844
|
1054
|
|
|
1054
|
0
|
2553
|
$self->fix_priorities(); |
845
|
1054
|
100
|
|
|
|
2918
|
|
|
62
|
|
|
|
|
265
|
|
846
|
1054
|
|
|
|
|
4379
|
# don't do this if allow_user_rules is active, since it deletes entries |
847
|
|
|
|
|
|
|
# from {tests} |
848
|
|
|
|
|
|
|
if (!$conf->{allow_user_rules}) { |
849
|
|
|
|
|
|
|
$self->find_dup_rules(); # must be after fix_priorities() |
850
|
124
|
|
|
124
|
0
|
506
|
} |
851
|
124
|
50
|
33
|
|
|
802
|
|
852
|
0
|
|
|
|
|
0
|
dbg("config: finish parsing"); |
853
|
|
|
|
|
|
|
|
854
|
124
|
|
|
|
|
539
|
while (my ($name, $text) = each %{$conf->{tests}}) { |
855
|
|
|
|
|
|
|
my $type = $conf->{test_types}->{$name}; |
856
|
|
|
|
|
|
|
my $priority = $conf->{priority}->{$name} || 0; |
857
|
|
|
|
|
|
|
$conf->{priorities}->{$priority}++; |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
# eval type handling |
860
|
91
|
|
|
91
|
0
|
263
|
if (($type & 1) == 1) { |
861
|
91
|
|
|
|
|
199
|
if (my ($function, $args) = ($text =~ /^(\w+)\((.*?)\)$/)) { |
862
|
|
|
|
|
|
|
my $argsref = $self->pack_eval_args($args); |
863
|
|
|
|
|
|
|
if (!defined $argsref) { |
864
|
|
|
|
|
|
|
$self->lint_warn("syntax error for eval function $name: $text"); |
865
|
91
|
50
|
|
|
|
316
|
next; |
866
|
91
|
|
|
|
|
843
|
} |
867
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS) { |
868
|
0
|
|
|
|
|
0
|
$conf->{body_evals}->{$priority}->{$name} = [ $function, [@$argsref] ]; |
869
|
|
|
|
|
|
|
} |
870
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_HEAD_EVALS) { |
871
|
91
|
|
|
|
|
670
|
$conf->{head_evals}->{$priority}->{$name} = [ $function, [@$argsref] ]; |
872
|
91
|
|
|
|
|
582
|
} |
873
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_RBL_EVALS) { |
874
|
|
|
|
|
|
|
# We don't do priorities for $Mail::SpamAssassin::Conf::TYPE_RBL_EVALS |
875
|
|
|
|
|
|
|
# we also use the arrayref instead of the packed string |
876
|
91
|
50
|
|
|
|
455
|
$conf->{rbl_evals}->{$name} = [ $function, [@$argsref] ]; |
877
|
91
|
|
|
|
|
564
|
} |
878
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_RAWBODY_EVALS) { |
879
|
|
|
|
|
|
|
$conf->{rawbody_evals}->{$priority}->{$name} = [ $function, [@$argsref] ]; |
880
|
91
|
|
|
|
|
625
|
} |
881
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_FULL_EVALS) { |
882
|
91
|
|
|
|
|
197
|
$conf->{full_evals}->{$priority}->{$name} = [ $function, [@$argsref] ]; |
|
3787
|
|
|
|
|
10760
|
|
883
|
3696
|
|
|
|
|
5022
|
} |
884
|
3696
|
|
100
|
|
|
8567
|
#elsif ($type == $Mail::SpamAssassin::Conf::TYPE_URI_EVALS) { |
885
|
3696
|
|
|
|
|
5418
|
# $conf->{uri_evals}->{$priority}->{$name} = [ $function, [@$argsref] ]; |
886
|
|
|
|
|
|
|
#} |
887
|
|
|
|
|
|
|
else { |
888
|
3696
|
100
|
|
|
|
6103
|
$self->lint_warn("unknown type $type for $name: $text", $name); |
889
|
2713
|
50
|
|
|
|
13213
|
next; |
890
|
2713
|
|
|
|
|
5313
|
} |
891
|
2713
|
50
|
|
|
|
6616
|
} |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
892
|
0
|
|
|
|
|
0
|
else { |
893
|
0
|
|
|
|
|
0
|
$self->lint_warn("syntax error for eval function $name: $text", $name); |
894
|
|
|
|
|
|
|
next; |
895
|
|
|
|
|
|
|
} |
896
|
84
|
|
|
|
|
612
|
} |
897
|
|
|
|
|
|
|
# non-eval tests |
898
|
|
|
|
|
|
|
else { |
899
|
2323
|
|
|
|
|
10963
|
if ($type == $Mail::SpamAssassin::Conf::TYPE_BODY_TESTS) { |
900
|
|
|
|
|
|
|
$conf->{body_tests}->{$priority}->{$name} = $text; |
901
|
|
|
|
|
|
|
} |
902
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_HEAD_TESTS) { |
903
|
|
|
|
|
|
|
$conf->{head_tests}->{$priority}->{$name} = $text; |
904
|
1
|
|
|
|
|
6
|
} |
905
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_META_TESTS) { |
906
|
|
|
|
|
|
|
$conf->{meta_tests}->{$priority}->{$name} = $text; |
907
|
0
|
|
|
|
|
0
|
} |
908
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_URI_TESTS) { |
909
|
|
|
|
|
|
|
$conf->{uri_tests}->{$priority}->{$name} = $text; |
910
|
305
|
|
|
|
|
1512
|
} |
911
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_RAWBODY_TESTS) { |
912
|
|
|
|
|
|
|
$conf->{rawbody_tests}->{$priority}->{$name} = $text; |
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_FULL_TESTS) { |
915
|
|
|
|
|
|
|
$conf->{full_tests}->{$priority}->{$name} = $text; |
916
|
0
|
|
|
|
|
0
|
} |
917
|
0
|
|
|
|
|
0
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_EMPTY_TESTS) { |
918
|
|
|
|
|
|
|
} |
919
|
|
|
|
|
|
|
else { |
920
|
|
|
|
|
|
|
$self->lint_warn("unknown type $type for $name: $text", $name); |
921
|
0
|
|
|
|
|
0
|
next; |
922
|
0
|
|
|
|
|
0
|
} |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
$self->lint_trusted_networks(); |
927
|
983
|
100
|
|
|
|
2111
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
928
|
231
|
|
|
|
|
929
|
if (!$isuserconf) { |
929
|
|
|
|
|
|
|
$conf->{main}->call_plugins("finish_parsing_end", { conf => $conf }); |
930
|
|
|
|
|
|
|
} else { |
931
|
558
|
|
|
|
|
1721
|
$conf->{main}->call_plugins("user_conf_parsing_end", { conf => $conf }); |
932
|
|
|
|
|
|
|
} |
933
|
|
|
|
|
|
|
|
934
|
132
|
|
|
|
|
477
|
$conf->found_any_rules(); # before we might delete {tests} |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
if (!$conf->{allow_user_rules}) { |
937
|
62
|
|
|
|
|
335
|
# free up stuff we no longer need |
938
|
|
|
|
|
|
|
delete $conf->{tests}; |
939
|
|
|
|
|
|
|
delete $conf->{priority}; |
940
|
0
|
|
|
|
|
0
|
#test_types are needed - see bug 5503 |
941
|
|
|
|
|
|
|
#delete $conf->{test_types}; |
942
|
|
|
|
|
|
|
} |
943
|
0
|
|
|
|
|
0
|
} |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
my ($self) = @_; |
946
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
947
|
|
|
|
|
|
|
$conf->{meta_dependencies} = { }; |
948
|
0
|
|
|
|
|
0
|
|
949
|
0
|
|
|
|
|
0
|
foreach my $name (keys %{$conf->{tests}}) { |
950
|
|
|
|
|
|
|
next unless ($conf->{test_types}->{$name} |
951
|
|
|
|
|
|
|
== $Mail::SpamAssassin::Conf::TYPE_META_TESTS); |
952
|
|
|
|
|
|
|
my $alreadydone = {}; |
953
|
|
|
|
|
|
|
$self->_meta_deps_recurse($conf, $name, $name, $alreadydone); |
954
|
91
|
|
|
|
|
1282
|
} |
955
|
|
|
|
|
|
|
} |
956
|
91
|
50
|
|
|
|
264
|
|
957
|
91
|
|
|
|
|
667
|
my ($self, $conf, $toprule, $name, $alreadydone) = @_; |
958
|
|
|
|
|
|
|
|
959
|
0
|
|
|
|
|
0
|
# Avoid recomputing the dependencies of a rule |
960
|
|
|
|
|
|
|
return split(' ', $conf->{meta_dependencies}->{$name}) if defined $conf->{meta_dependencies}->{$name}; |
961
|
|
|
|
|
|
|
|
962
|
91
|
|
|
|
|
1055
|
# Obviously, don't trace empty or nonexistent rules |
963
|
|
|
|
|
|
|
my $rule = $conf->{tests}->{$name}; |
964
|
91
|
50
|
|
|
|
344
|
unless ($rule) { |
965
|
|
|
|
|
|
|
$conf->{meta_dependencies}->{$name} = ''; |
966
|
91
|
|
|
|
|
2009
|
return ( ); |
967
|
91
|
|
|
|
|
1130
|
} |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
# Avoid infinite recursion |
970
|
|
|
|
|
|
|
return ( ) if exists $alreadydone->{$name}; |
971
|
|
|
|
|
|
|
$alreadydone->{$name} = ( ); |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
my %deps; |
974
|
91
|
|
|
91
|
0
|
279
|
|
975
|
91
|
|
|
|
|
202
|
# Lex the rule into tokens using a rather simple RE method ... |
976
|
91
|
|
|
|
|
368
|
my @tokens = ($rule =~ /($ARITH_EXPRESSION_LEXER)/og); |
977
|
|
|
|
|
|
|
|
978
|
91
|
|
|
|
|
194
|
# Go through each token in the meta rule |
|
91
|
|
|
|
|
1076
|
|
979
|
3697
|
100
|
|
|
|
7123
|
my $conf_tests = $conf->{tests}; |
980
|
|
|
|
|
|
|
foreach my $token (@tokens) { |
981
|
132
|
|
|
|
|
275
|
# has to be an alpha+numeric token |
982
|
132
|
|
|
|
|
644
|
next if $token =~ tr{A-Za-z0-9_}{}c || substr($token,0,1) =~ tr{A-Za-z_}{}c; # even faster |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
# and has to be a rule name |
985
|
|
|
|
|
|
|
next unless exists $conf_tests->{$token}; |
986
|
|
|
|
|
|
|
|
987
|
447
|
|
|
447
|
|
846
|
# add and recurse |
988
|
|
|
|
|
|
|
$deps{untaint_var($token)} = ( ); |
989
|
|
|
|
|
|
|
my @subdeps = $self->_meta_deps_recurse($conf, $toprule, $token, $alreadydone); |
990
|
447
|
100
|
|
|
|
942
|
@deps{@subdeps} = ( ); |
991
|
|
|
|
|
|
|
} |
992
|
|
|
|
|
|
|
$conf->{meta_dependencies}->{$name} = join (' ', keys %deps); |
993
|
443
|
|
|
|
|
1029
|
return keys %deps; |
994
|
443
|
50
|
|
|
|
978
|
} |
995
|
0
|
|
|
|
|
0
|
|
996
|
0
|
|
|
|
|
0
|
my ($self) = @_; |
997
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
die unless $conf->{meta_dependencies}; # order requirement |
1000
|
443
|
50
|
|
|
|
872
|
my $pri = $conf->{priority}; |
1001
|
443
|
|
|
|
|
673
|
|
1002
|
|
|
|
|
|
|
# sort into priority order, lowest first -- this way we ensure that if we |
1003
|
443
|
|
|
|
|
484
|
# rearrange the pri of a rule early on, we cannot accidentally increase its |
1004
|
|
|
|
|
|
|
# priority later. |
1005
|
|
|
|
|
|
|
foreach my $rule (sort { |
1006
|
443
|
|
|
|
|
9782
|
$pri->{$a} <=> $pri->{$b} |
1007
|
|
|
|
|
|
|
} keys %{$pri}) |
1008
|
|
|
|
|
|
|
{ |
1009
|
443
|
|
|
|
|
1090
|
# we only need to worry about meta rules -- they are the |
1010
|
443
|
|
|
|
|
806
|
# only type of rules which depend on other rules |
1011
|
|
|
|
|
|
|
my $deps = $conf->{meta_dependencies}->{$rule}; |
1012
|
3860
|
100
|
100
|
|
|
11353
|
next unless (defined $deps); |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
my $basepri = $pri->{$rule}; |
1015
|
1637
|
100
|
|
|
|
3923
|
foreach my $dep (split ' ', $deps) { |
1016
|
|
|
|
|
|
|
my $deppri = $pri->{$dep}; |
1017
|
|
|
|
|
|
|
if ($deppri > $basepri) { |
1018
|
315
|
|
|
|
|
872
|
dbg("rules: $rule (pri $basepri) requires $dep (pri $deppri): fixed"); |
1019
|
315
|
|
|
|
|
1298
|
$pri->{$dep} = $basepri; |
1020
|
315
|
|
|
|
|
652
|
} |
1021
|
|
|
|
|
|
|
} |
1022
|
443
|
|
|
|
|
1281
|
} |
1023
|
443
|
|
|
|
|
1626
|
} |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
my ($self) = @_; |
1026
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
1027
|
91
|
|
|
91
|
0
|
242
|
|
1028
|
91
|
|
|
|
|
205
|
my %names_for_text; |
1029
|
|
|
|
|
|
|
my %dups; |
1030
|
91
|
50
|
|
|
|
278
|
while (my ($name, $text) = each %{$conf->{tests}}) { |
1031
|
91
|
|
|
|
|
276
|
my $type = $conf->{test_types}->{$name}; |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
# skip eval and empty tests |
1034
|
|
|
|
|
|
|
next if ($type & 1) || |
1035
|
|
|
|
|
|
|
($type eq $Mail::SpamAssassin::Conf::TYPE_EMPTY_TESTS); |
1036
|
91
|
|
|
|
|
252
|
|
1037
|
9041
|
|
|
|
|
12569
|
my $tf = ($conf->{tflags}->{$name}||''); $tf =~ s/\s+/ /gs; |
1038
|
91
|
|
|
|
|
1306
|
# ensure similar, but differently-typed, rules are not marked as dups; |
1039
|
|
|
|
|
|
|
# take tflags into account too due to "tflags multiple" |
1040
|
|
|
|
|
|
|
$text = "$type\t$text\t$tf"; |
1041
|
|
|
|
|
|
|
|
1042
|
3700
|
|
|
|
|
4636
|
if (defined $names_for_text{$text}) { |
1043
|
3700
|
100
|
|
|
|
5544
|
$names_for_text{$text} .= " ".$name; |
1044
|
|
|
|
|
|
|
$dups{$text} = undef; # found (at least) one |
1045
|
443
|
|
|
|
|
573
|
} else { |
1046
|
443
|
|
|
|
|
1017
|
$names_for_text{$text} = $name; |
1047
|
317
|
|
|
|
|
450
|
} |
1048
|
317
|
100
|
|
|
|
710
|
} |
1049
|
7
|
|
|
|
|
166
|
|
1050
|
7
|
|
|
|
|
21
|
foreach my $text (keys %dups) { |
1051
|
|
|
|
|
|
|
my $first; |
1052
|
|
|
|
|
|
|
my $first_pri; |
1053
|
|
|
|
|
|
|
my @names = sort {$a cmp $b} split(' ', $names_for_text{$text}); |
1054
|
|
|
|
|
|
|
foreach my $name (@names) { |
1055
|
|
|
|
|
|
|
my $priority = $conf->{priority}->{$name} || 0; |
1056
|
|
|
|
|
|
|
|
1057
|
91
|
|
|
91
|
0
|
239
|
if (!defined $first || $priority < $first_pri) { |
1058
|
91
|
|
|
|
|
213
|
$first_pri = $priority; |
1059
|
|
|
|
|
|
|
$first = $name; |
1060
|
91
|
|
|
|
|
182
|
} |
1061
|
|
|
|
|
|
|
} |
1062
|
91
|
|
|
|
|
240
|
# $first is now the earliest-occurring rule. mark others as dups |
|
3788
|
|
|
|
|
10317
|
|
1063
|
3697
|
|
|
|
|
4466
|
|
1064
|
|
|
|
|
|
|
my @dups; |
1065
|
|
|
|
|
|
|
foreach my $name (@names) { |
1066
|
3697
|
100
|
66
|
|
|
8481
|
next if $name eq $first; |
1067
|
|
|
|
|
|
|
push @dups, $name; |
1068
|
|
|
|
|
|
|
delete $conf->{tests}->{$name}; |
1069
|
984
|
|
100
|
|
|
2450
|
} |
|
984
|
|
|
|
|
1576
|
|
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
dbg("rules: $first merged duplicates: ".join(' ', @dups)); |
1072
|
984
|
|
|
|
|
2378
|
$conf->{duplicate_rules}->{$first} = \@dups; |
1073
|
|
|
|
|
|
|
} |
1074
|
984
|
100
|
|
|
|
1982
|
} |
1075
|
1
|
|
|
|
|
5
|
|
1076
|
1
|
|
|
|
|
4
|
# Deprecated function |
1077
|
|
|
|
|
|
|
warn "deprecated function pack_eval_method() used\n"; |
1078
|
983
|
|
|
|
|
3262
|
return ('',undef); |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
my ($self, $args) = @_; |
1082
|
91
|
|
|
|
|
688
|
|
1083
|
1
|
|
|
|
|
3
|
return [] if $args =~ /^\s+$/; |
1084
|
|
|
|
|
|
|
|
1085
|
1
|
|
|
|
|
5
|
# bug 4419: Parse quoted strings, unquoted alphanumerics/floats, |
|
1
|
|
|
|
|
5
|
|
1086
|
1
|
|
|
|
|
4
|
# unquoted IPv4 and IPv6 addresses, and unquoted common domain names. |
1087
|
2
|
|
50
|
|
|
15
|
# s// is used so that we can determine whether or not we successfully |
1088
|
|
|
|
|
|
|
# parsed ALL arguments. |
1089
|
2
|
100
|
66
|
|
|
16
|
my @args; |
1090
|
1
|
|
|
|
|
2
|
local($1,$2,$3); |
1091
|
1
|
|
|
|
|
3
|
while ($args =~ s/^\s* (?: (['"]) (.*?) \1 | ( [\d\.:A-Za-z-]+? ) ) |
1092
|
|
|
|
|
|
|
\s* (?: , \s* | $ )//x) { |
1093
|
|
|
|
|
|
|
# DO NOT UNTAINT THESE ARGS |
1094
|
|
|
|
|
|
|
# The eval function that handles these should do that as necessary, |
1095
|
|
|
|
|
|
|
# we have no idea what acceptable arguments look like here. |
1096
|
1
|
|
|
|
|
15
|
push @args, defined $2 ? $2 : $3; |
1097
|
1
|
|
|
|
|
2
|
} |
1098
|
2
|
100
|
|
|
|
6
|
|
1099
|
1
|
|
|
|
|
4
|
if ($args ne '') { |
1100
|
1
|
|
|
|
|
4
|
return undef; ## no critic (ProhibitExplicitReturnUndef) |
1101
|
|
|
|
|
|
|
} |
1102
|
|
|
|
|
|
|
|
1103
|
1
|
|
|
|
|
8
|
return \@args; |
1104
|
1
|
|
|
|
|
11
|
} |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
########################################################################### |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
my ($self) = @_; |
1109
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
1110
|
0
|
|
|
0
|
0
|
0
|
|
1111
|
0
|
|
|
|
|
0
|
# validate trusted_networks and internal_networks, bug 4760. |
1112
|
|
|
|
|
|
|
# check that all internal_networks are listed in trusted_networks |
1113
|
|
|
|
|
|
|
# too. do the same for msa_networks, but check msa_networks against |
1114
|
|
|
|
|
|
|
# internal_networks if trusted_networks aren't defined |
1115
|
2713
|
|
|
2713
|
0
|
5360
|
|
1116
|
|
|
|
|
|
|
my ($nt, $matching_against); |
1117
|
2713
|
50
|
|
|
|
5561
|
if ($conf->{trusted_networks_configured}) { |
1118
|
|
|
|
|
|
|
$nt = $conf->{trusted_networks}; |
1119
|
|
|
|
|
|
|
$matching_against = 'trusted_networks'; |
1120
|
|
|
|
|
|
|
} elsif ($conf->{internal_networks_configured}) { |
1121
|
|
|
|
|
|
|
$nt = $conf->{internal_networks}; |
1122
|
|
|
|
|
|
|
$matching_against = 'internal_networks'; |
1123
|
2713
|
|
|
|
|
2994
|
} else { |
1124
|
2713
|
|
|
|
|
6750
|
return; |
1125
|
2713
|
|
|
|
|
7498
|
} |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
foreach my $net_type ('internal_networks', 'msa_networks') { |
1128
|
|
|
|
|
|
|
next unless $conf->{"${net_type}_configured"}; |
1129
|
|
|
|
|
|
|
next if $net_type eq $matching_against; |
1130
|
1554
|
50
|
|
|
|
6832
|
|
1131
|
|
|
|
|
|
|
my $replace_nets; |
1132
|
|
|
|
|
|
|
my @valid_net_list; |
1133
|
2713
|
50
|
|
|
|
4955
|
my $net_list = $conf->{$net_type}; |
1134
|
0
|
|
|
|
|
0
|
|
1135
|
|
|
|
|
|
|
foreach my $net (@{$net_list->{nets}}) { |
1136
|
|
|
|
|
|
|
# don't check to see if an excluded network is included - that's senseless |
1137
|
2713
|
|
|
|
|
7102
|
if (!$net->{exclude} && !$nt->contains_net($net)) { |
1138
|
|
|
|
|
|
|
my $msg = "$matching_against doesn't contain $net_type entry '". |
1139
|
|
|
|
|
|
|
($net->{as_string})."'"; |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
$self->lint_warn($msg, undef); # complain |
1142
|
|
|
|
|
|
|
$replace_nets = 1; # and omit it from the new internal set |
1143
|
91
|
|
|
91
|
0
|
265
|
} |
1144
|
91
|
|
|
|
|
222
|
else { |
1145
|
|
|
|
|
|
|
push @valid_net_list, $net; |
1146
|
|
|
|
|
|
|
} |
1147
|
|
|
|
|
|
|
} |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
if ($replace_nets) { |
1150
|
|
|
|
|
|
|
# something was invalid. replace the old nets list with a fixed version |
1151
|
91
|
|
|
|
|
208
|
# (which may be empty) |
1152
|
91
|
100
|
|
|
|
364
|
$net_list->{nets} = \@valid_net_list; |
|
|
100
|
|
|
|
|
|
1153
|
28
|
|
|
|
|
73
|
} |
1154
|
28
|
|
|
|
|
54
|
} |
1155
|
|
|
|
|
|
|
} |
1156
|
1
|
|
|
|
|
3
|
|
1157
|
1
|
|
|
|
|
3
|
########################################################################### |
1158
|
|
|
|
|
|
|
|
1159
|
62
|
|
|
|
|
164
|
my ($self, $name, $text, $type) = @_; |
1160
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
1161
|
|
|
|
|
|
|
|
1162
|
29
|
|
|
|
|
94
|
# Don't allow invalid names ... |
1163
|
58
|
100
|
|
|
|
218
|
if ($name !~ IS_RULENAME) { |
1164
|
16
|
100
|
|
|
|
61
|
$self->lint_warn("config: error: rule '$name' has invalid characters ". |
1165
|
|
|
|
|
|
|
"(not Alphanumeric + Underscore + starting with a non-digit)\n", $name); |
1166
|
15
|
|
|
|
|
29
|
return; |
1167
|
|
|
|
|
|
|
} |
1168
|
15
|
|
|
|
|
39
|
|
1169
|
|
|
|
|
|
|
# Also set a hard limit for ALL rules (rule names longer than 40 |
1170
|
15
|
|
|
|
|
23
|
# characters throw warnings). Check this separately from the above |
|
15
|
|
|
|
|
55
|
|
1171
|
|
|
|
|
|
|
# pattern to avoid vague error messages. |
1172
|
38
|
100
|
100
|
|
|
205
|
if (length $name > 100) { |
1173
|
|
|
|
|
|
|
$self->lint_warn("config: error: rule '$name' is too long ". |
1174
|
4
|
|
|
|
|
27
|
"(recommended maximum length is 22 characters)\n", $name); |
1175
|
|
|
|
|
|
|
return; |
1176
|
4
|
|
|
|
|
97
|
} |
1177
|
4
|
|
|
|
|
13
|
|
1178
|
|
|
|
|
|
|
# Warn about, but use, long rule names during --lint |
1179
|
|
|
|
|
|
|
if ($conf->{lint_rules}) { |
1180
|
34
|
|
|
|
|
78
|
if (length($name) > 40 && $name !~ /^__/ && $name !~ /^T_/) { |
1181
|
|
|
|
|
|
|
$self->lint_warn("config: warning: rule name '$name' is over 40 chars ". |
1182
|
|
|
|
|
|
|
"(recommended maximum length is 22 characters)\n", $name); |
1183
|
|
|
|
|
|
|
} |
1184
|
15
|
100
|
|
|
|
59
|
} |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
# parameter to compile_regexp() |
1187
|
4
|
|
|
|
|
37
|
my $ignore_amre = |
1188
|
|
|
|
|
|
|
$self->{conf}->{lint_rules} || |
1189
|
|
|
|
|
|
|
$self->{conf}->{ignore_always_matching_regexps}; |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
# all of these rule types are regexps |
1192
|
|
|
|
|
|
|
if ($type == $Mail::SpamAssassin::Conf::TYPE_BODY_TESTS || |
1193
|
|
|
|
|
|
|
$type == $Mail::SpamAssassin::Conf::TYPE_FULL_TESTS || |
1194
|
|
|
|
|
|
|
$type == $Mail::SpamAssassin::Conf::TYPE_RAWBODY_TESTS || |
1195
|
3697
|
|
|
3697
|
0
|
10279
|
$type == $Mail::SpamAssassin::Conf::TYPE_URI_TESTS) |
1196
|
3697
|
|
|
|
|
6432
|
{ |
1197
|
|
|
|
|
|
|
my ($rec, $err) = compile_regexp($text, 1, $ignore_amre); |
1198
|
|
|
|
|
|
|
if (!$rec) { |
1199
|
3697
|
50
|
|
|
|
10542
|
$self->lint_warn("config: invalid regexp for $name '$text': $err", $name); |
1200
|
0
|
|
|
|
|
0
|
return; |
1201
|
|
|
|
|
|
|
} |
1202
|
0
|
|
|
|
|
0
|
$conf->{test_qrs}->{$name} = $rec; |
1203
|
|
|
|
|
|
|
} |
1204
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_HEAD_TESTS) |
1205
|
|
|
|
|
|
|
{ |
1206
|
|
|
|
|
|
|
local($1,$2,$3); |
1207
|
|
|
|
|
|
|
# RFC 5322 section 3.6.8, ftext printable US-ASCII chars not including ":" |
1208
|
3697
|
50
|
|
|
|
8695
|
# no re "strict"; # since perl 5.21.8: Ranges of ASCII printables... |
1209
|
0
|
|
|
|
|
0
|
if ($text =~ /^exists:(.*)/) { |
1210
|
|
|
|
|
|
|
my $hdr = $1; |
1211
|
0
|
|
|
|
|
0
|
# check :addr etc header options |
1212
|
|
|
|
|
|
|
# $hdr used in eval text, validate carefully |
1213
|
|
|
|
|
|
|
if ($hdr !~ /^[\w.-]+:?$/) { |
1214
|
|
|
|
|
|
|
$self->lint_warn("config: invalid head test $name header: $hdr"); |
1215
|
3697
|
100
|
|
|
|
7266
|
return; |
1216
|
1888
|
0
|
33
|
|
|
4186
|
} |
|
|
|
33
|
|
|
|
|
1217
|
0
|
|
|
|
|
0
|
$hdr =~ s/:$//; |
1218
|
|
|
|
|
|
|
$conf->{test_opt_header}->{$name} = $hdr; |
1219
|
|
|
|
|
|
|
$conf->{test_opt_exists}->{$name} = 1; |
1220
|
|
|
|
|
|
|
} else { |
1221
|
|
|
|
|
|
|
# $hdr used in eval text, validate carefully |
1222
|
|
|
|
|
|
|
if ($text !~ /^([\w.-]+(?:\:|(?:\:[a-z]+){1,2})?)\s*([=!]~)\s*(.+)$/) { |
1223
|
|
|
|
|
|
|
$self->lint_warn("config: invalid head test $name: $text"); |
1224
|
|
|
|
|
|
|
return; |
1225
|
3697
|
|
66
|
|
|
8936
|
} |
1226
|
|
|
|
|
|
|
my ($hdr, $op, $pat) = ($1, $2, $3); |
1227
|
|
|
|
|
|
|
$hdr =~ s/:$//; |
1228
|
3697
|
100
|
66
|
|
|
21332
|
if ($pat =~ s/\s+\[if-unset:\s+(.+)\]$//) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
1229
|
|
|
|
|
|
|
$conf->{test_opt_unset}->{$name} = $1; |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
my ($rec, $err) = compile_regexp($pat, 1, $ignore_amre); |
1232
|
|
|
|
|
|
|
if (!$rec) { |
1233
|
294
|
|
|
|
|
1136
|
$self->lint_warn("config: invalid regexp for $name '$pat': $err", $name); |
1234
|
294
|
50
|
|
|
|
834
|
return; |
1235
|
0
|
|
|
|
|
0
|
} |
1236
|
0
|
|
|
|
|
0
|
$conf->{test_qrs}->{$name} = $rec; |
1237
|
|
|
|
|
|
|
$conf->{test_opt_header}->{$name} = $hdr; |
1238
|
294
|
|
|
|
|
1088
|
$conf->{test_opt_neg}->{$name} = 1 if $op eq '!~'; |
1239
|
|
|
|
|
|
|
} |
1240
|
|
|
|
|
|
|
} |
1241
|
|
|
|
|
|
|
elsif ($type == $Mail::SpamAssassin::Conf::TYPE_META_TESTS) |
1242
|
558
|
|
|
|
|
1670
|
{ |
1243
|
|
|
|
|
|
|
if ($self->is_meta_valid($name, $text)) { |
1244
|
|
|
|
|
|
|
# Untaint now once and not repeatedly later |
1245
|
558
|
100
|
|
|
|
1708
|
$text = untaint_var($text); |
1246
|
62
|
|
|
|
|
294
|
} else { |
1247
|
|
|
|
|
|
|
return; |
1248
|
|
|
|
|
|
|
} |
1249
|
62
|
50
|
|
|
|
438
|
} |
1250
|
0
|
|
|
|
|
0
|
|
1251
|
0
|
|
|
|
|
0
|
$conf->{tests}->{$name} = $text; |
1252
|
|
|
|
|
|
|
$conf->{test_types}->{$name} = $type; |
1253
|
62
|
|
|
|
|
198
|
|
1254
|
62
|
|
|
|
|
288
|
if ($name =~ /AUTOLEARNTEST/i) { |
1255
|
62
|
|
|
|
|
391
|
dbg("config: auto-learn: $name has type $type = $conf->{test_types}->{$name} during add_test\n"); |
1256
|
|
|
|
|
|
|
} |
1257
|
|
|
|
|
|
|
|
1258
|
496
|
50
|
|
|
|
2864
|
|
1259
|
0
|
|
|
|
|
0
|
if ($type == $Mail::SpamAssassin::Conf::TYPE_META_TESTS) { |
1260
|
0
|
|
|
|
|
0
|
$conf->{priority}->{$name} ||= 500; |
1261
|
|
|
|
|
|
|
} |
1262
|
496
|
|
|
|
|
2239
|
else { |
1263
|
496
|
|
|
|
|
876
|
$conf->{priority}->{$name} ||= 0; |
1264
|
496
|
100
|
|
|
|
2114
|
} |
1265
|
124
|
|
|
|
|
624
|
$conf->{priority}->{$name} ||= 0; |
1266
|
|
|
|
|
|
|
$conf->{source_file}->{$name} = $self->{currentfile}; |
1267
|
496
|
|
|
|
|
1765
|
|
1268
|
496
|
50
|
|
|
|
1192
|
if ($conf->{main}->{keep_config_parsing_metadata}) { |
1269
|
0
|
|
|
|
|
0
|
$conf->{if_stack}->{$name} = $self->get_if_stack_as_string(); |
1270
|
0
|
|
|
|
|
0
|
|
1271
|
|
|
|
|
|
|
if ($self->{file_scoped_attrs}->{testrules}) { |
1272
|
496
|
|
|
|
|
1558
|
$conf->{testrules}->{$name} = 1; # used in build/mkupdates/listpromotable |
1273
|
496
|
|
|
|
|
1504
|
} |
1274
|
496
|
100
|
|
|
|
2724
|
} |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
# if we found this rule in a user_prefs file, it's a user rule -- note that |
1277
|
|
|
|
|
|
|
# we may need to recompile the rule code for this type (if they've already |
1278
|
|
|
|
|
|
|
# been compiled, e.g. in spamd). |
1279
|
132
|
50
|
|
|
|
607
|
# |
1280
|
|
|
|
|
|
|
# Note: the want_rebuild_for_type 'flag' is actually a counter; it is decremented |
1281
|
132
|
|
|
|
|
415
|
# after each scan. This ensures that we always recompile at least once more; |
1282
|
|
|
|
|
|
|
# once to *define* the rule, and once afterwards to *undefine* the rule in the |
1283
|
0
|
|
|
|
|
0
|
# compiled ruleset again. |
1284
|
|
|
|
|
|
|
# |
1285
|
|
|
|
|
|
|
# If two consecutive scans use user rules, that's ok -- the second one will |
1286
|
|
|
|
|
|
|
# reset the counter, and we'll still recompile just once afterwards to undefine |
1287
|
3697
|
|
|
|
|
11601
|
# the rule again. |
1288
|
3697
|
|
|
|
|
6686
|
# |
1289
|
|
|
|
|
|
|
if ($self->{scoresonly}) { |
1290
|
3697
|
50
|
|
|
|
7576
|
$conf->{want_rebuild_for_type}->{$type} = 2; |
1291
|
0
|
|
|
|
|
0
|
$conf->{user_defined_rules}->{$name} = 1; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
} |
1294
|
|
|
|
|
|
|
|
1295
|
3697
|
100
|
|
|
|
5817
|
my ($self, $name, $ok_or_fail, $string) = @_; |
1296
|
132
|
|
50
|
|
|
815
|
my $conf = $self->{conf}; |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
if ($conf->{regression_tests}->{$name}) { |
1299
|
3565
|
|
50
|
|
|
13243
|
push @{$conf->{regression_tests}->{$name}}, [$ok_or_fail, $string]; |
1300
|
|
|
|
|
|
|
} |
1301
|
3697
|
|
100
|
|
|
14045
|
else { |
1302
|
3697
|
|
|
|
|
8871
|
# initialize the array, and create one element |
1303
|
|
|
|
|
|
|
$conf->{regression_tests}->{$name} = [ [$ok_or_fail, $string] ]; |
1304
|
3697
|
50
|
|
|
|
7659
|
} |
1305
|
0
|
|
|
|
|
0
|
} |
1306
|
|
|
|
|
|
|
|
1307
|
0
|
0
|
|
|
|
0
|
my ($self, $name, $rule) = @_; |
1308
|
0
|
|
|
|
|
0
|
|
1309
|
|
|
|
|
|
|
# $meta is a degenerate translation of the rule, replacing all variables (i.e. rule names) with 0. |
1310
|
|
|
|
|
|
|
my $meta = ''; |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
# Paranoid check (Bug #7557) |
1313
|
|
|
|
|
|
|
if ($rule =~ /(?:\:\:|->)/) { |
1314
|
|
|
|
|
|
|
warn("config: invalid meta $name rule: $rule") ; |
1315
|
|
|
|
|
|
|
return 0; |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
# Process expandable functions before lexing |
1319
|
|
|
|
|
|
|
$rule =~ s/${META_RULES_MATCHING_RE}/ 0 /g; |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
# Lex the rule into tokens using a rather simple RE method ... |
1322
|
|
|
|
|
|
|
my @tokens = ($rule =~ /($ARITH_EXPRESSION_LEXER)/og); |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
# Go through each token in the meta rule |
1325
|
3697
|
50
|
|
|
|
19373
|
foreach my $token (@tokens) { |
1326
|
0
|
|
|
|
|
0
|
# If the token is a syntactically legal rule name, make it zero |
1327
|
0
|
|
|
|
|
0
|
if ($token =~ IS_RULENAME) { |
1328
|
|
|
|
|
|
|
$meta .= "0 "; |
1329
|
|
|
|
|
|
|
} |
1330
|
|
|
|
|
|
|
# if it is a (decimal) number or a string of 1 or 2 punctuation |
1331
|
|
|
|
|
|
|
# characters (i.e. operators) tack it onto the degenerate rule |
1332
|
0
|
|
|
0
|
0
|
0
|
elsif ($token =~ /^(\d+(?:\.\d+)?|[[:punct:]]{1,2})\z/s) { |
1333
|
0
|
|
|
|
|
0
|
$meta .= "$token "; |
1334
|
|
|
|
|
|
|
} |
1335
|
0
|
0
|
|
|
|
0
|
# Skip anything unknown (Bug #7557) |
1336
|
0
|
|
|
|
|
0
|
else { |
|
0
|
|
|
|
|
0
|
|
1337
|
|
|
|
|
|
|
$self->lint_warn("config: invalid meta $name token: $token", $name); |
1338
|
|
|
|
|
|
|
return 0; |
1339
|
|
|
|
|
|
|
} |
1340
|
0
|
|
|
|
|
0
|
} |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
$meta = untaint_var($meta); # was carefully checked |
1343
|
|
|
|
|
|
|
my $evalstr = 'my $x = '.$meta.'; 1;'; |
1344
|
|
|
|
|
|
|
if (eval $evalstr) { |
1345
|
132
|
|
|
132
|
0
|
518
|
return 1; |
1346
|
|
|
|
|
|
|
} |
1347
|
|
|
|
|
|
|
my $err = $@ ne '' ? $@ : "errno=$!"; chomp $err; |
1348
|
132
|
|
|
|
|
338
|
$err =~ s/\s+(?:at|near)\b.*//s; |
1349
|
|
|
|
|
|
|
$err =~ s/Illegal division by zero/division by zero possible/i; |
1350
|
|
|
|
|
|
|
$self->lint_warn("config: invalid expression for rule $name: \"$rule\": $err\n", $name); |
1351
|
132
|
50
|
|
|
|
654
|
return 0; |
1352
|
0
|
|
|
|
|
0
|
} |
1353
|
0
|
|
|
|
|
0
|
|
1354
|
|
|
|
|
|
|
# Deprecated functions, leave just in case.. |
1355
|
|
|
|
|
|
|
my ($self, $rule, $re) = @_; |
1356
|
|
|
|
|
|
|
warn "deprecated is_delimited_regexp_valid() called, use compile_regexp()\n"; |
1357
|
132
|
|
|
|
|
912
|
my ($rec, $err) = compile_regexp($re, 1, 1); |
1358
|
|
|
|
|
|
|
return $rec; |
1359
|
|
|
|
|
|
|
} |
1360
|
132
|
|
|
|
|
5145
|
my ($self, $rule, $re) = @_; |
1361
|
|
|
|
|
|
|
warn "deprecated is_regexp_valid() called, use compile_regexp()\n"; |
1362
|
|
|
|
|
|
|
my ($rec, $err) = compile_regexp($re, 1, 1); |
1363
|
132
|
|
|
|
|
694
|
return $rec; |
1364
|
|
|
|
|
|
|
} |
1365
|
817
|
100
|
|
|
|
2625
|
warn "deprecated is_always_matching_regexp() called\n"; |
|
|
50
|
|
|
|
|
|
1366
|
334
|
|
|
|
|
751
|
return; |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
########################################################################### |
1370
|
|
|
|
|
|
|
|
1371
|
483
|
|
|
|
|
1177
|
my ($self, $singlelist, @addrs) = @_; |
1372
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
foreach my $addr (@addrs) { |
1375
|
0
|
|
|
|
|
0
|
$addr = lc $addr; |
1376
|
0
|
|
|
|
|
0
|
my $re = $addr; |
1377
|
|
|
|
|
|
|
$re =~ s/[\000\\\(]/_/gs; # paranoia |
1378
|
|
|
|
|
|
|
$re =~ s/([^\*\?_a-zA-Z0-9])/\\$1/g; # escape any possible metachars |
1379
|
|
|
|
|
|
|
$re =~ tr/?/./; # "?" -> "." |
1380
|
132
|
|
|
|
|
514
|
$re =~ s/\*+/\.\*/g; # "*" -> "any string" |
1381
|
132
|
|
|
|
|
481
|
$conf->{$singlelist}->{$addr} = "^${re}\$"; |
1382
|
132
|
50
|
|
|
|
7793
|
} |
1383
|
132
|
|
|
|
|
851
|
} |
1384
|
|
|
|
|
|
|
|
1385
|
0
|
0
|
|
|
|
0
|
my ($self, $listname, $addr, $domain) = @_; |
|
0
|
|
|
|
|
0
|
|
1386
|
0
|
|
|
|
|
0
|
my $conf = $self->{conf}; |
1387
|
0
|
|
|
|
|
0
|
|
1388
|
0
|
|
|
|
|
0
|
$domain = lc $domain; |
1389
|
0
|
|
|
|
|
0
|
$addr = lc $addr; |
1390
|
|
|
|
|
|
|
if ($conf->{$listname}->{$addr}) { |
1391
|
|
|
|
|
|
|
push @{$conf->{$listname}->{$addr}{domain}}, $domain; |
1392
|
|
|
|
|
|
|
} |
1393
|
|
|
|
|
|
|
else { |
1394
|
0
|
|
|
0
|
0
|
0
|
my $re = $addr; |
1395
|
0
|
|
|
|
|
0
|
$re =~ s/[\000\\\(]/_/gs; # paranoia |
1396
|
0
|
|
|
|
|
0
|
$re =~ s/([^\*\?_a-zA-Z0-9])/\\$1/g; # escape any possible metachars |
1397
|
0
|
|
|
|
|
0
|
$re =~ tr/?/./; # "?" -> "." |
1398
|
|
|
|
|
|
|
$re =~ s/\*+/\.\*/g; # "*" -> "any string" |
1399
|
|
|
|
|
|
|
$conf->{$listname}->{$addr}{re} = "^${re}\$"; |
1400
|
0
|
|
|
0
|
0
|
0
|
$conf->{$listname}->{$addr}{domain} = [ $domain ]; |
1401
|
0
|
|
|
|
|
0
|
} |
1402
|
0
|
|
|
|
|
0
|
} |
1403
|
0
|
|
|
|
|
0
|
|
1404
|
|
|
|
|
|
|
my ($self, $singlelist, @addrs) = @_; |
1405
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
1406
|
0
|
|
|
0
|
0
|
0
|
|
1407
|
0
|
|
|
|
|
0
|
foreach my $addr (@addrs) { |
1408
|
|
|
|
|
|
|
delete($conf->{$singlelist}->{lc $addr}); |
1409
|
|
|
|
|
|
|
} |
1410
|
|
|
|
|
|
|
} |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
my ($self, $listname, @addrs) = @_; |
1413
|
34
|
|
|
34
|
0
|
56
|
my $conf = $self->{conf}; |
1414
|
34
|
|
|
|
|
41
|
|
1415
|
|
|
|
|
|
|
foreach my $addr (@addrs) { |
1416
|
34
|
|
|
|
|
49
|
delete($conf->{$listname}->{lc $addr}); |
1417
|
34
|
|
|
|
|
44
|
} |
1418
|
34
|
|
|
|
|
36
|
} |
1419
|
34
|
|
|
|
|
55
|
|
1420
|
34
|
|
|
|
|
161
|
add_to_addrlist_rcvd(@_); |
1421
|
34
|
|
|
|
|
56
|
} |
1422
|
34
|
|
|
|
|
51
|
|
1423
|
34
|
|
|
|
|
140
|
my ($self, $listname, $addr, $domain) = @_; |
1424
|
|
|
|
|
|
|
my $conf = $self->{conf}; |
1425
|
|
|
|
|
|
|
my $conf_lname = $conf->{$listname}; |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
$addr = lc $addr; |
1428
|
0
|
|
|
0
|
0
|
0
|
if ($conf_lname->{$addr}) { |
1429
|
0
|
|
|
|
|
0
|
$domain = lc $domain; |
1430
|
|
|
|
|
|
|
my $domains_listref = $conf_lname->{$addr}{domain}; |
1431
|
0
|
|
|
|
|
0
|
# removing $domain from the list |
1432
|
0
|
|
|
|
|
0
|
my @replacement = grep { lc $_ ne $domain } @$domains_listref; |
1433
|
0
|
0
|
|
|
|
0
|
if (!@replacement) { # nothing left, remove the entire addr entry |
1434
|
0
|
|
|
|
|
0
|
delete($conf_lname->{$addr}); |
|
0
|
|
|
|
|
0
|
|
1435
|
|
|
|
|
|
|
} elsif (@replacement != @$domains_listref) { # anything changed? |
1436
|
|
|
|
|
|
|
$conf_lname->{$addr}{domain} = \@replacement; |
1437
|
0
|
|
|
|
|
0
|
} |
1438
|
0
|
|
|
|
|
0
|
} |
1439
|
0
|
|
|
|
|
0
|
} |
1440
|
0
|
|
|
|
|
0
|
|
1441
|
0
|
|
|
|
|
0
|
|
1442
|
0
|
|
|
|
|
0
|
########################################################################### |
1443
|
0
|
|
|
|
|
0
|
|
1444
|
|
|
|
|
|
|
my ($self, $path) = @_; |
1445
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
# the path may be specified as "~/foo", so deal with that |
1447
|
|
|
|
|
|
|
$path = $self->{conf}->{main}->sed_path($path); |
1448
|
0
|
|
|
0
|
0
|
0
|
|
1449
|
0
|
|
|
|
|
0
|
if (!File::Spec->file_name_is_absolute ($path)) { |
1450
|
|
|
|
|
|
|
my ($vol, $dirs, $file) = File::Spec->splitpath ($self->{currentfile}); |
1451
|
0
|
|
|
|
|
0
|
$path = File::Spec->catpath ($vol, $dirs, $path); |
1452
|
0
|
|
|
|
|
0
|
dbg("config: fixed relative path: $path"); |
1453
|
|
|
|
|
|
|
} |
1454
|
|
|
|
|
|
|
return $path; |
1455
|
|
|
|
|
|
|
} |
1456
|
|
|
|
|
|
|
|
1457
|
0
|
|
|
0
|
0
|
0
|
########################################################################### |
1458
|
0
|
|
|
|
|
0
|
|
1459
|
|
|
|
|
|
|
my ($self, $msg, $rule, $iserror) = @_; |
1460
|
0
|
|
|
|
|
0
|
|
1461
|
0
|
|
|
|
|
0
|
if (!defined $iserror) { $iserror = 1; } |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
if ($self->{conf}->{main}->{lint_callback}) { |
1464
|
|
|
|
|
|
|
$self->{conf}->{main}->{lint_callback}->( |
1465
|
|
|
|
|
|
|
msg => $msg, |
1466
|
0
|
|
|
0
|
0
|
0
|
rule => $rule, |
1467
|
|
|
|
|
|
|
iserror => $iserror |
1468
|
|
|
|
|
|
|
); |
1469
|
|
|
|
|
|
|
} |
1470
|
0
|
|
|
0
|
0
|
0
|
elsif ($self->{conf}->{lint_rules}) { |
1471
|
0
|
|
|
|
|
0
|
warn $msg."\n"; |
1472
|
0
|
|
|
|
|
0
|
} |
1473
|
|
|
|
|
|
|
else { |
1474
|
0
|
|
|
|
|
0
|
info($msg); |
1475
|
0
|
0
|
|
|
|
0
|
} |
1476
|
0
|
|
|
|
|
0
|
|
1477
|
0
|
|
|
|
|
0
|
if ($iserror) { |
1478
|
|
|
|
|
|
|
$self->{conf}->{errors}++; |
1479
|
0
|
|
|
|
|
0
|
} |
|
0
|
|
|
|
|
0
|
|
1480
|
0
|
0
|
|
|
|
0
|
} |
|
|
0
|
|
|
|
|
|
1481
|
0
|
|
|
|
|
0
|
|
1482
|
|
|
|
|
|
|
########################################################################### |
1483
|
0
|
|
|
|
|
0
|
|
1484
|
|
|
|
|
|
|
my ($self) = @_; |
1485
|
|
|
|
|
|
|
return join ' ', map { |
1486
|
|
|
|
|
|
|
$_->{conditional} |
1487
|
|
|
|
|
|
|
} @{$self->{if_stack}}; |
1488
|
|
|
|
|
|
|
} |
1489
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
########################################################################### |
1491
|
|
|
|
|
|
|
|
1492
|
0
|
|
|
0
|
0
|
0
|
1; |