webstump/scripts/mime-parsing.lib

   1 #
   2 # this is a library of perl routines for MIME parsing.
   3 #
   4
   5 if( $use_mime eq "yes" ){
   6   require MIME::Parser;
   7   require Convert::UU; import uudecode;
   8 }
   9
  10 sub uudecode_text {
  11   my $dir = pop( @_ );
  12   my $entity = pop( @_ );
  13
  14   my $type = $entity->mime_type;
  15   my $body = $entity->stringify_body;
  16
  17   if( $type =~ /^text\// ) {
  18     my $filename = $entity->bodyhandle->path;
  19     $filename =~ s/.*\///;
  20     print TEXT_FILES $filename . "\n" or die $!;
  21
  22     my $count = 0;
  23     while(1) {
  24       last if( $count++ > 15 );
  25       my ($data, $name, $mode ) = &uudecode( $body );
  26       $name =~ s/\//_/g;
  27
  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 $!;
  32           close FILE or die $!;
  33           chmod 0644, $file or die $!;
  34         }
  35         my $filename = $entity->bodyhandle->path;
  36         open( REDUCED, ">$filename" ) or die $!;
  37         print REDUCED $body or die $!;
  38         close( REDUCED ) or die $!;
  39       } else {
  40         last;
  41       }
  42     }
  43   } else {
  44     $body = "";
  45   }
  46
  47   $body =~ s/\n+/\n/gs;
  48
  49   return $body;
  50 }
  51
  52 sub decode_mime_message {
  53   my $dir = pop( @_ );
  54   mkdir $dir, 0775;
  55   chmod 0755, $dir;
  56   #chdir $dir;
  57
  58   # Create parser, and set the output directory:
  59   my $parser = new MIME::Parser;
  60   $parser->output_dir( $dir );
  61
  62   # Parse input:
  63   $entity = $parser->read(\*STDIN) or die "couldn't parse MIME stream";
  64
  65   open( FULL, ">$dir/full_message.txt" ) or die $!;
  66   print FULL $entity->as_string or die $!;
  67   close( FULL ) or die $!;
  68
  69
  70   my $RealSubject = "Real-Subject: " . $entity->head->get( "Subject" );
  71
  72   my $prolog = "From: " . $entity->head->get( "From" ) . "$RealSubject\n";
  73
  74   open( SKELETON, ">$dir/skeleton.skeleton" );
  75   $entity->dump_skeleton( \*SKELETON );
  76   close( SKELETON );
  77
  78   open( HEAD, ">$dir/headers.txt" ) or die $!;
  79   print HEAD $entity->head->as_string . "\n" or die $!;
  80   close( HEAD ) or die $!;
  81
  82   open( TEXT_FILES, ">$dir/text.files.lst" ) or die $!;
  83
  84   print TEXT_FILES "headers.txt\n" or die $!;
  85
  86   my $body = &uudecode_text( $entity, $dir );
  87   $body =~ /(.*\n){0,3}/s;
  88
  89   $prolog .= $1;
  90
  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;
  96       $prolog .= $1;
  97     }
  98   }
  99
 100   close( TEXT_FILES );
 101
 102   $Article_From = $entity->head->get( "From" );
 103   chop $Article_From;
 104   $Article_Subject = $entity->head->get( "Subject" );
 105   chop $Article_Subject;
 106   $Article_Head = $entity->head->as_string;
 107   $Article_Body = $body;
 108
 109   chmod $dir, 0755;
 110   return ($entity, $prolog);
 111 }
 112
 113 sub decode_plaintext_message {
 114   my $dir = pop( @_ );
 115
 116   $Article_Head = "";
 117
 118   while( <STDIN> ) {
 119     $Article_Head .= $_;
 120     chomp;
 121     if( /^From: / ) {
 122       $Article_From = $_;
 123       $Article_From =~ s/^From: //;
 124     } elsif( /^Subject: / ) {
 125       $Article_Subject = $_;
 126       $Article_Subject =~ s/^Subject: //;
 127     }
 128
 129     last if /^$/;
 130   }
 131
 132   $Article_Body = "";
 133
 134   $Article_Body .= $_ while( <STDIN> );
 135
 136   return &file_plaintext_message( $dir );
 137
 138 }
 139
 140 # stores a plaintext message in a fashion similar to a MIME message
 141 sub file_plaintext_message {
 142   my $dir = pop( @_ );
 143
 144   mkdir $dir, 0775;
 145   chmod 0755, $dir;
 146
 147   open( FULL, ">$dir/full_message.txt" ) or die $!;
 148   print FULL $Article_Body or die $!;
 149   close( FULL ) or die $!;
 150
 151
 152   my $prolog = "From: " . $Article_From . "\nReal-Subject: $Article_Subject";
 153 #              . "Subject: " . $entity->head->get( "Subject" );
 154
 155   $prolog .= "\n\n";
 156
 157   open( SKELETON, ">$dir/skeleton.skeleton" );
 158   close( SKELETON );
 159
 160   open( HEAD, ">$dir/headers.txt" ) or die $!;
 161   print HEAD $Article_Head . "\n" or die $!;
 162   close( HEAD ) or die $!;
 163
 164   open( TEXT_FILES, ">$dir/text.files.lst" ) or die $!;
 165
 166   print TEXT_FILES "headers.txt\nfull_message.txt\n" or die $!;
 167
 168   my $body = $Article_Body;
 169   $body =~ /(.*\n){0,3}/s;
 170
 171   $prolog .= $1;
 172
 173   close( TEXT_FILES ) or die $!;
 174
 175   return $prolog;
 176 }
 177 1;