#!/usr/local/bin/perl

$man = <<EOM;
<TITLE>mail2rec: Tool to create archive of email messages using WODA</TITLE> 
<H1>mail2rec:<BR><SMALL>Converts an email message to WODA record</SMALL></H1>

<P>
Mail2rec is an add-on program for
<A HREF=http://www.fagg.uni-lj.si/~zturk/works/wb/>WODA</A>
database. It converts email messages into the database's
records. It can process plain email messages or multipart MIME
messages with base64 encoded attachments.

<H3>Usage:</H3>
<PRE>mail2rec /directory/for/rec/files</PRE>
Typically this would be used from <TT>/usr/lib/aliases</TT> file.
After you change that file don't forget to run newaliases!

<H3>Files:</H3>
mail2rec is <A HREF=mail2rec.txt>right here</A>.<P>
Needs a definition of WODA database to handle archived mail.
Sample definition is at
<A HREF=http://www.fagg.uni-lj.si/~zturk/works/wb/mail.txt>http://www.fagg.uni-lj.si/~zturk/works/wb/mail.txt</A>

<H3>Author:</H3>
<A HREF=http://www.fagg.uni-lj.si/~zturk/>Ziga Turk</A>. Routine to
decode base64 was fond on the Web, can't remember where.

<H3>Copyrigh:</H3>
mail2rec is freeware.

EOM

$DEBUG=1;
if ($ARGV[0] eq '-man') {
    print $man;
    exit;
}

if ($ARGV[0] eq '-test') {
    shift(@ARGV);
    $TEST=1;
}

$DIR = $ARGV[0] || ".";
mkdir ($DIR,0777);
open (err,">>$DIR/mair2rec.log");
select (err);

$_id = &randID();
open (rec,">$DIR/$_id.rec") || die "Could not open file\n";
print "\n--- $_id ---\n";

# get the message

if ($TEST) {
    open (h,"$DIR/lastmail.txt");
    @input = <h>;
    close (h);
} else {
    @input = <STDIN>;
}

$input = join('',@input);
open (h,">$DIR/lastmail.txt");
print h $input;
close(h);

$*=1;

# header and body

($headers,$body) = split("\n\n",$input,2);
$rec{headers}=$headers;

# extract interesting headers

$headers =~ s/\n\s/ /g;
@headers = split(/\n/,$headers);
@flds = ('from','to','subject','reply-to','date','content-type');
foreach $headrow (@headers) {
    foreach $fld (@flds) {
	if ($headrow =~ m/^$fld:\s/i) {
	    $rec{$fld}=$';
	    print "$fld=$'\n" if $DEBUG;
	}
    }
}

# MIME ?

if (! ($rec{'content-type'} =~ m|Multipart/Mixed|i)) {

    $rec{body} = $body;

} else {

    $rec{body} = '';

    $rec{'content-type'} =~ m/boundary="?([^"]*)/;
    $boundary=$1;

    print "Boundayy=<$boundary>\n" if $DEBUG;

    if ($boundary eq '') {
	print "ERROR: Boundary no good\n";
	$rec{body} = $body;
	goto writeit;
    }

    # parse MIME body

    @pairs = split(/--$boundary/,$body);
    @pairs = splice(@pairs,1,$#pairs);

    print "MIME BODY has $#pairs pairs\n" if $DEBUG;

    if ($#pairs > 20) {
	print "ERROR: Too many ($#pairs) attachments\n";
	$rec{body} = "Too many attachments in this message\n";
	goto writeit;
    }

    $dpart = 0;
    foreach $part (@pairs) {

	if ($part =~ m/\x0D\x0A$/) {
	    $CRLF = "\x0D\x0A";
    	} else {
	    $CRLF = "\x0A";
	}

	($mimeHeader,$mimeData)=split(/$CRLF$CRLF/,$part,2);

	next if $mimeHeader =~ m|^--|;
	$dpart++;

# print "\nPART $dpart\n$mimeHeader\n\n";

	print "\nMIME part $dpart\n";
	$mime{$dpart,'header'}=$mimeHeader;
    	chop $mimeData;
    	chop $mimeData if length($CRLF)==2;

    	$mimeHeader =~ s/\r//g;
    	$mimeHeader =~ s/\n/;/g;
    	(@mimeHeaders)=split(/\s*;\s*/,$mimeHeader);

        foreach $item (@mimeHeaders) {
	    next if $item eq '';
	    ($name,$value)=split(/=|:/,$item,2);
	    $value=~ m/\s*"*([^"]*)/;
	    $value=$1;
	    $name =~ tr/[A-Z]/[a-z]/;
	    $mime{$dpart,$name}=$value;
	    print "mime{$dpart,$name}=$value\n" if $DEBUG;
        }

	if ($mime{$dpart,'filename'}) {
	    $mime{$dpart,'filename'} =~ tr/[A-Z]/[a-z]/;
	    $mime{$dpart,'filename'} =~ m/([^\.]*)$/;
	    $mime{$dpart,'ext'} = $1;
	    print "mime{$dpart,ext}=$1\n" if $DEBUG;
	}

	if ($mime{$dpart,'content-transfer-encoding'} =~ m/base64/i) {
	    $mime{$dpart,'binary'} = &decode64($mimeData);;
# print "Binary part len = " . length($mime{$dpart,'binary'}) . "\n";
	    $mime{$dpart}='BIN';
            $f = $mime{$dpart,'filename'};
	    $rec{body} .= "+ Attached file $f\n";

	} elsif ($mime{$dpart,'content-type'} =~ m!text/plain|text/html!) {
	    $rec{body} .= "$mimeData\n";
	    $mime{$dpart}='TEXT';

	} else {
	    $mime{$dpart,'binary'}=$part;
	    $mime{$dpart}='UNKNOWN';
	    $rec{body} .= "** Attachment **\n";
	}	    
    }# each part

    # write attachments to files

    $natt=0;
    for ($i=1;$i<=$dpart;$i++) {
	$type = $mime{$i};
	print "PART $i of type $type\n";
	if ($mime{$i} eq 'TEXT') {
	    next;
	} elsif ($mime{$i} eq 'BIN') {
	    $natt++;
	    $ext = $mime{$i,'ext'};
	    $rec{"att$natt"}="$_id.att$natt.$ext";
	    open (h,">$DIR/$_id.att$natt.$ext");
	    binmode(h);
	    print h $mime{$i,'binary'};
	    close(h);
	} elsif ($mime{$i} eq 'UNKNOWN') {
	    $natt++;
	    $rec{"att$natt"}=$mime{$i,'filename'};
	    open (h,">$DIR/$_id.att$natt.txt");
	    print h $mime{$i,'binary'};
	    close(h);
	}
    }

} # mime-or-not

