#!/usr/bin/perl

use strict;
use Apache;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);
use Mail::Sender;
use HTML::Parser;
use HTML::Filter;
use HTML::Template;
use IPC::SharedCache;

my $post_template_file='/home/oc/www/tmpl/ml-archive.tmpl';

use vars qw/
%form
%cookie
$file
%msg
$cr

$textarea_width
$smtp_host
$BODY
$TITLE
/;

sub Send_Mail {
    my %msg=%{$_[0]};
    open(SENDMAIL,"| sendmail $msg{header}{to}");
    foreach (keys %{$msg{header}}) {
        print SENDMAIL ucfirst($_).": $msg{header}{$_}\n";
    }
    print SENDMAIL "\n";
    print SENDMAIL $msg{body};
    close(SENDMAIL);
}


sub Str_To_Email {
    my $email=$_[0];
    $email=~s/( |%20)dot( |%20)/\./g;
    $email=~s/( |%20)at( |%20)/\@/g;
    $email=~s/&lt;/</s;
    $email=~s/&gt;/>/s;
    $email=~s/&nbsp;/ /s;
    $email=~s/&quot;/"/s;
    return $email;
}

sub Email_To_Str {
    my $email=$_[0];
    $email=~s/\./ dot /sg;
    $email=~s/\@/ at /sg;
    $email=~s/%20/ /sg;
    $email=~s/&lt;/</s;
    $email=~s/&gt;/>/s;
    $email=~s/&nbsp;/ /s;
    $email=~s/&quot;/"/s;
    $email=~s/ +/ /gs;
    $email=~s/^[$cr\n]+//gs;
    $email=~s/[$cr\n]+$//gs;
    return $email;
}

