#!/usr/bin/perl -w
# vim: set sw=4 ts=4 si et:
# Written by: Guido Socher, Copyright: GPL
#
no locale;
# this is the directory where lfwmC.pm is found:
use lib '/home/webmail/lfwmail';
use strict;
use lfwmC;
use CGI;
# note: you need also MD5 for POP3Client.
use Mail::POP3Client;
# MIME::Parser is quite heavy. It is therefore included only when needed (further down):
use MIME::Words;
sub msgshow_ascii($$);
sub decodemessage($$$);
sub getmsg($$);
sub getmimeparts($$$);
sub getenclosure($$$);
sub printbuttonbar($$$$);
#
# config data pointer:
my $cf=lfwmC::getconfig();
my $q; 
$q=new CGI;
#
my $gl_msgnum;
# user data:
my $ud;
$ud=lfwmC::getACU($q);
#

# create only files readable by my own uid:
umask(0077);
#
unless($ud->{'cookie'} && $ud->{'uid'}){
    lfwmC::htmldie_std($q,"Error no uid/cookie received.");
}
unless($ud->{'action'}){
    lfwmC::htmldie_std($q,"Error no action received.");
}
# change the value of action and extract the message number:
if($ud->{'action'} && $ud->{'action'}=~/([eas])(\d+)/){
    $ud->{'action'}=$1;
    $ud->{'msgnum'}=$2;
}else{
    lfwmC::htmldie_std($q,"Error no valid action (".$ud->{'action'}.") received.");
}
# set the $ud->{'pw'} or terminate this program:
$ud=lfwmC::cookie2pw($q,$ud,$cf);
%ENV=();
$ENV{'PATH'}="/bin:/usr/bin";
$ENV{'IFS'}=" ";

if ($ud->{'action'} eq "s"){
    # display a given message
    print $q->header(-Pragma=> 'no-cache');
	print $q->start_html(-title=>"message number ". $ud->{'msgnum'},
'BGCOLOR=#FFFFFF');
    printbuttonbar($ud->{'uid'},$ud->{'msgnum'},$ud->{'cookie'},$cf->{'url'});
    print "<br clear=\"all\">\n";
    decodemessage($q,$ud,$cf);
    getmsg($ud,$cf);
    print '<br><hr><br clear=\"all\">';
    printbuttonbar($ud->{'uid'},$ud->{'msgnum'},$ud->{'cookie'},$cf->{'url'});
    print "<br clear=\"all\">\n";
    print $q->end_html;
    print "\n";
}elsif ($ud->{'action'} eq "a"){
    # display a given message in raw
    print $q->header(-type=>'text/plain',-Pragma=> 'no-cache');
    print "\n\n============ raw message, Msg. Nr.: ".$ud->{'msgnum'}." ==============\n\n";
    msgshow_ascii($ud,$cf);
    print "\n";
}elsif($ud->{'action'} eq "e"){
    # get enclosure
    my $part=$q->param('part');
    lfwmC::htmldie_std($q,"ERROR: no enclosure part number found.") unless(defined $part && $part=~/\d/);
    getenclosure($ud,$cf,$part);
}elsif($ud->{'action'} eq "r"){
    # reply
    print $q->header(-Pragma=> 'no-cache');
	print $q->start_html(-title=>"lfwmail web mail",
'BGCOLOR=#FFFFFF');
    print '<p>reply</p>
';
    print $q->end_html;
    print "\n";
}else{
    lfwmC::htmldie_std($q,"Program error no action found.");
}

