#!/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;
use MIME::Lite;
sub gethdr($$);
sub getmsg_text($$$);
sub makesendform_top($$$$$$$);
sub sendmessageout($$$);
sub fname2mtype($);
#
# config data pointer:
my $cf=lfwmC::getconfig();
my $q; 
$q=new CGI;
#
# user data pointer:
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'}=~/([frns])(\d+)/){
    $ud->{'action'}=$1;
    $ud->{'msgnum'}=$2;
}else{
    lfwmC::htmldie_std($q,"Error no valid action (".$ud->{'action'}.") received.");
}
# authenticate:
lfwmC::cookie2pw($q,$ud,$cf);
%ENV=();
$ENV{'PATH'}='/bin:/usr/bin';
#
$ENV{'IFS'}=" ";

if ($ud->{'action'} eq "n"){
    # compose a new message
    makesendform_top($q,"new message",'','','',$ud,$cf);
    print "<textarea name=\"mtxt\" rows=\"20\" cols=\"80\" wrap=\"off\">\n";
    #
    print "</textarea>\n<br><br>\n";
    print "<input type=\"hidden\" name=\"a\" value=\"s0\">\n";
    print "<input type=\"submit\" value=\"send mail\"><br><hr><br>\n";
    print "<br>Optional attachment (<small>make a tar.gz/zip file if you want to add more</small>):\n";
    print $q->filefield(-name=>'attdat',-size=>35);
    print $q->endform;
    print $q->end_html;
    print "\n";
}elsif($ud->{'action'} eq "s"){
    # send the message out.
    sendmessageout($q,$ud,$cf);
}elsif ($ud->{'action'} eq "r"){
    # reply
    my $hdrinfo=gethdr($ud,$cf);
    makesendform_top($q,"reply to msg ".$ud->{'msgnum'},$hdrinfo->{'from'},'',$hdrinfo->{'subject'},$ud,$cf);
    print "<textarea name=\"mtxt\" rows=\"20\" cols=\"80\" wrap=\"off\">\n";
    print "\n";
    getmsg_text(1,$ud,$cf);
    #
    print "</textarea>\n<br><br>\n";
    print "<input type=\"hidden\" name=\"a\" value=\"s".$ud->{'msgnum'}."\">\n";
    print "<input type=\"submit\" value=\"send mail\"><br><hr><br>\n";
    print "<br>Optional attachment (<small>make a tar.gz/zip file if you want to add more</small>):\n";
    print $q->filefield(-name=>'attdat',-size=>35);
    print $q->endform;
    print $q->end_html;
    print "\n";
}elsif($ud->{'action'} eq "f"){
    # forward
    my $hdrinfo=gethdr($ud,$cf);
    makesendform_top($q,"forward of msg ".$ud->{'msgnum'},'','',$hdrinfo->{'subject'},$ud,$cf);
    print "<textarea name=\"mtxt\" rows=\"20\" cols=\"80\" wrap=\"off\">\n";
    print "\n----- forwarded message ------\n";
    getmsg_text(2,$ud,$cf);
    #
    print "</textarea>\n<br><br>\n";
    print "<input type=\"hidden\" name=\"a\" value=\"s".$ud->{'msgnum'}."\">\n";
    print "<input type=\"submit\" value=\"send mail\"><br><hr><br>\n";
    my @details;
    if ($hdrinfo->{'attachment'}){
        print "Click on the checkbox to include the attachement(s):<br>\n";
        foreach my $att (sort keys %{$hdrinfo->{'attachment'}}){
            print "File:".$hdrinfo->{'attachment'}->{"$att"}->{'fname'} ."(";
            print $hdrinfo->{'attachment'}->{"$att"}->{'type'}.")\n";
            print "<input type=\"checkbox\" value=\"$att\" name=\"attachment$att\">\n";
            print "   &nbsp;\n";
        }
        print "<br><hr>\n";
    }
    print "<br>Optional attachment (<small>make a tar.gz/zip file if you want to add more</small>):\n";
    print $q->filefield(-name=>'attdat',-size=>35);
    print $q->endform;
    print $q->end_html;
    print "\n";
}else{
    lfwmC::htmldie_std($q,"Program error no action found.");
}

