← Back to branch summary

~ubuntu-branches/ubuntu/utopic/spamassassin/utopic-updates

« back to all changes in this revision

Viewing changes to t/dnsbl_subtests.t

  • Committer: Package Import Robot
  • Author(s): Noah Meyerhans
  • Date: 2014-02-14 22:45:15 UTC
  • mfrom: (0.8.1) (0.6.2) (5.1.22 sid)
  • Revision ID: package-import@ubuntu.com-20140214224515-z1es2twos8xh7n2y
Tags: 3.4.0-1
http://bugs.debian.org/738963
http://bugs.debian.org/738872
http://bugs.debian.org/738867
http://bugs.debian.org/738951
http://bugs.debian.org/738974
* New upstream version! (Closes: 738963, 738872, 738867)
* Scrub the environment when switching to the debian-spamd user in
  postinst and cron.daily. (Closes: 738951)
* Enhancements to postinst to better manage ownership of
  /var/lib/spamassassin, via Iain Lane <iain.lane@canonical.com>
  (Closes: 738974)

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/dnsbl_subtests.t
 
1
#!/usr/bin/perl
 
2
 
 
3
# supporting tests for: Bug 6362 - Change urirhssub mask syntax
 
4
 
 
5
use strict;
 
6
use warnings;
 
7
use re 'taint';
 
8
use lib '.'; use lib 't';
 
9
 
 
10
use SATest; sa_t_init("dnsbl_subtests");
 
11
use Test;
 
12
 
 
13
use vars qw(%patterns %anti_patterns);
 
14
use constant num_tests => 46;
 
15
use constant DO_RUN => 1;
 
16
 
 
17
BEGIN {
 
18
  plan tests => (DO_RUN ? num_tests : 0);
 
19
};
 
20
 
 
21
exit unless DO_RUN;
 
22
 
 
23
my $prefix = '.';
 
24
if (-e 'test_dir') {            # running from test directory, not ..
 
25
  $prefix = '..';
 
26
}
 
27
 
 
28
use Errno qw(EADDRINUSE EACCES);
 
29
use Net::DNS::Nameserver;
 
30
use Mail::SpamAssassin;
 
31
 
 
32
# Bug 5761 (no 127.0.0.1 in jail, use SPAMD_LOCALHOST if specified)
 
33
my $dns_server_localaddr = $ENV{'SPAMD_LOCALHOST'};
 
34
if (!$dns_server_localaddr) {
 
35
  $dns_server_localaddr = $have_inet4 ? '127.0.0.1' : '::1';
 
36
}
 
37
 
 
38
my $use_inet4 =
 
39
  !$have_inet6 ||
 
40
  ($have_inet4 && $dns_server_localaddr =~ /^\d+\.\d+\.\d+\.\d+\z/);
 
41
 
 
42
sub find_free_port($);  # prototype
 
43
my($dns_server_localport, $sock_udp, $sock_tcp) =
 
44
  find_free_port($dns_server_localaddr);
 
45
 
 
46
$dns_server_localport  or die "Failed to obtain a free port number";
 
47
 
 
48
printf("Using %s [%s]:%s for a spawned test DNS server\n",
 
49
       $use_inet4 ? 'inet' : 'inet6',
 
50
       $dns_server_localaddr, $dns_server_localport);
 
51
 
 
52
# test zone names (lowercase!)
 
53
my $z  = 'sa1-dbl-test.spamassassin.org';
 
54
my $z2 = 'sa2-dbl-test.spamassassin.org';
 
55
 
 
56
my $local_conf = <<"EOD";
 
57
  use_bayes 0
 
58
  use_razor2 0
 
59
  use_pyzor 0
 
60
# use_auto_whitelist 0
 
61
# use_dcc 0
 
62
  score NO_RELAYS 0
 
63
  score NO_RECEIVED 0
 
64
  score TVD_SPACE_RATIO 0
 
65
 
 
66
  rbl_timeout 5
 
67
  dns_available yes
 
