| Server IP : 23.254.227.96 / Your IP : 216.73.216.21 Web Server : Apache/2.4.62 (Unix) OpenSSL/1.1.1k System : Linux hwsrv-1277026.hostwindsdns.com 4.18.0-477.13.1.el8_8.x86_64 #1 SMP Tue May 30 14:53:41 EDT 2023 x86_64 User : viralblo ( 1001) PHP Version : 8.1.31 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /usr/share/doc/perl-MIME-tools/examples/ |
Upload File : |
#!/usr/bin/perl -w
=head1 NAME
mimeabuse - try hard to break MIME parsing
=head1 DESCRIPTION
This is meant to be run from the MIME-tools distribution directory
as a test. It will attempt to parse the same several messages 1000
times each. It does a purge after each parse, so it shouldn't fill up
your disk; however, it should be a good test for hitting resource
limits.
I wrote this after I discovered that, under Perl 5.002 at least,
FileHandle->new_tmpfile returned an object that did not get
destructed automatically when it exited scope. :-(
=head1 AUTHOR
Eryq, eryq@zeegee.com
=cut
use MIME::Parser;
my $parser = new MIME::Parser;
((-d "./testin") && (-d "./testout")) or
die "run this from the MIME-tools distribution directory";
$parser->output_dir("./testout");
$parser->output_to_core("NONE");
foreach $input (
'multi-simple.msg',
'multi-nested3.msg',
'mp-msg-rfc822.msg'
) {
$parser->parse_nested_messages($input eq 'mp-msg-rfc822.msg');
for ($i = 0; $i < 1000; $i++) {
print STDERR "$input: i = $i\n";
open IN, "testin/$input" or die "open testin/$input: $!";
$entity = $parser->read(\*IN) or die "MIME error";
close IN;
$entity->purge;
}
}
print "Who-hooo! Done!\n";