sub msgshow_ascii($$){
    my $ud=shift;
    my $cf=shift;
    my $pop=new Mail::POP3Client(USER =>$ud->{'uid'},PASSWORD=>$ud->{'pw'},HOST=>$cf->{'pophost'});
    print("\nAuthentication error\n") unless($pop->Connect());
    foreach ( $pop->Head($ud->{'msgnum'})){
        print "$_\n";
    }
    foreach ( $pop->Body($ud->{'msgnum'})){
        print "$_\n";
    }
    print "\n";
    $pop->Close();
}
# a recursive function to get all the mime parts of a message
sub getmimeparts($$$){
    my $entity=shift;
    my $result=shift;
    my $i=shift;
    my ($type,$fname);
    my $path='';
    if ($entity->bodyhandle){
        $path = $entity->bodyhandle->path;
    }
    if ($path){
        # ignore empty parts with no file name
        $type=$entity->effective_type||'text/plain';
        $fname=$entity->head->recommended_filename||'unknown';
        $fname=~s/\^/./g;
        $type=~s/\^/_/g;
        $path=~s/\^/_/g; # security
        push(@{$result}, "part;$i;$type^$fname^$path\n");
    }
    foreach my $part ($entity->parts){
        $i++; # part number, note you can have in 
        #the result part 2, 3,5 (no 0, 1 no 4)
        getmimeparts($part,$result,$i);
    }
}
#
# read a message from pop3 and decode it into
# the directory $mimetmpdir/$uid/$msgnum
sub decodemessage($$$){
    my $q=shift;
    my $ud=shift;
    my $cf=shift;
    #
    my $uid=$ud->{'uid'};
    my $pw=$ud->{'pw'};
    my $structdir=$cf->{"mimetmpdir"}."/$uid/".$ud->{'msgnum'};
    # already decoded, nothing to do
    return(0) if ( -d "$structdir");
    my $pop=new Mail::POP3Client(USER =>"$uid",PASSWORD=>"$pw",HOST=>$cf->{'pophost'});
    lfwmC::htmldie_std($q,"Authentication error.") unless($pop->Connect());
    # create the struture where we store the message temporary
    # This gets deleted at next logout/login
    mkdir $cf->{"mimetmpdir"}."/$uid", 0700 if (! -d $cf->{"mimetmpdir"}."/$uid");
    mkdir $structdir, 0700 if (! -d $structdir);
    die "ERROR: could not create $structdir\n" if (! -d "$structdir");
    open(MSG,">$structdir/raw_msg.txt")||die "ERROR: can not write $structdir/raw_msg.txt\n";
    foreach ( $pop->Head($ud->{'msgnum'})){
        print MSG "$_\n";
    }
    print MSG "\n";
    foreach ( $pop->Body($ud->{'msgnum'})){
        print MSG "$_\n";
    }
    close MSG;
    $pop->Close();
    # now decode it
    require MIME::Parser; # load parser on demand
    my $parser = new MIME::Parser;
    mkdir "$structdir/mime", 0700 if (! -d "$structdir/mime");
    $parser->output_under("$structdir/mime");
    $parser->ignore_errors(1);
    open(MSG,"$structdir/raw_msg.txt")||die "ERROR: can not read $structdir/raw_msg.txt\n";
    my $entity = $parser->parse(\*MSG);
    open(II,">$structdir/mimeEntities.txt")||die "ERROR: can not write $structdir/mimeEntities.txt\n";
    my ($from,$subject,$cc,$to,$date);
    my $head = $entity->head;
    $from = $head->get('From') || '(unknown)';
    $from=MIME::Words::decode_mimewords($from);
    $subject = $head->get('Subject') || '(No subject)';
    $subject=MIME::Words::decode_mimewords($subject);
    $date = $head->get('Date') || '(missing date)';
    $cc = $head->get('CC')|| '';
    $to = $head->get('To') || '(unknown)';
    $to=MIME::Words::decode_mimewords($to);
    chomp($from);
    chomp($subject);
    chomp($date);
    chomp($cc);
    chomp($to);
    print II "head;from;$from\n";
    print II "head;subject;$subject\n";
    print II "head;date;$date\n";
    print II "head;cc;$cc\n";
    print II "head;to;$to\n";
    my @mimeparts;
    getmimeparts($entity,\@mimeparts,0);
    for  (@mimeparts){
        print II;
    }
    close II;
    close MSG;
}