#-----------  end of main program
#
# read mimetmpdir/uid/msgnum and fetch data from mail header
# and info about the number of attachments available
# Returns 0 or a pointer to header info
sub gethdr($$){
    my $ud=shift;
    my $cf=shift;
    my %hdr;
    my $attachmentcount=0;
    my $structdir=$cf->{"mimetmpdir"}."/".$ud->{'uid'}."/".$ud->{'msgnum'};
    unless(open(II,"$structdir/mimeEntities.txt")){
        print "ERROR: message number ".$ud->{'msgnum'}.",no data found\n";
        return 0;
    }
    $hdr{'cc'}='';
    my ($type,$fname,$filepath);
    my @line;
    while(<II>){
        next unless(/\w/);
        chomp;
        @line=split(/;/,$_,3);
        if ($line[0] eq 'head'){
            $hdr{'to'}=$line[2] if ($line[1] eq 'to');
            $hdr{'from'}=$line[2] if ($line[1] eq 'from');
            $hdr{'cc'}=$line[2] if ($line[1] eq 'cc' && $line[2]);
            $hdr{'subject'}=$line[2] if ($line[1] eq 'subject');
            $hdr{'date'}=$line[2] if ($line[1] eq 'date');
            next;
        }
        if ($line[0] eq 'part'){
            ($type,$fname,$filepath)=split(/\^/,$line[2],3);
            if ($type eq 'text/plain' && $fname eq 'unknown'){
                # not an attachment
                next;
            }elsif($type eq 'text/html'  && $fname eq 'unknown'){
                # not an attachment
                next;
            }else{
                #something like: partnum^mimetype^filename^pathtofile
                #filename can be unknown
                $hdr{'attachment'}->{"$attachmentcount"}->{'part'}=$line[1];
                $hdr{'attachment'}->{"$attachmentcount"}->{'type'}=$type;
                $hdr{'attachment'}->{"$attachmentcount"}->{'fname'}=$fname;
                $hdr{'attachment'}->{"$attachmentcount"}->{'path'}=$filepath;
                $attachmentcount++;
            }
        }
    }
    close II;
    return(\%hdr);
}
#
# 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)
# This function produces only plain text with special html characters
# escaped. 
sub getmsg_text($$$){
    my $doindent=shift; # set to 1 for reply messages, 2 for forward
    my $ud=shift;
    my $cf=shift;
    my $indentchar='>';
    my $structdir=$cf->{"mimetmpdir"}."/".$ud->{'uid'}."/".$ud->{'msgnum'};
    unless(open(II,"$structdir/mimeEntities.txt")){
        print "ERROR: message number ".$ud->{'msgnum'}.",no data found\n";
        return 0;
    }
    my ($from,$subject,$cc,$to,$date);
    $cc='';
    $from='(unknown)';
    $subject='(No subject)';
    $date ='(missing date)';
    $to ='(unknown)';
    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
                if ($doindent == 1){
                    # indent with '>' for a reply
                    print lfwmC::htmlescape("$date $from wrote:\n");
                }else{
                    $indentchar='';
                    print lfwmC::htmlescape("To: $to\n") if($doindent == 2);
                    print lfwmC::htmlescape("From: $from\n");
                    print lfwmC::htmlescape("Subject: $subject\n");
                    if ($cc){
                        print lfwmC::htmlescape("CC: $cc\n");
                    }
                    print lfwmC::htmlescape("Date: $date\n");
                    print "\n";
                }
            }
            ($type,$fname,$filepath)=split(/\^/,$line[2],3);
            if ($type eq 'text/plain'){
                unless (-r "$filepath"){
                    print "ERROR: can not read message content\n";
                    next;
                }
                print "\n---------- this is a mime multipart message. New part starts below -------\n\n" if ($partseperator);
                open(MF,"fmt -s -w85 \"$filepath\" |")||die;
                while(<MF>){
                    print lfwmC::htmlescape("$indentchar$_");
                }
                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("$indentchar$_");
                }
                close MF;
            }else{
                print "\n---------- this is a mime multipart message. New part starts below -------\n\n" if ($partseperator);
                print lfwmC::htmlescape("$indentchar|-------------------------\n");
                print lfwmC::htmlescape("$indentchar| Enclosure/Attachment:$fname\n");
                print lfwmC::htmlescape("$indentchar| Type:$type\n");
                print lfwmC::htmlescape("$indentchar|-------------------------\n");
            }
            $partseperator=1;
            $prevfname=$fname;
            $prevtype=$type;
        }
    }
    close II;
    return(1);
}

