#!/usr/bin/perl -w
#<munpack: decode a message with multipart/mixed MIME attachments

use Getopt::Long;
use File::Basename;
use File::Temp qw /tempdir/;
use MIME::Parser;
use strict;

use subs qw(manpage myuuid textfiles usage version where);
$ENV{'PATH'} = join ":", qw(/bin /usr/bin /usr/local/bin /opt/sfw/bin);

my $myname = basename($0);
$myname =~ s/\.\w*$//;   # strip any extension

my %options;
my @getopt_args = (
    'h|?',    # print usage
    'm',      # print manpage
    'u',      # print UUID
    'v',      # print version
    'w',      # print source location
    );

Getopt::Long::config("noignorecase", "bundling");
usage unless GetOptions(\%options, @getopt_args);

manpage if $options{'m'};
myuuid  if $options{'u'};
version if $options{'v'};
where   if $options{'w'};
usage   if $options{'h'} || !@ARGV;

### Make sure we have someplace to work.

my $dir = "$myname-work";
unless (-d $dir) {
    $dir = tempdir("./XXXXXXXX") or die "tempdir: $!\n";
    chmod(0755, $dir);
}

### Create parser, and set some parsing options.
### DO NOT parse contained "message/rfc822" objects as
### nested MIME streams, or we lose the header from each object.

my $parser = new MIME::Parser;
$parser->output_dir("$dir");
$parser->extract_nested_messages(0);

### Parse a file or stdin.

my $ifile;
my $entity;

if ($ifile = shift(@ARGV)) {
    $entity = $parser->parse_open($ifile) or die "parse failed\n";
}
else {
    $entity = $parser->parse(\*STDIN) or die "parse failed\n";
}

### Is any further work needed for each generated file?

chdir($dir) or die "$dir: cannot chdir: $!\n";
opendir(DIR, ".") or die ".: cannot read: $!\n";
my @files = textfiles(readdir(DIR));
closedir(DIR);

my $eachmsg = new MIME::Parser;    # new parser for each message.
$eachmsg->output_dir(".");
$eachmsg->extract_nested_messages(1);

print "Message in $dir:\n";
for (@files) {
    my $eachent;
    my $mtype;

    if ($eachent = $eachmsg->parse_open($_)) {
	$mtype = $eachent->mime_type;
        print " + checking message $_... $mtype\n";

	# We don't have to extract a plain-text message
	$eachent->purge if $mtype eq "text/plain";
    }
    else {
        print " - message $_ not MIME\n";
    }
}

exit(0);

#---------------------------------------------------------------------
# Look for just the text files in a given list.

sub textfiles {
    my @retval;
    foreach my $entry (@_) {
        push @retval, $entry if (-T $entry);
    }
    return @retval;
}

#---------------------------------------------------------------------
# Print a usage message from the comments and exit.

sub usage {
    my ($emsg) = @_;
    use Pod::Usage qw(pod2usage);
    warn "$emsg\n" if defined $emsg;
    pod2usage(-verbose => 99, -sections => "NAME|SYNOPSIS|OPTIONS");
}

sub manpage {
    my @args = ("perldoc", "$0");
    exec { $args[0] } @args;          # safe even with one-arg list
    die("should not get here\n");
}

#---------------------------------------------------------------------
# Print the UUID, current version, or source location.

sub myuuid {
    my $UUID = $1
        if q$UUID: 70a8604c-172d-3179-9c67-60b7d056f7e7 $ =~ /UUID: (.*) /;
    print "$UUID\n";
    exit(0);
}

sub version {
    my $VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
    my $DATE = $1 if q$Date: 2012-07-26 17:11:48-04 $ =~ /Date: (.*) /;
    print "$myname $VERSION $DATE\n";
    exit(0);
}

sub where {
    my $SOURCE = $1
        if q$Source: /home/vogelke/bin/RCS/munpack,v $ =~
          /Source: (.*) /;
    my $HOST = $1 if q$Host: sys7.com $ =~ /Host: (.*) /;
    print "file://$HOST", "$SOURCE\n";
    exit(0);
}

#---------------------------------------------------------------------
__END__

=head1 NAME

munpack - decode a message with multipart/mixed MIME attachments

=head1 SYNOPSIS

munpack [-hmuvw] [log ...]

=head1 OPTIONS

=over 4

=item B<-h>

Print a brief help message and exit.

=item B<-m>

Print the manual page and exit.

=item B<-u>

Print the script UUID and exit.

=item B<-v>

Print the version and exit.

=item B<-w>

Print the source location and exit.

=back

=head1 DESCRIPTION

B<munpack> will decode a multipart/mixed message possibly containing
other MIME messages, and store the results in a directory beneath
the current one.

If the directory B<munpack-work> exists, it will be used as the
workspace.  Otherwise, a temporary directory will be created.

=head1 AUTHOR

 Karl Vogel <vogelke+unix@pobox.com>
 Oasis Systems, Inc.

=cut