sub Html2Text {
    my @line=();
    my $tag=1;

sub tag_handler {
    return if ($tag);
    my $in=$_[0];
    if ($in=~m/^p$/i) {
        $tag=1;
        push(@line,"\n\n");
    }
    if ($in=~m/^(div|table|tr|br|block)/i) {
        $tag=1;
        push(@line,"\n");
    }
}

sub text_handler {
    my $in=$_[0];
    $in=~s/\n/ /g;
    $in=~s/&nbsp;/ /g;
    push(@line,$in);
    $tag=0;
}

    my $p=HTML::Parser->new(api_version => 3);
    $p->handler(text => \&text_handler, "text");
    $p->handler(start => \&tag_handler, "tagname");
    $p->parse($_[0]);
    my $result=join(//,@line);
    $result=~s/ +/ /sg;
    $result=~s/^(\n| )*//sg;
    return $result;
}

sub Format_Text {
    my $result='';
    my @line=split(/\n/,$_[0]);
    foreach my $line (@line) {
        my $new_line='';
        foreach my $word (split(/ /,$line)) {
            if (length($new_line.$word)>$_[1]-1) {
                $result.=$new_line."\n";
                $new_line="$word ";
            } else {
                $new_line.=$word;
                $new_line.=' ';
            }
        }
        $result.=$new_line."\n";
    }
    return $result;
}

sub Read_Source {
    open(FILE,$file) or die("can't open file $file");
    while(my $line=<FILE>) {
        $msg{source}.=$line;

        if ($line=~m/<LI><em>From<\/em>: (.*)$/i && $msg{from} eq '') {
            my @elt=split(/,|;/,$1);
            foreach (@elt) {
                if ($_=~m/to=([^&]+)/i) {
                    $msg{from}.=', 'if ($msg{from});
                    $msg{from}.="$1";
                }
            }
        }


        if ($line=~m/<LI><em>To<\/em>: (.*)$/i && $msg{to} eq '') {
            my @elt=split(/,|;/,$1);
            foreach (@elt) {
                if ($_=~m/to=([^&]+)/i) {
                    $msg{to}.=', 'if ($msg{to});
                    $msg{to}.="$1";
                }
            }
        }

        if ($line=~m/<LI><em>Reply-To<\/em>: (.*)$/i && $msg{'reply-to'} eq '') {
            my @elt=split(/,|;/,$1);
            foreach (@elt) {
                if ($_=~m/to=([^&]+)/i) {
                    $msg{'reply-to'}.=', 'if ($msg{'reply-to'});
                    $msg{'reply-to'}.="$1";
                }
            }
        }

        if ($line=~m/<LI><em>Cc<\/em>: (.*)$/i && $msg{cc} eq '') {
            my @elt=split(/,|;/,$1);
            foreach (@elt) {
                if ($_=~m/to=([^&]+)/i) {
                    $msg{cc}.=', 'if ($msg{cc});
                    $msg{cc}.="$1";
                }
            }
        }



        if ($line=~m/<LI><em>Date<\/em>: *(.*)<\/LI>$/i && $msg{date} eq '') {
            $msg{date}=$1;
            $msg{date}=~s/<A HREF="[^"]*">|<\/A>//ig;
        }
        if ($line=~m/<LI><em>Subject<\/em>: *(.*)<\/LI>$/i && $msg{subject} eq '') {
            $msg{subject}=$1;
        }
    }
    close(FILE);
    $msg{source}=~m/<!--X-Body-of-Message-->(.*)<!--X-Body-of-Message-End-->/s;
    $msg{body}=$1;
    $msg{body}=~s!--\nTo unsubscribe from.*http://www\.opencores\.org/mailinglists\.shtml!!igs;
    if ($msg{body}=~m/<(div|table|tr|br|block)/i) {
        $msg{body}=Html2Text($msg{body});
    } else {
        $msg{body}=~s/< *\/* *pre *>//isg;
        $msg{body}=~s/< *a +[^>]*href="([^"]*)"[^>]*>[^<]*< *\/a[^>]*>/$1/isg;
        $msg{body}=~s/< *\/a[^>]*>//gis;
    }


    foreach (qw (body subject)) {
        $msg{$_}=~s/&lt;/</s;
        $msg{$_}=~s/&gt;/>/s;
        $msg{$_}=~s/&nbsp;/ /s;
        $msg{$_}=~s/&quot;/"/s;
        $msg{$_}=~s/ +/ /gs;
        $msg{$_}=~s/^[$cr\n]+//gs;
        $msg{$_}=~s/[$cr\n]+$//gs;
    }
    foreach (qw (from to cc reply-to)) {
        $msg{$_}=Email_To_Str($msg{$_});
    }
}


sub Output {
    my %out=();
    foreach (qw (from to cc)) {
        $out{$_}=$msg{$_};
        $out{$_}=~s/</&lt;/g;
        $out{$_}=~s/>/&gt;/g;
        $out{$_}=~s/"/&quot;/g;
    }
    $BODY.="<p>To prevent abuse and spamming, your IP address and other information may be attached to this message.<p>";
    $BODY.="<p>You must specify 'From' address otherwise message won't be send!<p>";
    $BODY.="<p>$_[0]</p>" if ($_[0]);
    $BODY.="<form action=$ENV{SCRIPT_NAME} method=post><table>";
    $BODY.="<tr><td>From: </td><td><input type=query name=from value=\"$out{from}\" size=50></td></tr>";
    $BODY.="<tr><td valign=top>To: </td><td>".join('<br>',split(/, /,$out{to}))."</td></tr>";
    $BODY.="<tr><td>Subject: </td><td><input type=query name=subject value=\"$msg{subject}\" size=50></td></tr>";
    $BODY.="</table><table><tr><td><textarea cols=$textarea_width rows=22 wrap=soft name=body>$msg{body}</textarea>
    <br>&nbsp;<center><input type=submit value=\"  Send  \"></td></tr></table>";
    $BODY.="<input type=hidden name=cmd value='send'>
    <input type=hidden name=msg value='$form{msg}'>
    <input type=hidden name=to value=\"$msg{to}\"></form>";

}

sub Reply {
    Read_Source;
    $msg{cmd}='send';
    my $date=my $cc='';
    $cc="\nCC: $msg{cc}" if ($msg{cc} ne '');
    $date="\nDate: $msg{date}" if ($msg{date}=~m/:/);
    $msg{body}=Format_Text($msg{body},$textarea_width-2);
    $msg{body}='> '.$msg{body};
    $msg{body}=~s/[$cr\n]{1}/\n> /gs;
    my $header=<<END


----- Original Message -----
From: $msg{from}
To: $msg{to}$cc$date
Subject: $msg{subject}

END
;
    $msg{body}=Format_Text($header,$textarea_width)."\n".$msg{body};
    unless ($msg{subject}=~m/^re:/i) {
        $msg{subject}='Re: '.$msg{subject};
    }
    if ($msg{'reply-to'} ne '') {
        $msg{to}=$msg{'reply-to'};
    }
    foreach (qw(from cc reply-to)) {
        $msg{from}='' if ($msg{$_} eq $msg{from} && $_ ne 'from');
        $msg{cc}='' if ($msg{$_} eq $msg{cc} && $_ ne 'cc');
        $msg{'reply-to'}='' if ($msg{$_} eq $msg{'reply-to'} && $_ ne 'reply-to');
    }
    if ($form{cmd} eq 'reply_all') {
        $msg{to}=join(', ', ($msg{from},$msg{cc},$msg{'reply-to'}));
    }
    $msg{to}=~s/, , /, /g;
    $msg{to}=~s/, *$//g;
    $msg{body}="\n&nbsp;".$msg{body};
    $msg{from}=$cookie{post_from};
    Output;
}

sub New {
    Read_Source;
    $msg{cmd}='send';
    $msg{body}='';
    $msg{subject}='';
    my $to1=$form{to};
    my $to2=$form{to};
    my $to3=$form{to};
    $to2=~s/ /%20/g;
    if ($msg{source}=~m/$to1/i || $msg{source}=~m/$to3/i || $msg{source}=~m/$to2/i) {
        $msg{to}=Email_To_Str($form{to});
        $msg{from}=$cookie{post_from};
        Output;
    } else {
        $BODY.="Invalid to address: '$form{to}'";
    }
}

sub Send_Error {
    print header;
    $msg{from}=$form{from};
    $msg{to}=$form{to};
    $msg{subject}=$form{subject};
    $msg{body}=$form{body};
    Output("<font color=red>$_[0]</font>");
}

sub Send {
    my $result="";
    my $set_cookie=0;
    Read_Source;
    my $from=$form{from};
    unless ($from=~m/.+\@.+\..+/) {
        Send_Error("You must provide valid 'From' address!");
        return;
    }
    if ($form{subject}=~m/^ *$/) {
        Send_Error("Message must have a subject!");
        return;
    }
    my $to=$form{to};
    my $found=1;
    foreach (split(/, /,$to)) {
        $found=0 unless ($msg{to}=~m/$_/ || $msg{from}=~m/$_/ || $msg{'reply-to'}=~m/$_/ || $msg{cc}=~m/$_/ || $_=~m/[A-Z0-9]\@opencores.org/i);
    }
    unless ($found) {
        Send_Error("Invalid 'To' address: $to!");
        return
    } elsif(length($form{body})<12) {
        Send_Error('Body is too short');
        return;
    } else {
        $from=Str_To_Email($from);
        $to=Str_To_Email($to);
        my $subject=$form{subject};
        my $msg=$form{body};
#        my $sender=new Mail::Sender{
#            smtp=>$smtp_host,
#            from=>$from,
#            to=>$to,
#            subject=>$subject,
#            headers => "X-Originating-IP: $ENV{REMOTE_ADDR}\r\n",
#        };
#        if ($sender->MailMsg({msg=>$msg})<0) {
#            $BODY="Can't send email: $Mail::Sender::Error. Please contact webmaster.";
#        } else {

            my %msg=();
            $msg{header}{from}=$from;
            $msg{header}{to}=$to;  
            $msg{header}{subject}=$subject;
            $msg{body}=$msg;
            Send_Mail(\%msg);

            my $date=`date`;
            system("echo \"$date\tIp: $ENV{'REMOTE_ADDR'}\n\tFrom: $form{from}\n\tTo: $to\n\tSubject: $subject\n\tFile: $file\n\" >> /tmp/webpost.log");
            $BODY="Message successfully sent.";
            $set_cookie=1 if ($cookie{post_from} ne $form{from} && $form{from}=~m/.+\@.+\..+/);
#        }
    }
    if ($set_cookie) {
        my $cookie=cookie(
            -name=>"post_from",
            -value=>$from,
            -expires=>'+1y',
        );

        print header(-cookie=>[$cookie]);
    } else {
        print header; 
    }
}

sub Template_Output {
    my $template=HTML::Template->new(
        filename=>$post_template_file,
    );
    $template->param(
        title=>$TITLE,
        body=>$BODY
    );
    print $template->output;

}

sub Main {
   $ENV{PATH}="/usr/local/bin:/bin:/usr/bin:/usr/X11R6/bin:.";
   %form=();
   %cookie=(); 
   $file='';
   %msg=();
   $cr=chr(13);

   $textarea_width=60;
   $smtp_host='localhost';
   $BODY='';
   $TITLE='Post';
    my $query=new CGI;
    foreach ($query->param) {
        $form{$_}=$query->param($_);
    }
    $form{to}=Email_To_Str($form{to});
    foreach ($query->cookie) {
        $cookie{$_}=$query->cookie($_);
    }  
    print header unless ($form{cmd} eq 'send');

    $file='/home/oc/www'.$form{msg};
    if ($form{msg}=~m/\.\./ || !($form{msg}=~m/^\/ml-archive\//)) {
        $BODY.="Invalid message";
    }
    if ($form{cmd}=~m/^reply/) {
        Reply;
    } elsif ($form{cmd} eq 'send') {
        Send;
    } elsif ($form{cmd} eq 'new') {
        New;
    } else {
        $BODY='Unknown command!';
    }
    Template_Output;
}

Main;