# given a string like "guido soche" <xxx@yyy>,zz@yyy
# returns: xxx@yyy,zz@yyy
sub get_emails($){
    my $estring=shift;
    my @tmp=split(/[,;]/,$estring);
    $estring="";
    for (@tmp){
        if (/([\w\-\.]+\@[\w\-\.]+)/){
            # contains @
            $estring.=$1 .",";
        }elsif(/([\w\-\.]+)/){
            # local addr:
            $estring.=$1 .",";
        }
    }
    chop($estring);
    return($estring);
}

# make the first part of the send form
sub makesendform_top($$$$$$$){
    my $q=shift;
    my $title=shift;
    my $to=shift;
    my $cc=shift;
    my $subject=shift;
    my $ud=shift;
    my $cf=shift;
    #
    $to=get_emails($to);
    $cc=get_emails($cc);
    $to=lfwmC::htmlescape($to);
    $cc=lfwmC::htmlescape($cc);
    $subject=lfwmC::htmlescape($subject);
    print $q->header(-Pragma=> 'no-cache');
	print $q->start_html(-title=>"lfwmail web mail send form",
'BGCOLOR=#FFFFFF');
    print "<small>".lfwmC::htmlescape($title)."</small><br>\n";
    print $q->start_multipart_form(-method=>'POST',
                        -action=>$cf->{'url'}."_send");
    print '<table border="1" bgcolor="#BABABA">';
    print "<tr><td>To:</td><td><INPUT NAME=\"to\" SIZE=\"80\" TYPE=\"text\" value=\"$to\"></td></tr>\n";
    print "<tr><td>Subject:</td><td><INPUT NAME=\"subject\" SIZE=\"80\" TYPE=\"text\" value=\"$subject\"></td></tr>\n";
    print "<tr><td>Cc:</td><td><INPUT NAME=\"cc\" SIZE=\"80\" TYPE=\"text\" value=\"$cc\"></td></tr>\n";
    print "<tr><td>Bcc:</td><td><INPUT NAME=\"bcc\" SIZE=\"80\" TYPE=\"text\" value=\"\"></td></tr>\n";
    print "</table><br clear=\"all\">\n";
    print "<input type=\"hidden\" name=\"c\" value=\"".$ud->{'cookie'}."\">\n";
    print "<input type=\"hidden\" name=\"uid\" value=\"".$ud->{'uid'}."\">\n";
}


