| #!/usr/bin/perl -T |
| |
| use lib '.'; use lib 't'; |
| use SATest; sa_t_init("recursion"); |
| use Test::More tests => 10; |
| use IO::File; |
| |
| # --------------------------------------------------------------------------- |
| |
| %patterns = ( |
| q{X-Spam-Status: }, 'headerfound', |
| ); |
| |
| # --------------------------------------------------------------------------- |
| |
| my $msg1 = q{From: foo |
| Message-Id: <bar> |
| To: baz |
| Subject: testing recursion |
| Content-Type: multipart/report; report-type=delivery-status; |
| boundary="__BOUND__" |
| |
| --__BOUND__ |
| |
| This is the report. |
| |
| --__BOUND__ |
| Content-Type: message/delivery-status |
| |
| Reporting-MTA: dns; example.org |
| Diagnostic-Info: hi! |
| |
| --__BOUND__ |
| Content-Type: message/rfc822 |
| |
| __MSG__ |
| |
| --__BOUND__-- |
| |
| }; |
| |
| my $msg2 = q{From: foo |
| Message-Id: <bar> |
| To: baz |
| Subject: testing recursion 2 |
| Content-Type: multipart/mixed; boundary="__BOUND__" |
| |
| |
| --__BOUND__ |
| Content-Type: text/plain; charset="us-ascii" |
| MIME-Version: 1.0 |
| Content-Transfer-Encoding: 7bit |
| |
| hi! |
| |
| --__BOUND__ |
| Content-Type: message/rfc822 |
| MIME-Version: 1.0 |
| |
| __MSG__ |
| |
| --__BOUND__-- |
| |
| }; |
| |
| # --------------------------------------------------------------------------- |
| |
| sub create_test_message { |
| my $msg = shift; |
| |
| my $boundstr = "AAAAAAAAAAAAAAAAAAA"; |
| my $bound = $boundstr; $boundstr++; |
| my $text = $msg; |
| $text =~ s/__BOUND__/${bound}/g; |
| |
| for my $i (1 .. 600) { |
| my $newmsg = $msg; |
| $bound = $boundstr; $boundstr++; |
| $newmsg =~ s/__BOUND__/${bound}/g; |
| $newmsg =~ s/__MSG__/${text}/g; |
| $text = $newmsg; |
| } |
| |
| open (OUT, ">$workdir/recurse.eml") or die; |
| print OUT $text; |
| close OUT or die; |
| } |
| |
| sub create_test_message_3 { |
| my $boundstr = "AAAAAAAAAAAAAAAAAAA"; |
| my $bound = $boundstr; $boundstr++; |
| my $text = q{From: foo |
| Message-Id: <bar> |
| To: baz |
| Subject: testing recursion 3 |
| }; |
| |
| for my $i (1 .. 600) { |
| $text .= qq{Content-Type: multipart/mixed; boundary="$boundstr" |
| |
| --$boundstr |
| }; |
| $boundstr++; |
| } |
| |
| open (OUT, ">$workdir/recurse.eml") or die; |
| print OUT $text; |
| close OUT or die; |
| } |
| |
| sub try_scan { |
| my $fh = IO::File->new_tmpfile(); |
| ok($fh); |
| open(STDERR, ">&=".fileno($fh)) || die "Cannot reopen STDERR"; |
| sarun("-D -L -t < $workdir/recurse.eml", |
| \&patterns_run_cb); |
| seek($fh, 0, 0); |
| my $error = do { |
| local $/; |
| <$fh>; |
| }; |
| |
| print "# $error\n"; |
| if ($error =~ /Deep recursion on subroutine/) { ok(0); } |
| else { ok(1); } |
| |
| ok_all_patterns(); |
| } |
| |
| create_test_message($msg1); |
| try_scan(); |
| create_test_message($msg2); |
| try_scan(); |
| create_test_message_3(); |
| try_scan(); |
| |
| ok(unlink "$workdir/recurse.eml"); |