#!/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: 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: 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, ">log/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: To: baz Subject: testing recursion 3 }; for my $i (1 .. 600) { $text .= qq{Content-Type: multipart/mixed; boundary="$boundstr" --$boundstr }; $boundstr++; } open (OUT, ">log/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 < log/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 'log/recurse.eml');