#!/usr/bin/perl

require 5.002;                # for SUPER

use lib "$ENV{HOME}/lib/MIME-Base64-2.12/lib/site_perl";

use MIME::Base64;
use File::Basename;
use File::stat;
use Fcntl ':flock';
use Getopt::Long;
use Time::ParseDate;   

# Usage is: $me --in folder --out folder.out --dir output-directory

if ($#ARGV == -1) {
   Usage();
}

$result = GetOptions qw( --in=s --out=s --dir=s --cat! );

if ( "$opt_in" eq "" ) {
}
else {
   $folder=$opt_in;
   $fs = stat $folder;

   open(STDIN,"+<$folder") || die "Error: opening input folder $folder\n";
   if (!lock(STDIN)) {
      close(STDIN);
      printf STDERR "Error: could not lock folder $folder\n";
   }
   print STDERR "Extracting attachments from folder $folder...\n";
}

$cat=("$opt_cat" eq "") ? ">" : ">>";

if ( "$opt_out" eq "" ) {
}
else {
   $output=$opt_out;
   # redirect STDOUT to $output
   open(STDOUT,"$cat$output") || die "Error: opening output folder $output\n";
}

if ( "$opt_dir" eq "" ) {
   $opt_dir=".";
}

@header = ();
@body = ();
$last=0;
$date=0;
$subject=0;
$from=0;
$alreadyOutput=0;
while(<STDIN>) {

   chomp;

   if (/^From /) {
      $envelope = $_;
      $inheader = 1;

      next if @header == NULL; # first time?

      processMessage();
      if ( $alreadyOutput == 1 ) {
          print STDERR "**************************************\n";
      }

      @header = ();
      @body = ();
      $last = 0;
      $date = 0;
      $subject=0;
      $from=0;
      $alreadyOutput=0;

      next;
   }
   if ($inheader) {
      if (/^From:(.*)/) {
         $from=$1;
      }
      if (/^Subject:(.*)/) {
         $subject=$1;
      }

      if (/^$/) {
         $inheader = 0;
         @body = ();
      }
      elsif (/^Date:(.*)/) {
         push @header, $_;
         $last++;
         $date=$1;
      }
      elsif (/^(\s+)(.*)/) {
         $header[$last-1] .= "\n$1$2";
         next;
      }
      elsif (/^(\S+):(.*)/) {
         push @header, $_;
         $last++;
         next;
      }
      else {
         printf STDERR "-----\nUnexpected header entry\n";
         printf STDERR "$_-----\n";
         next;
      }
   }

   push @body,$_;

};

processMessage();

unlock(STDIN);
close(STDIN);

if ($fs) {
   chmod $fs->mode, $output;
   chown $fs->uid,$fs->gid, $output;
}

print STDERR "\n";

sub aprint {
   $out=$_[0]; shift;
   foreach $e (@_) {
      print $out "$e\n";
   }
}

