—#!/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
++) {
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;
}
}
"Who-hooo! Done!\n"
;