2 # this is a library of perl routines for MIME parsing.
5 if( $use_mime eq "yes" ){
7 require Convert::UU; import uudecode;
12 my $entity = pop( @_ );
14 my $type = $entity->mime_type;
15 my $body = $entity->stringify_body;
17 if( $type =~ /^text\// ) {
18 my $filename = $entity->bodyhandle->path;
19 $filename =~ s/.*\///;
20 print TEXT_FILES $filename . "\n" or die $!;
24 last if( $count++ > 15 );
25 my ($data, $name, $mode ) = &uudecode( $body );
28 if( $data && $name ) {
29 $body =~ s/\nbegin.*?\nend\n/((((Encoded File: $name))))\n/s;
30 if( open( FILE, ">$dir/$name" ) ) {
31 print FILE $data or die $!;
33 chmod 0644, $file or die $!;
35 my $filename = $entity->bodyhandle->path;
36 open( REDUCED, ">$filename" ) or die $!;
37 print REDUCED $body or die $!;
38 close( REDUCED ) or die $!;
52 sub decode_mime_message {
58 # Create parser, and set the output directory:
59 my $parser = new MIME::Parser;
60 $parser->output_dir( $dir );
63 $entity = $parser->read(\*STDIN) or die "couldn't parse MIME stream";
65 open( FULL, ">$dir/full_message.txt" ) or die $!;
66 print FULL $entity->as_string or die $!;
67 close( FULL ) or die $!;
70 my $RealSubject = "Real-Subject: " . $entity->head->get( "Subject" );
72 my $prolog = "From: " . $entity->head->get( "From" ) . "$RealSubject\n";
74 open( SKELETON, ">$dir/skeleton.skeleton" );
75 $entity->dump_skeleton( \*SKELETON );
78 open( HEAD, ">$dir/headers.txt" ) or die $!;
79 print HEAD $entity->head->as_string . "\n" or die $!;
80 close( HEAD ) or die $!;
82 open( TEXT_FILES, ">$dir/text.files.lst" ) or die $!;
84 print TEXT_FILES "headers.txt\n" or die $!;
86 my $body = &uudecode_text( $entity, $dir );
87 $body =~ /(.*\n){0,3}/s;
91 if( $entity->is_multipart ) {
92 foreach( $entity->parts() ) {
93 print $_->mime_type . "\n" or die $!;
94 $body = &uudecode_text( $_, $dir );
95 $body =~ /(.*\n){0,3}/s;
102 $Article_From = $entity->head->get( "From" );
104 $Article_Subject = $entity->head->get( "Subject" );
105 chop $Article_Subject;
106 $Article_Head = $entity->head->as_string;
107 $Article_Body = $body;
110 return ($entity, $prolog);
113 sub decode_plaintext_message {
123 $Article_From =~ s/^From: //;
124 } elsif( /^Subject: / ) {
125 $Article_Subject = $_;
126 $Article_Subject =~ s/^Subject: //;
134 $Article_Body .= $_ while( <STDIN> );
136 return &file_plaintext_message( $dir );
140 # stores a plaintext message in a fashion similar to a MIME message
141 sub file_plaintext_message {
147 open( FULL, ">$dir/full_message.txt" ) or die $!;
148 print FULL $Article_Body or die $!;
149 close( FULL ) or die $!;
152 my $prolog = "From: " . $Article_From . "\nReal-Subject: $Article_Subject";
153 # . "Subject: " . $entity->head->get( "Subject" );
157 open( SKELETON, ">$dir/skeleton.skeleton" );
160 open( HEAD, ">$dir/headers.txt" ) or die $!;
161 print HEAD $Article_Head . "\n" or die $!;
162 close( HEAD ) or die $!;
164 open( TEXT_FILES, ">$dir/text.files.lst" ) or die $!;
166 print TEXT_FILES "headers.txt\nfull_message.txt\n" or die $!;
168 my $body = $Article_Body;
169 $body =~ /(.*\n){0,3}/s;
173 close( TEXT_FILES ) or die $!;