You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@spamassassin.apache.org by bi...@apache.org on 2018/06/26 17:37:24 UTC
svn commit: r1834452 - in /spamassassin: branches/3.4/t/uri_list.t
trunk/t/uri_list.t
Author: billcole
Date: Tue Jun 26 17:37:23 2018
New Revision: 1834452
URL: http://svn.apache.org/viewvc?rev=1834452&view=rev
Log:
Test for bug 7591
Added:
spamassassin/branches/3.4/t/uri_list.t
spamassassin/trunk/t/uri_list.t
Added: spamassassin/branches/3.4/t/uri_list.t
URL: http://svn.apache.org/viewvc/spamassassin/branches/3.4/t/uri_list.t?rev=1834452&view=auto
==============================================================================
--- spamassassin/branches/3.4/t/uri_list.t (added)
+++ spamassassin/branches/3.4/t/uri_list.t Tue Jun 26 17:37:23 2018
@@ -0,0 +1,156 @@
+#!/usr/bin/perl
+
+# 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.
+
+BEGIN {
+ if (-e 't/test_dir') { # if we are running "t/rule_names.t", kluge around ...
+ chdir 't';
+ }
+
+ if (-e 'test_dir') { # running from test directory, not ..
+ unshift(@INC, '../blib/lib');
+ }
+}
+
+my $prefix = '.';
+if (-e 'test_dir') { # running from test directory, not ..
+ $prefix = '..';
+}
+
+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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@example.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@example.com>
+MIME-Version: 1.0
+To: Recipient <re...@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();
+warn "temp dir is $tmpdir\n";
+
+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 $sarcnt = qx/..\/spamassassin -D all < $tmpdir\/msg 2>&1 |grep -c 'uridnsbl:.*skip'/;
+ 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();
+
Added: spamassassin/trunk/t/uri_list.t
URL: http://svn.apache.org/viewvc/spamassassin/trunk/t/uri_list.t?rev=1834452&view=auto
==============================================================================
--- spamassassin/trunk/t/uri_list.t (added)
+++ spamassassin/trunk/t/uri_list.t Tue Jun 26 17:37:23 2018
@@ -0,0 +1,156 @@
+#!/usr/bin/perl
+
+# 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.
+
+BEGIN {
+ if (-e 't/test_dir') { # if we are running "t/rule_names.t", kluge around ...
+ chdir 't';
+ }
+
+ if (-e 'test_dir') { # running from test directory, not ..
+ unshift(@INC, '../blib/lib');
+ }
+}
+
+my $prefix = '.';
+if (-e 'test_dir') { # running from test directory, not ..
+ $prefix = '..';
+}
+
+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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@x.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@x.com>
+MIME-Version: 1.0
+To: Recipient <re...@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: <cl...@example.com>
+Date: Mon, 07 Oct 2002 09:00:00 +0000
+From: Sender <se...@example.com>
+MIME-Version: 1.0
+To: Recipient <re...@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();
+warn "temp dir is $tmpdir\n";
+
+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 $sarcnt = qx/..\/spamassassin -D all < $tmpdir\/msg 2>&1 |grep -c 'uridnsbl:.*skip'/;
+ 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();
+