#!/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; # MIME::ToolUtils->debugging(1); # MIME::ToolUtils->emulate_tmpfile('CLONE'); 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";