#
# read $mimetmpdir/$uid/$msgnum and print it as
# text message html will be converted to text with lynx or w3m (this
# is more secure than html messages)
sub getmsg($$){
    my $ud=shift;
    my $cf=shift;
    #
    my $uid=$ud->{'uid'};
    my $msgnum=$ud->{'msgnum'};
    my $cookie=$ud->{'cookie'};
    my $structdir=$cf->{"mimetmpdir"}."/$uid/$msgnum";
    unless(open(II,"$structdir/mimeEntities.txt")){
        print "<pre>\n";
        print "ERROR: message number $msgnum, no data found\n";
        print "</pre>\n";
        return 1;
    }
    my ($from,$subject,$cc,$to,$date);
    my ($type,$fname,$filepath);
    my $headprinted=0; # print header only once
    my @line;
    my $partseperator=0; # if we have several parts
    my $prevtype=0; # for mixed html and plain text mails
    my $prevfname=0; # for mixed html and plain text mails
    while(<II>){
        next unless(/\w/);
        chomp;
        @line=split(/;/,$_,3);
        if ($line[0] eq 'head'){
            $to=$line[2] if ($line[1] eq 'to');
            $from=$line[2] if ($line[1] eq 'from');
            $cc=$line[2] if ($line[1] eq 'cc');
            $subject=$line[2] if ($line[1] eq 'subject');
            $date=$line[2] if ($line[1] eq 'date');
            next;
        }
        if ($line[0] eq 'part'){
            if ($headprinted==0){
                $headprinted=1;
                # The header part is always before the parts part.
                # $to,...  are therefore now set
                print "<table bgcolor=\"#bbcaea\"><tr><td>\n";
                print lfwmC::htmlescape("Date: $date\n")."<br>\n";
                print lfwmC::htmlescape("From: $from\n")."<br>\n";
                print lfwmC::htmlescape("Subject: $subject\n")."<br>\n";
                if ($cc){
                    print lfwmC::htmlescape("CC: $cc\n")."<br>\n";
                }
                print "</td></tr></table>\n<pre>\n";
            }
            ($type,$fname,$filepath)=split(/\^/,$line[2],3);
            if ($type eq 'text/plain'){
                print "\n---------- this is a mime multipart message. New part starts below -------\n\n" if ($partseperator);
                unless (-r "$filepath"){
                    print "ERROR: can not read message content\n";
                    next;
                }
                open(MF,"fmt -s -w85 \"$filepath\" |")||die;
                while(<MF>){
                    print lfwmC::htmlescape("$_");
                }
                close MF;
            }elsif($type eq 'text/html'){
                if ($prevfname eq 'unknown' && $prevtype eq 'text/plain'){
                    # message with both html and text, ignore this html part
                    next;
                }
                print "\n---------- this is a mime multipart message. New part starts below -------\n\n" if ($partseperator);
                unless (-r "$filepath"){
                    print "ERROR: can not read message content\n";
                    next;
                }
                open(MF,$cf->{'htmldecoder'}." \"$filepath\" |")||die;
                while(<MF>){
                    print lfwmC::htmlescape("$_");
                }
                close MF;
                print "\n</pre><table bgcolor=\"#bbcaea\"><tr><td>\n";
                print "Convertet to plain text from html. <br>
                <a href=\"".$cf->{'url'}."_display?c=$cookie&amp;a=e$msgnum&amp;uid=$uid&amp;part=$line[1]\">Click here to get original html code.</a>\n";
                print "<br></td></tr></table><pre>\n";
            }else{
                print lfwmC::htmlescape("|-------------------------\n");
                print lfwmC::htmlescape("| Enclosure/Attachment:$fname\n");
                print lfwmC::htmlescape("| Type:$type\n");
                # make it downloadable
                print "| Click here to download/view: <a href=\"".$cf->{'url'}."_display?c=$cookie&amp;a=e$msgnum&amp;uid=$uid&amp;part=$line[1]\">$fname</a>\n";
                print lfwmC::htmlescape("|-------------------------\n");
            }
            $partseperator=1;
            $prevfname=$fname;
            $prevtype=$type;
        }
    }
    print "</pre>\n";
    close II;
}

# read $mimetmpdir/$uid/$msgnum and fetch one enclosure.
sub getenclosure($$$){
    my $ud=shift;
    my $cf=shift;
    my $partnumber=shift; 
    #
    my $structdir=$cf->{"mimetmpdir"}."/".$ud->{'uid'}."/".$ud->{'msgnum'};
    unless(open(II,"$structdir/mimeEntities.txt")){
        print "Content-type: text/plain\n";
        print "\n";
        print "ERROR: message number ".$ud->{'msgnum'}.", no data found\n";
        return 1;
    }
    my @line;
    my ($type,$fname,$filepath);
    while(<II>){
        next unless(/\w/);
        chomp;
        @line=split(/;/,$_,3);
        if ($line[0] eq 'part' && "$line[1]" eq "$partnumber"){
            ($type,$fname,$filepath)=split(/\^/,$line[2],3);
            unless (-r "$filepath"){
                print "Content-type: text/plain\n";
                print "\n";
                print "ERROR: can not read message content\n";
                return 1;
            }
            print "Connection: close\n";
            print "Content-type: $type\n";
            print "\n";
            open(MF,"$filepath")||die;
            while(<MF>){
                print;
            }
            close MF;
            last;
        }
    }
    close II;
}

sub printbuttonbar($$$$){
    my $uid=shift;
    my $msgnum=shift;
    my $cookie=shift;
    my $url=shift;
    #
    print '<small><table border="1" align="right" bgcolor="#BABABA"><tr>';
    print "<td bgcolor=\"#DDDDDD\"><a href=\"${url}_send?c=$cookie&amp;a=r$msgnum&amp;uid=$uid\">Reply</a></td>\n";
    print "<td bgcolor=\"#DDDDDD\"><a href=\"${url}_send?c=$cookie&amp;a=f$msgnum&amp;uid=$uid\">Forward</a></td>\n";
    print "<td bgcolor=\"#DDDDDD\"><a href=\"${url}_display?c=$cookie&amp;a=a$msgnum&amp;uid=$uid\">Display raw</a></td>\n";
    print "<td bgcolor=\"#DDDDDD\"><a href=\"${url}_send?c=$cookie&amp;a=n0&amp;uid=$uid\">Compose New</a></td>\n";
    print "<td bgcolor=\"#DDDDDD\"><a href=\"${url}?c=$cookie&amp;a=logout&amp;uid=$uid\" target=\"_top\">Logout</a></td>\n";
    print "</tr></table></small>\n";
}

# end of lfwmail_display