sub sendmessageout($$$){
    my $q=shift;
    my $ud=shift;
    my $cf=shift;
    #
    my $uid=$ud->{'uid'};
    my $msgnum=$ud->{'msgnum'};
    my $mtxt=$q->param('mtxt');
    my $fromuid=$uid;
    # shadow users, for security. Remove a string from uid
    # before sending the mail:
    my $shuid=$cf->{'shadowuid'};
    $fromuid=~s/$shuid//o;
    my $to=$q->param('to');
    lfwmC::htmldie($q,"Error fields To: and/or message text where empty") unless($mtxt && $to);
    my $cc=$q->param('cc');
    my $bcc=$q->param('bcc');
    # remove dangerous garabge from addresses:
    $to=get_emails($to);
    $cc=get_emails($cc) if ($cc);
    $bcc=get_emails($bcc) if ($bcc);
    my $subject=$q->param('subject');
    #
    my $msgtmpfile=$cf->{'mimetmpdir'}."/$uid/attdat.bin";
    # uploaded attachement:
    my $attdat=$q->param('attdat');
    my $attdat_fh=$q->upload('attdat');
    # local attachments (from forwareded messages):
    my @names=$q->param;
    my @localattnums;
    my $havelocalatt=0;
    my ($tmp,$type);
    for my $n (@names){
        if($n=~/^attachment\d/){
            $havelocalatt=1;
            $tmp=$q->param($n);
            push(@localattnums,$tmp) if (defined $tmp);
        }
    }
    my $msg;
    if (($attdat && $attdat_fh)||$havelocalatt){
        # multi part message
        $msg = MIME::Lite->new(
              From     =>$fromuid ."\@". $cf->{'domain'},
              To       =>$to,
              Cc       =>$cc,
              Bcc      =>$bcc,
              Subject  =>$subject,
              Type    =>'multipart/mixed'
              );
        $msg->attach(Type =>'TEXT',Data => $mtxt);
        if ($attdat && $attdat_fh){
            # basename it:
            $attdat=~s/^.*\///;

            # remove strage characters from file name for security:
            $attdat=~s/[^\w\.\-\:]/_/g;
            # get tne mime type of the uploaded attachment file:
            $type=fname2mtype($attdat);
            #
            open(TF,">$msgtmpfile")||die "ERROR: can not write $msgtmpfile, euid=$>\n";
            while (<$attdat_fh>) {
                print TF;
            }
            close TF;
            $msg->attach(Type => $type,
                    Filename =>$attdat,
                    Disposition => 'attachment',
                    Path=>$msgtmpfile);
        }
        my $hdrinfo=gethdr($ud,$cf);
        if ($havelocalatt){
            lfwmC::htmldie($q,"ERROR: attachments not found") unless($hdrinfo && $hdrinfo->{'attachment'});
            my ($t,$fn,$path);
            for my $att (@localattnums){
                $t=$hdrinfo->{'attachment'}->{"$att"}->{'type'};
                next unless($t);
                $fn=$hdrinfo->{'attachment'}->{"$att"}->{'fname'};
                # basename it:
                $fn=~s/^.*\///;
                $path=$hdrinfo->{'attachment'}->{"$att"}->{'path'};
                $msg->attach(Type => $t,
                        Filename =>$fn,
                        Disposition => 'attachment',
                        Path=>$path);
            }
        }
    }else{
        # single part
        $msg = MIME::Lite->new(
              From     =>$fromuid ."\@". $cf->{'domain'},
              To       =>$to,
              Cc       =>$cc,
              Bcc      =>$bcc,
              Subject  =>$subject,
              Type     =>'text/plain',
              Encoding =>'quoted-printable',
              Data     =>$mtxt
              );
    }
    $msg->send || lfwmC::htmldie($q,"Software error: Failed to send message");
    if ( -f "$msgtmpfile"){
        unlink("$msgtmpfile");
    }
    lfwmC::htmldie($q,"OK, message sent");

}

# get the mime type from the name:
sub fname2mtype($){
    my $fname=shift;
    my $type = 'application/octet-stream';
    my $extention;
    #
    # only the most common mime types:
    my %mimeextentions=(
    'gif'=>'image/gif',
    'jpg'=>'image/jpg',
    'jpeg'=>'image/jpg',
    'tif'=>'image/tiff',
    'tiff'=>'image/tiff',
    'png'=>'image/png',
    'txt'=>'text/plain',
    'rtf'=>'text/rtf',
    'shtml'=>'text/html',
    'htm'=>'text/html',
    'html'=>'text/html',
    'phtml'=>'text/html',
    'php'=>'text/html',
    'php3'=>'text/html',
    'php4'=>'text/html',
    'wav'=>'audio/x-wav',
    'ra'=>'audio/x-realaudio',
    'mp3'=>'audio/mpeg',
    'mid'=>'audio/midi',
    'gz'=>'application/x-gzip',
    'ppt'=>'application/vnd.ms-powerpoint',
    'xls'=>'application/vnd.ms-excel',
    'doc'=>'application/msword',
    'zip'=>'application/zip',
    );
    if ($fname =~ /\.(\w+)$/){
        $extention=lc $1;
        if ($mimeextentions{$extention}){
            $type=$mimeextentions{$extention};
        }
    }
    $type;
}

# end of lfwmail_send