writeit:

$rec{_at}=time;
$rec{_from}='127.0.0.1';

print rec "\n";

foreach $fld (sort(keys(%rec))) {
    next if $fld eq 'content-type';
    $val = $rec{$fld};
    $val =~ tr/\012/\034/;
    print rec "$fld\012$val\012";
}

close (h);
exit;

sub decode64 {

    local($lines, $temp, $ret );

%A2B = (        
    'A',  0,  'B',  1,  'C',  2,  'D',  3,
    'E',  4,  'F',  5,  'G',  6,  'H',  7,
    'I',  8,  'J',  9,  'K', 10,  'L', 11,
    'M', 12,  'N', 13,  'O', 14,  'P', 15,
    'Q', 16,  'R', 17,  'S', 18,  'T', 19,
    'U', 20,  'V', 21,  'W', 22,  'X', 23,
    'Y', 24,  'Z', 25,  'a', 26,  'b', 27,
    'c', 28,  'd', 29,  'e', 30,  'f', 31,
    'g', 32,  'h', 33,  'i', 34,  'j', 35,
    'k', 36,  'l', 37,  'm', 38,  'n', 39,
    'o', 40,  'p', 41,  'q', 42,  'r', 43,
    's', 44,  't', 45,  'u', 46,  'v', 47,
    'w', 48,  'x', 49,  'y', 50,  'z', 51,
    '0', 52,  '1', 53,  '2', 54,  '3', 55,
    '4', 56,  '5', 57,  '6', 58,  '7', 59,
    '8', 60,  '9', 61,  '+', 62,  '/', 63,
);

    $ret = '';
    @lines = split(/\n/,$mimeData);
    foreach $_ (@lines) {
        #chomp;                             
        next unless $_;                     
        s/\s+//g;
        if( /[^A-Za-z0-9\+\/\=]/ || length($_)%4 > 0 ) {
            print "?" if $DEBUG;
            next;
        }                                   

        while( /([\w\+\/])([\w\+\/])([\w\+\/])([\w\+\/])/ig ){
            $temp = $A2B{$1}<<18 | $A2B{$2}<<12 | $A2B{$3}<<6 | $A2B{$4};
            $ret .= pack('CCC', $temp >> 16, $temp >> 8, $temp );
        }
        if( /([\w\+\/])([\w\+\/])([\w\+\/])\=$/ ){
            $temp = $A2B{$1}<<18 | $A2B{$2}<<12 | $A2B{$3}<<6;
            $ret .= pack('CC', $temp >> 16, $temp >> 8 );
        }elsif( /([\w\+\/])([\w\+\/])\=\=$/ ){
            $temp = $A2B{$1}<<18 | $A2B{$2}<<12;
            $ret .= pack('C', $temp >> 16  );
        }
    }

    return $ret;
}

sub randID {

        local (@a) = (0..9,'a'..'f');
        local ($x, $n, $c, $o, $base, @c);
        $base = $#a+1;

        $n = $n || 4;
        $x = $base**$n;
	srand(time); 
	while (1) {

            $x = int(rand($x));

            for ($i=1;$i<=5;$i++) {
            	$o = $x % $base;
            	$c[$i]=$a[$o];
            	$x = int($x/$base);
            }
	    $n = join('',@c);

	    last unless -e "$DIR/$n.rec";
	}

	return $n;
}