68
  clear_dns_servers
 
69
  dns_server [$dns_server_localaddr]:$dns_server_localport
 
70
 
 
71
# zone 1
 
72
  urirhssub  X_URIBL_Y_2A   $z  A  127.0.1.2
 
73
  body       X_URIBL_Y_2A   eval:check_uridnsbl('X_URIBL_Y_2A')
 
74
  tflags     X_URIBL_Y_2A   domains_only
 
75
 
 
76
  urirhssub  X_URIBL_Y_2B   $z  A  127.0.1.2-127.0.1.2
 
77
  body       X_URIBL_Y_2B   eval:check_uridnsbl('X_URIBL_Y_2B')
 
78
  tflags     X_URIBL_Y_2B   domains_only
 
79
 
 
80
  urirhssub  X_URIBL_Y_2C   $z  A  127.0.1.2/0xffffffff
 
81
  body       X_URIBL_Y_2C   eval:check_uridnsbl('X_URIBL_Y_2C')
 
82
  tflags     X_URIBL_Y_2C   domains_only
 
83
 
 
84
  urirhssub  X_URIBL_Y_2D   $z  A  127.0.1.2/255.255.255.255
 
85
  body       X_URIBL_Y_2D   eval:check_uridnsbl('X_URIBL_Y_2D')
 
86
  tflags     X_URIBL_Y_2D   domains_only
 
87
 
 
88
  urirhssub  X_URIBL_Y_2E   $z  A  127.0.1.2/127.0.1.2
 
89
  body       X_URIBL_Y_2E   eval:check_uridnsbl('X_URIBL_Y_2E')
 
90
  tflags     X_URIBL_Y_2E   domains_only
 
91
 
 
92
  urirhssub  X_URIBL_Y_2F   $z  A  0/128.255.254.253
 
93
  body       X_URIBL_Y_2F   eval:check_uridnsbl('X_URIBL_Y_2F')
 
94
  tflags     X_URIBL_Y_2F   domains_only
 
95
 
 
96
  urirhssub  X_URIBL_Y_2G   $z  A  2
 
97
  body       X_URIBL_Y_2G   eval:check_uridnsbl('X_URIBL_Y_2G')
 
98
  tflags     X_URIBL_Y_2G   domains_only
 
99
 
 
100
  urirhssub  X_URIBL_N_2G   $z  A  5
 
101
  body       X_URIBL_N_2G   eval:check_uridnsbl('X_URIBL_N_2G')
 
102
  tflags     X_URIBL_N_2G   domains_only
 
103
 
 
104
  urirhssub  X_URIBL_Y_ANY  $z  A  127.0.1.1-127.0.1.254
 
105
  body       X_URIBL_Y_ANY  eval:check_uridnsbl('X_URIBL_Y_ANY')
 
106
  tflags     X_URIBL_Y_ANY  domains_only
 
107
 
 
108
  urirhssub  X_URIBL_Y_3    $z  A  127.0.1.3-127.0.1.19
 
109
  body       X_URIBL_Y_3    eval:check_uridnsbl('X_URIBL_Y_3')
 
110
  tflags     X_URIBL_Y_3    domains_only
 
111
 
 
112
  urirhssub  X_URIBL_N_3    $z  A  127.0.1.4-127.0.1.18
 
113
  body       X_URIBL_N_3    eval:check_uridnsbl('X_URIBL_Y_3')
 
114
  tflags     X_URIBL_N_3    domains_only
 
115
 
 
116
  urirhssub  X_URIBL_Y_FFA  $z  A  255.255.255.0
 
117
  body       X_URIBL_Y_FFA  eval:check_uridnsbl('X_URIBL_Y_FFA')
 
118
  tflags     X_URIBL_Y_FFA  domains_only
 
119
 
 
120
  urirhssub  X_URIBL_Y_FFB  $z  A  255.0.255.0/0xFF00FFff
 
121
  body       X_URIBL_Y_FFB  eval:check_uridnsbl('X_URIBL_Y_FFB')
 