sub processMessage {

   my $boundary="";
   my $multipartRelated=0;
   my $noFileName=0;

   # look for multipart in Content-Type header
   foreach $h (@header) {
      if ($h =~ /^Content-Type:(.*)/i) {
         $_ = $h;
         if (/multipart\/mixed/i) {
            if (/boundary="(\S+)"/i) {
               $boundary=$1;
                
                #looks like some stupid MS attachments use id's like:
                #--Boundary_(ID_xFvCIQ+W7Uv1WgYKklIeDA)--
                #so we will escape the characters in the string so 
                #we can match regular expressions:
                #--Boundary_\(ID_xFvCIQ\+W7Uv1WgYKklIeDA\)--
                $boundary =~ s/\(/\\\(/;
                $boundary =~ s/\)/\\\)/;
                $boundary =~ s/\+/\\\+/;
               last;
            }
         }
         elsif (/multipart\/related/i) {
            if (/boundary="(\S+)"/i) {
               $boundary=$1;
                
                #looks like some stupid MS attachments use id's like:
                #--Boundary_(ID_xFvCIQ+W7Uv1WgYKklIeDA)--
                #so we will escape the characters in the string so 
                #we can match regular expressions:
                #--Boundary_\(ID_xFvCIQ\+W7Uv1WgYKklIeDA\)--
                $boundary =~ s/\(/\\\(/;
                $boundary =~ s/\)/\\\)/;
                $boundary =~ s/\+/\\\+/;

                $multipartRelated=1;

               last;
            }
         }
      }
   }

   print STDOUT "$envelope\n";
   print STDERR "."; # a bit of feedback to stderr

   aprint(STDOUT,@header);
   if ($boundary) {

      my @mimepart=();
      for ($i=0; $i < $#body; $i++) {
         $_ = $body[$i];

         if (/--$boundary/) {
            next if $#mimepart == -1;

            # process mimepart
            if ($trencode =~ /base64/i) {

               if ($cdisp =~ /filename="(.*)"/i) {
                  # get rid of any path specs
                  $filename= basename "$1";
               }
               else {
                  $noFileName=1;
                  $filename="noname.bin";
               }

               # account for duplicates
               $filename = uniqueName("$opt_dir/$filename");

               if (open(FILE,">$filename")) {

                  if ( $alreadyOutput != 1 ) {
                      print STDERR "\n**************************************\n";
                      print STDERR "Date: $date";
                      print STDERR "\nFrom: $from";
                      print STDERR "\nSubject: $subject\n";
                      if ( $multipartRelated == 1 ) {
                        print STDERR "Warning: Content-Type: multipart/related;\n";
                      }
                      if ( $noFileName == 1 ) {
                        print STDERR "Warning: no filename given\n";
                      }
                  }
                  print STDERR " Writing $filename\n";
                  $alreadyOutput=1;

                  binmode(FILE);
                  $go=0;
                  foreach $mp (@mimepart) {
                     $_ = $mp;
                     if ($go == 0) {
                        # start processing after reaching a blank line in
                        # @mimepart
                        $go = 1 if (/^$/);
                        next;
                     }
                     next if ( /^$/ );         # skip blank lines
                     last if (/--$boundary/);  # stop at boundary

                     $decoded = decode_base64($mp);
                     print FILE $decoded;
                  }
                  close(FILE);

                  if ($fs) {
                     chmod $fs->mode, $filename;
                     chown $fs->uid,$fs->gid, $filename;
                  }
                  if ($date) {
                     my $mtime=parsedate($date);
                     utime $mtime, $mtime, $filename if $mtime;
                  }

                  # tell the L^Huser where their attachment is
                  print STDOUT "Content-Type: text/plain; charset=us-ascii\n";
                  print STDOUT "Content-Transfer-Encoding: 7bit\n\n";
                  print STDOUT "*****\n";
                  print STDOUT "***** Content-Type: $ctype\n";
                  print STDOUT "***** Content-Transfer-Encoding: $trencode\n";
                  print STDOUT "***** Content-Description: $cdesc\n";
                  print STDOUT "***** Content-Disposition: $cdisp\n";
                  print STDOUT "*****\n\n";
                  print STDOUT "***** Attached file saved to disk:
$filename\n\n";
               }
               else {
                  printf STDERR "\n Error: could not open attachment file
$filename\n";
                  aprint(STDOUT,@mimepart);
               }
            }
            else {
               aprint(STDOUT,@mimepart);
            }

            print STDOUT "$body[$i]\n"; # print the boundary marker

            @mimepart = ();
            $filename="";
            $trencode="";
            $ctype="";
            $cdisp="";
            $cdesc="";
         }
         else {
            if ( /^Content-Transfer-Encoding:(.*)/i ) {
               $trencode=$1;
            }
            elsif( /^Content-Type:(.*)/i ) {
               $ctype=$1;
               while ( /;$/ ) {
                  $ctype .= $body[++$i];
                  $_ .= $body[$i];
               }
            }
            elsif( /^Content-Disposition:(.*)/i ) {
               $cdisp=$1;
               while(/;$/) {
                  $cdisp .= $body[++$i];
                  $_ .= $body[$i];
               }
            }
            elsif( /^Content-Description:(.*)/i ) {
                $cdesc=$1;
            }
            push @mimepart,$_;
         }
      }
      aprint(STDOUT,@mimepart);
   }
   else {
      aprint(STDOUT,@body);
   }
   print STDOUT "\n";
}

sub uniqueName {
   #$filename = uniqueName("$opt_dir/$filename");

   my $f, $p, $g, $x;

   #make this $n local because we want to start the unique count at 0 for   
   #each iteration 
   my $n; 
   
   ($f,$p) = fileparse($_[0]);

   @chunks = split( /\./, $f );
   $x = ".bin";
   if ($#chunks > 0) {
      $f = $chunks[0];
      $x = ".$chunks[$#chunks]";
      for (my $i=1; $i<$#chunks;$i++) {
         $f .= ".$chunks[$i]";
      }
   }

   my $g = "$p$f$x";
   while( -f "$g" ) {
      ++$n;
      $g="$p$f-$n$x";
   }

   return $g;
}

sub lock {
   # true on success
   $rval = flock($_[0],LOCK_EX | LOCK_NB); # exclusive lock, non blocking
   return $rval;
}

sub unlock {
   $rval = flock($_[0],LOCK_UN);
   return $rval;
}

sub Usage() {
   my $usage;
   my $me=basename $0;

$usage=<<USAGE;
$me ver. 0.1 Copyright 2000, Steeve McCauley

 Usage is: $me --in folder --out folder.out --dir output-directory

   --in   input folder (default: stdin )
   --out  output folder (default: stdout)
   --dir  directory for decoded attachments (default: current)
   --cat  concatonate output to output folder (default: truncate)

   Example,

      $me --dir=~user/Mail/mime < user > user.stripped

USAGE
   print $usage;
   exit(1);
}