#!/usr/local/bin/perl
# hmime.pl, by Jin S Choi <jsc@mit.edu>
# v0.1
# A filter to convert MIME compliant messages into messages with embedded
# hyperbole buttons.

# Usage: mime.pl [options] [filename]
# options:
# 	-d   deletes saved original message when done
#	-t   specifies top directory to unpack in
#	-o   specifies outputfile in top directory

require 'getopts.pl';
&Getopts('o:t:d');

$topdir = $opt_t || "$ENV{'HOME'}/Mail/Attachments";

# Strings for generating symbols.
$gensym = "G000000";
$image = "image000";
$audio = "audio000";
$video = "video000";
$message = "message000";
$app = "app0000";


# deal with headers
$hdrs = '';
while (<>) {
    $hdrs .= $_;
    last if /^$/;		# empty line
    if (s/^\s+//) {		# folded line
	$headers{$lastfield} .= $_;
    } else {
	($name,$body) = /^([^:]+):\s*(.*)$/;
	$name =~ s/(.*)/\L\1\E/; # canonicalize to lowercase
	$headers{$name} = $body;
	$lastfield = $name;
    }
}


if (!defined($headers{'mime-version'})) {
    print while (<>);
    exit;
}

if ($opt_o) {
    open(OUTFILE, ">$opt_o") || die $!;
    select OUTFILE;
}

# create a directory to unpack in
$subdir = $headers{'message-id'} || time;
$subdir =~ s/([<>])//g;

(mkdir($topdir, 0755) || die $!) if (! -e $topdir);
chdir $topdir || die $!;
mkdir($subdir, 0755);
chdir $subdir || die $!;

# dump the message
open(MSG, ">msg") || die $!;
print MSG $hdrs;
print $hdrs;
print MSG while (<>);
close MSG;

# process it
&extract("msg", *headers);

&create_buttons;

close OUTFILE if $opt_o;
unlink "msg" if $opt_d;


## SUBROUTINES

# first arg is filename containing body of message
# second arg is associative array of headers to use to
# decode it
sub extract {
    local($filename, *headers) = @_;
    local($encoding, $type, $outfile);
    local($lastfield);
    local($subdir) = $subdir;
    local(*IN);

    $encoding = $headers{'content-transfer-encoding'};
    $type = $headers{'content-type'} || "text/plain; charset=us-ascii";

    if ($encoding =~ /base64/i) {
	open(IN, "mimencode -u < $filename |") || die $!;
    } elsif ($encoding =~ /quoted-printable/i) {
	open(IN, "mimencode -u -q < $filename |") || die $!;
    } else {
	open(IN, "<$filename") || die $!;
    }

    $outfile = ($headers{'content-id'} 
		|| $headers{'message-id'}
		|| $headers{'subject'}
		|| $headers{'content-description'}
		|| time);
    $outfile =~ s/\s+//g;
    if ($type =~ /text/i) {
	print while (<IN>);
    } elsif ($type =~ /image\/([^\s;]+)/i) {
	$outfile = $image++ . ".$1";
	open(OUT, ">$outfile") || die $!;
	print OUT while (<IN>);
	close OUT;
	push(@buts, $outfile);
	print "<($outfile)>\n";
    } elsif ($type =~ /audio\/basic/i) {
	$outfile = $audio++;
	open(OUT, ">$outfile.snd") || die $!;
	print OUT while (<IN>);
	close OUT;
	push(@buts, "$outfile.snd");
	print "<($outfile.snd)>\n";
    } elsif ($type =~ /application\/(\S+)/i) {
	$outfile = $app++;
	$outfile .= ".ps" if $1 =~ /postscript/i;
	open(OUT, ">$outfile") || die $!;
	print OUT while (<IN>);
	close OUT;
	push(@buts, $outfile);
	print "<($outfile)>\n";
    } elsif ($type =~ /video\/(\S+)/i) {
	$outfile = $video++ . ".$1";
	open(OUT, ">$outfile") || die $!;
	print OUT while (<IN>);
	close OUT;
	push(@buts, $outfile);
	print "<($outfile)>\n";
    } elsif ($type =~ /multipart/i) {
	## TODO: handle multipart/alternative correctly
	($boundary) = $type =~ /boundary="([^\"]+)"/i;
	($boundary) = $type =~ /boundary=(\S+)/i if !$boundary;
	

	# skip the prologue
	while (<IN>) {
	    last if /^--$boundary/;
	}

	$done = 0;
	while (!$done || !eof(IN)) {
	    # get the headers
	    undef %newheaders;
	    while (($_ = <IN>) !~ /^$/) {
		if (s/^\s+//) {		# folded line
		    $newheaders{$lastfield} .= $_;
		} else {
		    ($name,$body) = /^([^:]+):\s*(.*)$/;
		    $name =~ s/(.*)/\L\1\E/;	# canonicalize to lowercase
		    $newheaders{$name} = $body;
		    $lastfield = $name;
		}
	    }
	    
	    # output the part body
	    $filename = $gensym++;
	    open(OUT, ">$filename") || die $!;
	    while (<IN>) {
		if (/^--$boundary(--)?/) {
		    $done = 1 if $1;
		    last;
		}
		print OUT;
	    }
	    close OUT;

	    &extract($filename, *newheaders);
	    unlink $filename;
	}
    } elsif ($type =~ /message\/rfc822/i) {
	$outfile = $message++;
	open(OUT, "| $0 -d -t $topdir/$subdir -o $outfile") || die $!;
	print OUT while (<IN>);
	close OUT;
	push(@buts, $outfile);
	print "<($outfile)>\n";
    } else {
	$outfile = $gensym++;
	open(OUT, ">$outfile") || die $!;
	print OUT while (<IN>);
	close OUT;
	push(@buts, $outfile);
	print "<($outfile)>\n";
    }
}

sub create_buttons {
    # get the funny date string
    local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
	= localtime(time);
    local($datestring) = sprintf("19%d%02d%02d:%02d:%02d:%02d", 
				 $year, $mon + 1, $mday, $hour, $min, $sec);
    local($file, $oldhandle);

    if ($opt_o) {
	open(BUT, ">>$topdir/.hypb") || die $!;
	$oldhandle = select BUT;
	print "\f\n\"$opt_o\"\n";
    } else {
	print "\n\fbd\n";
    }
    foreach (@buts) {
	$file = "$topdir/$subdir/$_";
	s/_//;
	print qq#("$_" nil nil link-to-file ("$file") "$ENV{'USER'}" "$datestring" nil nil)\n#;
    }
    if ($opt_o) {
	select($oldhandle);
	close BUT;
    }
}