122
  tflags     X_URIBL_Y_FFB  domains_only
 
123
 
 
124
  urirhssub  X_URIBL_Y_FFC  $z  A  0xFFffFF00/0xFFffFFff
 
125
  body       X_URIBL_Y_FFC  eval:check_uridnsbl('X_URIBL_Y_FFC')
 
126
  tflags     X_URIBL_Y_FFC  domains_only
 
127
 
 
128
  urirhssub  X_URIBL_Y_FFD  $z  A  0x80000000
 
129
  body       X_URIBL_Y_FFD  eval:check_uridnsbl('X_URIBL_Y_FFD')
 
130
  tflags     X_URIBL_Y_FFD  domains_only
 
131
 
 
132
  urirhssub  X_URIBL_N_0A   $z  A  127.0.0.0
 
133
  body       X_URIBL_N_0A   eval:check_uridnsbl('X_URIBL_N_0A')
 
134
  tflags     X_URIBL_N_0A   domains_only
 
135
 
 
136
  urirhssub  X_URIBL_N_0B   $z  A  127.0.1.0
 
137
  body       X_URIBL_N_0B   eval:check_uridnsbl('X_URIBL_N_0B')
 
138
  tflags     X_URIBL_N_0B   domains_only
 
139
 
 
140
  urirhssub  X_URIBL_N_255A $z  A  127.0.1.255
 
141
  body       X_URIBL_N_255A eval:check_uridnsbl('X_URIBL_N_255A')
 
142
  tflags     X_URIBL_N_255A domains_only
 
143
 
 
144
  urirhssub  X_URIBL_N_255B $z  A  0.0.0.255/0.0.0.255
 
145
  body       X_URIBL_N_255B eval:check_uridnsbl('X_URIBL_N_255B')
 
146
  tflags     X_URIBL_N_255B domains_only
 
147
 
 
148
# zone 2
 
149
  urirhssub  X_URIBL_Y_2AZ2 $z2  A  127.0.1.2
 
150
  body       X_URIBL_Y_2AZ2 eval:check_uridnsbl('X_URIBL_Y_2AZ2')
 
151
 
 
152
  urirhssub  X_URIBL_Y_255A $z2  A  127.0.1.255
 
153
  body       X_URIBL_Y_255A eval:check_uridnsbl('X_URIBL_Y_255A')
 
154
 
 
155
  urirhssub  X_URIBL_Y_255B $z2  A  0.0.0.255/0.0.0.255
 
156
  body       X_URIBL_Y_255B eval:check_uridnsbl('X_URIBL_Y_255B')
 
157
EOD
 
