MIME Attachment Extractor

[httptech]

Description:

This is a short piece of code I wrote to enhance a online helpdesk system. It parses incoming emails, finds any attachments and saves them, then inserts into the email a link to where the saved attachments can be downloaded from.

In this code, the email is being read from STDIN, and the "cleaned" message (headers and body) is returned as a scalar.

You should take precautionary security measures on the directory that will hold the attachments; you obviously don't want to allow anyone to email you arbitrary code and run it from your public html directories.

use MIME::Parser;

sub read_email {
  my $dir = "/home/foo/public_html/attachments";
  my $url = "http://www.foo.bar/attachments";

  my $parser = new MIME::Parser;
  $parser->output_dir($dir);
  my $entity = $parser->read(\*STDIN) || die "couldn't parse MIME stre
+am";
  my $head = $entity->head;
  my $content = $head->as_string . "\n";

  my @parts = $entity->parts;
  my $body = $entity->bodyhandle;

  $content .= $body->as_string if defined $body;
  my $part;
  for $part (@parts) {
    my $path = ($part->bodyhandle) ? $part->bodyhandle->path : undef;
    if ($path =~ /msg-\d+.*\.doc/) {
      open(IN, $path) || warn "Couldn't open $path\n";
      local $/ = undef;
      $content .= <IN> . "\n";
      close IN;
      unlink ($path) || warn "Couldn't unlink $path\n";       
    }   
    else {
      my $file = $path;
      $file =~ s/$dir//o;
      $content .= "\n--\nSaved attachment: $url$file\n--\n"; }
    }

return $content;
}