-
Notifications
You must be signed in to change notification settings - Fork 70
/
uri_list.t
executable file
·144 lines (122 loc) · 3.91 KB
/
uri_list.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#!/usr/bin/perl -T
# Tests for Bug #7591, which is actually a bug seen in the EL7 build of Perl.
# The real root cause is obscure, so we test for the bug not the Perl version.
use lib '.'; use lib 't';
use strict;
use Test::More tests=> 12;
use Mail::SpamAssassin::Util;
use SATest; sa_t_init("uri_list");
use warnings;
use Cwd;
my $twoplus = <<'EOT';
Message-ID: <clean.1010101@x.com>
Date: Mon, 07 Oct 2002 09:00:00 +0000
From: Sender <sender@x.com>
MIME-Version: 1.0
To: Recipient <recipient@x.com>
Subject: this is a trivial message
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 8bit
an url: http://host1.example.com
an url: http://host2.example.com
EOT
my $threeurls = <<'EOT';
Message-ID: <clean.1010101@x.com>
Date: Mon, 07 Oct 2002 09:00:00 +0000
From: Sender <sender@x.com>
MIME-Version: 1.0
To: Recipient <recipient@x.com>
Subject: this is a trivial message
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 8bit
http://host1.example.com
http://host2.example.com
http://host3.example.com
EOT
my $threeplus = <<'EOT';
Message-ID: <clean.1010101@x.com>
Date: Mon, 07 Oct 2002 09:00:00 +0000
From: Sender <sender@x.com>
MIME-Version: 1.0
To: Recipient <recipient@x.com>
Subject: this is a trivial message
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 8bit
an url: http://host1.example.com
an url: http://host2.example.com
an url: http://host3.example.com
EOT
my $foururls = <<'EOT';
Message-ID: <clean.1010101@x.com>
Date: Mon, 07 Oct 2002 09:00:00 +0000
From: Sender <sender@x.com>
MIME-Version: 1.0
To: Recipient <recipient@x.com>
Subject: this is a trivial message
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 8bit
an url: http://host1.example.com
an url: http://host2.example.com
an url: http://host3.example.com
an url: http://host4.example.com
EOT
my $fiveurls = <<'EOT';
Message-ID: <clean.1010101@x.com>
Date: Mon, 07 Oct 2002 09:00:00 +0000
From: Sender <sender@x.com>
MIME-Version: 1.0
To: Recipient <recipient@x.com>
Subject: this is a trivial message
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 8bit
an url: http://host1.example.com
an url: http://host2.example.com
an url: http://host3.example.com
an url: http://host4.example.com
an url: http://host5.example.com
EOT
my $sixurls = <<'EOT';
Message-ID: <clean.1010101@example.com>
Date: Mon, 07 Oct 2002 09:00:00 +0000
From: Sender <sender@example.com>
MIME-Version: 1.0
To: Recipient <recipient@example.com>
Subject: this is a trivial message
Content-Type: text/plain; charset="UTF-8"
Content-Transfer-Encoding: 8bit
http://host1.example.com
http://host2.example.com
http://host3.example.com
http://host4.example.com
http://host5.example.com
http://host6.example.com
EOT
my $tmpdir = mk_safe_tmpdir();
for my $mail ($twoplus, $threeurls, $threeplus, $foururls, $fiveurls, $sixurls) {
my @urls = grep(/\bhttp:/m,$mail);
my $count = () = $mail =~ /\bhttp:\/\//g;
#warn "$count urls in message\n";
# initialize SpamAssassin
my $sa = create_saobj({dont_copy_prefs => 1});
$sa->init(0); # parse rules
my $mailobj = $sa->parse($mail);
my $msg = Mail::SpamAssassin::PerMsgStatus->new($sa, $mailobj);
my @urilist = $msg->get_uri_list();
my $ulcnt = $#urilist + 1 ;
#warn "$ulcnt urls in parselist\n";
ok ( $count == $ulcnt );
$sa->finish();
# this is ugly, but it actually demos the bug.
open (my $mfh, ">", "$tmpdir/msg");
print $mfh "$mail";
my $haverules = ( -f "../rules/25_uribl.cf" ) ;
my $sarcnt = qx/..\/spamassassin -D all < $tmpdir\/msg 2>&1 |grep -c 'uridnsbl:.*skip'/;
# test isn't very useful without this component, but this will at least skip the subtest when it can't be run
SKIP: {
skip "No rules found!\n", 1 if (! $haverules );
if (!ok ( $count == $sarcnt )) {
warn "Simple grep for http:// found $count URLs, get_uri_list found $ulcnt URLs, spamassassin script found $sarcnt\n";
}
}
}
cleanup_safe_tmpdir();