158
 
 
159
my(@testzone) = map { chomp; s/[ \t]+//; $_ } split(/^/, <<"EOD");
 
160
  $z               3600 IN SOA  ns.$z hostmaster.$z (1 10800 1800 2419200 3600)
 
161
  $z               3600 IN NS   ns.$z
 
162
  $z               3600 IN MX 0 .
 
163
  ns.$z            3600 IN A    127.0.0.1
 
164
  ns.$z            3600 IN AAAA ::1
 
165
  dbltest.com.$z   3600 IN A    127.0.1.2
 
166
  dbltest.com.$z   3600 IN TXT  "test answer on dbltest.com"
 
167
  dbltest03.com.$z 3600 IN A    127.0.1.3
 
168
  dbltest19.com.$z 3600 IN A    127.0.1.19
 
169
  dbltest20.com.$z 3600 IN A    127.0.1.20
 
170
  dbltest21.com.$z 3600 IN A    127.0.1.21
 
171
  dbltest39.com.$z 3600 IN A    127.0.1.39
 
172
  dbltest40.com.$z 3600 IN A    127.0.1.40
 
173
  dbltest50.com.$z 3600 IN A    127.0.1.50
 
174
  dbltest59.com.$z 3600 IN A    127.0.1.59
 
175
  dbltest99.com.$z 3600 IN A    127.0.1.99
 
176
  dbltestff.com.$z 3600 IN A    255.255.255.0
 
177
  dbltestER.com.$z 3600 IN A    127.0.1.255
 
178
  dbltestER.com.$z 3600 IN TXT  "No IP queries allowed"
 
179
 
 
180
  $z2              3600 IN SOA  ns.$z2 master.$z2 (1 10800 1800 2419200 3600)
 
181
  $z2              3600 IN NS   ns.$z2
 
182
  $z2              3600 IN MX 0 .
 
183
  ns.$z2           3600 IN A    127.0.0.1
 
184
  ns.$z2           3600 IN AAAA ::1
 
185
  dbltest.com.$z2  3600 IN A    127.0.1.2
 
186
EOD
 
187
 
 
188
# ---------------------------------------------------------------------------
 
189
 
 
190
sub reply_handler {
 
191
  my($qname, $qclass, $qtype, $peerhost,$query,$conn) = @_;
 
192
  my($rcode, @ans, @auth, @add);
 
193
  my $qclass_uc = uc $qclass;
 
194
  my $qtype_uc  = uc $qtype;
 
195
# print "Received query from $peerhost to ". $conn->{"sockhost"}. "\n";
 
196
# $query->print;
 
197
  $rcode = "NXDOMAIN";
 
198
  for my $rec_str (@testzone) {
 
199
    next if $rec_str =~ /^#/ || $rec_str =~ /^\s*$/;
 
200
    my($rrname,$rrttl,$rrclass,$rrtype,$rrdata) = split(' ',$rec_str,5);
 
201
    if ($qclass_uc eq uc($rrclass) && lc($rrname) eq lc($qname)) {
 
202
      $rcode = 'NOERROR';
 
203
      if ($qtype_uc eq uc($rrtype) || $qtype_uc eq 'ANY') {
 
204
        push(@ans, Net::DNS::RR->new(
 
205
                     join(' ', $qname, $rrttl, $qclass, $rrtype, $rrdata)));
 
206
      }
 
207
    }
 
208
  }
 
209
  # special DBL test case - numerical IP query handling
 
210
    # Bug 6983: Uninitialized value in lc in t/dnsbl_subtests for X_URIBL_Y_255A
 
211
    # Unicode case folding bug present in at least perl-5.8.[678], fixed 5.8.9
 
212
    # avoid case-insensitive regexp match, $z and $z2 are already in lowercase
 
213
  if ($qclass_uc eq 'IN' && lc $qname =~ /^[0-9.]+\.(?:\Q$z\E|\Q$z2\E)\z/s) {
 
214
    $rcode = 'NOERROR';
 
215
    if ($qtype_uc eq 'A' || $qtype_uc eq 'ANY') {
 
216
      push(@ans, Net::DNS::RR->new(join(' ',
 
217
                 $qname, '3600', $qclass, 'A', '127.0.1.255')));
 
218
    }
 
219
    if ($qtype_uc eq 'TXT' || $qtype_uc eq 'ANY') {
 
220
      push(@ans, Net::DNS::RR->new(join(' ',
 
221
                 $qname, '3600', $qclass, 'TXT', '"No IP queries allowed"')));
 
222
    }
 
223
  }
 
224
  return ($rcode, \@ans, \@auth, \@add);
 
225
}
 
226
 
 
227
sub dns_server($$) {
 
228
  my($local_addr, $local_port) = @_;
 
229
  my $ns = Net::DNS::Nameserver->new(
 
230
    LocalAddr => $local_addr, LocalPort => $local_port,
 
231
    ReplyHandler => \&reply_handler, Verbose => 0);
 
232
  $ns  or die "Cannot create a nameserver object";
 
233
  $ns->main_loop;
 
234
}
 
235
 
 
236
sub find_free_port($) {
 
237
  my($addr) = @_;
 
238
  my($port, $sock_udp, $sock_tcp);
 
239
  for (1..20) {  # choose a pair of free tcp & udp ports
 
240
    $port = 11001 + int(rand(65536-11001));
 
241
    my %args = (LocalAddr => $addr, LocalPort => $port);
 
242
    $sock_udp = $use_inet4 ? IO::Socket::INET->new(%args, Proto => 'udp')
 
243
                           : IO::Socket::INET6->new(%args, Proto => 'udp');
 
244
    $sock_udp || $! == EADDRINUSE || $! == EACCES
 
245
      or printf("Error creating UDP socket [%s]:%s: %s\n", $addr, $port, $!);
 
246
    $sock_tcp = $use_inet4 ? IO::Socket::INET->new(%args, Proto => 'tcp')
 
247
                           : IO::Socket::INET6->new(%args, Proto => 'tcp');
 
248
    $sock_tcp || $! == EADDRINUSE || $! == EACCES
 
249
      or printf("Error creating %s TCP socket [%s]:%s: %s\n",
 
250
                $use_inet4 ? 'inet' : 'inet6', $addr, $port, $!);
 
251
    last if $sock_tcp && $sock_udp;
 
252
  }
 
253
  undef $port if !$sock_tcp || !$sock_udp;
 
254
  return ($port, $sock_udp, $sock_tcp);
 
255
}
 
256
 
 
257
# ---------------------------------------------------------------------------
 
258
 
 
259
my $spamassassin_obj;
 
260
 
 
261
sub process_sample_urls(@) {
 
262
  my(@url_list) = @_;
 
263
  my($mail_obj, $per_msg_status, $spam_report);
 
264
  $spamassassin_obj->timer_reset;
 
265
 
 
266
  my $msg = <<'EOD';
 
267
From: "DNSBL Testing" <ab@example.org>
 
268
To: someone@example.org
 
269
Subject: test
 
270
Date: Mon, 8 Mar 2010 15:10:44 +0100
 
271
Message-Id: <test.123.test@example.org>
 
272
 
 
273
EOD
 
274
  $msg .= $_."\n" for @url_list;
 
275
 
 
276
  $mail_obj = $spamassassin_obj->parse($msg,0);
 
277
  if ($mail_obj) {
 
278
    local($1,$2,$3,$4,$5,$6);  # avoid Perl 5.8.x bug, $1 can get tainted
 
279
    $per_msg_status = $spamassassin_obj->check($mail_obj);
 
280
  }
 
281
  if ($per_msg_status) {
 
282
    $spam_report = $per_msg_status->get_tag('REPORT');
 
283
    $per_msg_status->finish;
 
284
  }
 
285
  if ($mail_obj) {
 
286
    $mail_obj->finish;
 
287
  }
 
288
  $spam_report =~ s/\A(\s*\n)+//s;
 
289
# print "\t$spam_report\n";
 
290
  return $spam_report;
 
291
}
 
292
 
 
293
sub test_samples($$) {
 
294
  my($patt_antipatt_list,$url_list_ref) = @_;
 
295
  my $el = $patt_antipatt_list->[0];
 
296
  shift @$patt_antipatt_list  if @$patt_antipatt_list > 1;  # last autorepeats
 
297
  my($patt,$anti) = split(m{\s* / \s*}x, $el, 2);
 
298
  %patterns      = map { (" $_ ", $_) } split(' ',$patt);
 
299
  %anti_patterns = map { (" $_ ", $_) } split(' ',$anti);
 
300
  my $spam_report = process_sample_urls(@$url_list_ref);
 
301
  clear_pattern_counters();
 
302
  patterns_run_cb($spam_report);
 
303
  my $status = ok_all_patterns();
 
304
  printf("\nTest on %s failed:\n%s\n",
 
305
         join(', ',@$url_list_ref), $spam_report)  if !$status;
 
306
}
 
307
 
 
308
 
 
309
# there is a time gap between closing sockets and reusing them by a spawned
 
310
# DNS server - if we are very unlucky and the port is acquired by some other
 
311
# process during this short interval, our spawned DNS server will fail to start
 
312
#
 
313
if ($sock_udp) {
 
314
  $sock_udp->close()  or die "Error closing UDP socket: $!";
 
315
}
 
316
if ($sock_tcp) {
 
317
  $sock_tcp->close()  or die "Error closing TCP socket: $!";
 
318
}
 
319
 
 
320
# detach a DNS server process
 
321
my $pid = fork();
 
322
defined $pid or die "Cannot fork: $!";
 
323
if (!$pid) {  # child
 
324
  dns_server($dns_server_localaddr, $dns_server_localport);
 
325
  exit;
 
326
}
 
327
 
 
328
# parent
 
329
# print STDERR "Forked a DNS server process [$pid]\n";
 
330
sleep 1;
 
331
 
 
332
$spamassassin_obj = Mail::SpamAssassin->new({
 
333
# rules_filename      => "$prefix/t/log/test_rules_copy",
 
334
# require_rules       => 1,
 
335
  rules_filename      => "/dev/null",
 
336
  site_rules_filename => "$prefix/t/log/localrules.tmp",
 
337
  userprefs_filename  => "$prefix/masses/spamassassin/user_prefs",
 
338
  post_config_text    => $local_conf,
 
339
  dont_copy_prefs     => 1,
 
340
# debug               => 'dns,async,uridnsbl',
 
341
});
 
342
ok($spamassassin_obj);
 
343
$spamassassin_obj->compile_now;  # try to preload most modules
 
344
 
 
345
test_samples(
 
346
  [q{ X_URIBL_Y_2A X_URIBL_Y_2B X_URIBL_Y_2C X_URIBL_Y_2D X_URIBL_Y_2E
 
347
      X_URIBL_Y_2F X_URIBL_Y_2G X_URIBL_Y_ANY / X_URIBL_N_2E X_URIBL_N_2G
 
348
      X_URIBL_N_3 X_URIBL_N_0A X_URIBL_N_0B X_URIBL_N_255A X_URIBL_N_255B }],
 
349
  [qw( http://dbltest.com/ )]);
 
350
 
 
351
test_samples(
 
352
  [q{ X_URIBL_Y_2A X_URIBL_Y_2B X_URIBL_Y_2C X_URIBL_Y_2D X_URIBL_Y_2E
 
353
      X_URIBL_Y_2F X_URIBL_Y_2G X_URIBL_Y_ANY X_URIBL_Y_3 / X_URIBL_N_3
 
354
      X_URIBL_N_0A X_URIBL_N_0B X_URIBL_N_255A X_URIBL_N_255B }],
 
355
  [qw( http://dbltest.com/ http://dbltest03.com/ http://dbltest19.com/ )]);
 
356
 
 
357
test_samples(
 
358
  [q{ X_URIBL_Y_2A X_URIBL_Y_2B X_URIBL_Y_2C X_URIBL_Y_2D X_URIBL_Y_2E
 
359
      X_URIBL_Y_2F X_URIBL_Y_2G X_URIBL_Y_FFA X_URIBL_Y_FFB X_URIBL_Y_FFC
 
360
      X_URIBL_Y_255A X_URIBL_Y_255B / X_URIBL_N_0A X_URIBL_N_0B
 
361
      X_URIBL_N_255A X_URIBL_N_255B }],
 
362
  [qw( http://DBLtest.COM/ http://dbltestFF.CoM/ http://140.211.11.130/ )]);
 
363
# X_URIBL_Y_FFD no longer hits intentionally (not in the 127.0.0.0/8 range),
 
364
# see Bug 6803
 
365
 
 
366
if ($pid) {
 
367
  kill('TERM',$pid) or die "Cannot stop a DNS server [$pid]: $!";
 
368
  waitpid($pid,0);
 
369
  undef $pid;
 
370
}
 
371
 
 
372
END {
 
373
  $spamassassin_obj->finish  if $spamassassin_obj;
 
374
  kill('KILL',$pid)  if $pid;  # ignoring status
 
375
}