#!/bin/perl
use LWP;
use MIME::Base64;
#configuration section
my $service_from="takeweb\@kilobyte.net";
my $service_reply_to="takeweb\@kilobyte.net";
my $service_errors_to="timur\@kilobyte.net";
my $path = "/home/takeweb/help.txt";
my $sendmail="/usr/lib/sendmail";
#end of configuration section
my $lines_to_process = 10;
my $fromaddress;
my $fromaddress2;
my $requestedurl;
my $date;
my $reply;
my $reply2;
my $precedence;
my $subject;
my $subject2;
my $origin_fromaddress;
my $origin_fromaddress2;
my @buffer;
my $header_space;
my $send;
my $www;
my $urldocroot;
my $boundary= '------------etuchasthuyvstretish73628927525642raz';
my $d, $h;
my %pictures;
my $result;
my $aftertime;
my $attachment;
my $url;
@buffer=;
#print "@buffer\n";
process_headers(@buffer);
process_body(@buffer);
sub process_headers
{
my $return;
{
my ($check,$rcheck,$scheck,$tcheck);
my $i = 0;
# $check == tested the "From:" line
# $rcheck == tested the "Reply-To:" line
# $scheck == tested the "Return-Path:" line
# $tcheck == tested the "Subject:" line
foreach (@_) {
#print "each $_";
/^From ([\w@\.!%-=:"]*)\s*\((.*)\).*/ && (!$check) && ($check =1) && ($origin_fromaddress2 = $2) && ($origin_fromaddress = $1);
# From: address (Full Name and other comments)
/^From: ([\w@\.!%-=:"]*)\s*$/ && (!$check) && ($check =1) && ($origin_fromaddress = $1);
# From: address (Full Name and other comments)
/^From: (.*) <\s*([\w@\.!%-=:"]*)\s*>/ && (!$check) && ($check =1) && ($origin_fromaddress2 = $1) && ($origin_fromaddress = $2);
# From: Full Name
/^Return-Path: <(.*)>/ && (!$scheck) && ($scheck =1) && ($return = $1);
/^Reply-To: ([\w@\.!%-=:"]*)\s*\((.*)\).*/ && (!$rcheck) && ($rcheck =1) && ($reply2 = $2) && ($reply = $1);
# Reply-To: address (Full Name and other comments)
/^Reply-To: ([\w@\.!%-=:"]*)\s*$/ && (!$rcheck) && ($rcheck =1) && ($reply = $1);
# Reply-To: address (Full Name and other comments)
/^Reply-To: (.*) <\s*([\w@\.!%-=:"]*)\s*>/ && (!$rcheck) && ($rcheck =1) && ($reply2 = $1) && ($reply = $2);
# Reply-To: Full Name
/^Subject: (.*)/ && (!$tcheck) && ($tcheck =1) && ($subject = $1);
/\s*Subject: (.*)/ && ($tcheck ==1) && ($subject2 = $1);
/^Precedence: (.*)/ && ($precedence = $1);
/^Date: (.*)/ && ($date = $1);
(/^$/) && (!($header_space)) && ($header_space = $i);
$i++;
}
}
if ($reply2) { $fromaddress2 = $reply2 } else { $fromaddress2 = $origin_fromaddress2 }
if ($reply) {$fromaddress = $reply } else {$fromaddress = $origin_fromaddress }
if ($fromaddress =~ /daemon/i) {&my_die("Hum, Seems to come from a mailer-daemon!!!") }
if (!($fromaddress)) { ($return)?$fromaddress = $return:&my_die("Can't find where the mail is coming from"); }
#if ($fromaddress =~ /server/i) {&my_die("Hum, Seems to come from myself!!!") }
#if ($fromaddress =~ /service/i) {&my_die("Hum, Seems to come from myself!!!") }
if ($subject =~ /returned mail/i) { &my_die("Hum, Seems to be an error message!!!") }
if ($precedence =~ /bulk/i) {&my_die("Hum, looks like a bulk message!!!") }
if ($precedence =~ /junk/i) {&my_die("Hum, looks like a junk message!!!") }
# We have established that $fromaddress is what we will be
# replying to.
}; # end process headers
sub my_die
{
my ($message) = @_;
my (@text);
push(@text,"Subject: Fatal error from service\n");
push(@text, "The service program died with the message\n");
push(@text, "die: $message\n");
push(@text, ".\n");
unshift(@text,"From: ${service_from}\n");
unshift(@text,"Reply-To: ${service_reply_to}\n");
unshift(@text,"Errors-To: ${service_errors_to}\n");
unshift(@text,"To: ${service_errors_to}\n");
open(MAIL,"| $sendmail -t") || die "can not open mail agent\n";
print MAIL @text;
#print @text;
close MAIL;
}
sub process_body
{
my $entry;
my $entry2;
my $i = 0;
foreach (@_) {
if ( ($i > $header_space) && (($i - $header_space) < $lines_to_process))
{
$send=0;
$www=0;
chomp($_);
/^\s*help/i && ($send = 1) && &help_me;
/^\s*send\s*$/i && ($send = 1) && &help_me;
/^\s*send\s*\s*$/i && ($send = 1) && &help_me;
(!(//i)) && (/^\s*send\s+([^\s].*)/i) && ($entry = $1) && ($send = 1) && &process_content($entry);
/^\s*www\s*$/i && ($send = 1) && &help_me;
/^\s*www\s*\s*$/i && ($send = 1) && &help_me;
(!(//i)) && (/^\s*www\s*([^\s].*)/i) && ($entry = $1) && ($www = 1) && &process_content($entry);
/^\s*(http:.*)/i && ($entry = $1) && ($send = 1) && &process_content($entry);
#/^\s*(ftp.*)/i && ($entry = $1) && ($send = 1) && &process_content($entry);
#/^\s*deep\s*(.*)/i && (!($disable_deep)) && ($entry = $1) && ($send = 1) && &www_deep($entry,$_[$i+1]);
/^\s*#/i && ($send = 1); # Comment for those who like Perl...
/^\s*REM/i && ($send = 1); # ...BASIC...
/^\s*\/\//i && ($send = 1); # ...C++
}; #
$i++;
}
} # end sub process_body
sub help_me {
my (@text);
open(TEMP,"${path}help.txt") || &my_die("Unable to open ${path}help.txt for reading");
@text = ;
close TEMP;
unshift(@text,"Subject: Help on the W3 mail robot\n\n");
unshift(@text,"From: ${service_from}\n");
unshift(@text,"Reply-To: ${service_reply_to}\n");
unshift(@text,"Errors-To: ${service_errors_to}\n");
unshift(@text,"To: $fromaddress\n");
open( MAIL,"| $sendmail -t") || die "can not open mail agent\n";
print MAIL @text;
#print @text;
close MAIL;
}
sub process_content
{
$url=$_[0];
$url =~ s/^(.*)\s*$/$1/; #strip space
#print "URL - $url\n";
if(!($url))
{my_die("Bad url: $url"); return; }
unless($url =~ m|^([-\$\w :~#@%\.\+\?&\*\(\)/]*)$|)
{my_die("Bad url: $url"); return; }
if(($url =~ /^telnet/i)||($url =~ /^news/i)||($url =~ /^gopher/i))
{my_die("Bad url: $url"); return; }
if ($url =~ m|//[^/]*$|) { $url =~ s|^(.*)$|$1/| } #add endian /
unless ($url =~ m/^http:\/\//i) { $url = "http://".$url }
$url =~ s/\$/%24/g; # for security
$url =~ s/&/%26/g; # for security
$urldocroot=$url;
$urldocroot =~ s/(.+)\/(.*)$/$1\//g;
($h, $d) = get_doc($url);
$result ="\n\n--$boundary\n";
$result.= $h;
$result.= "Content-Transfer-Encoding: base64\n\n";
if($www){
($attachment, $aftertime) = process_doc($d);
$result.= encode_base64($aftertime);
$result.= $attachment;
}elsif($send){
$result.= encode_base64($d);
}
mail_req($result);
}
sub mail_req
{
my ($text)=@_;
my $message="From: <$service_from>\n";
$message.="Reply-To: <$service_reply_to>\n";
$message.="To: <$fromaddress>\n";
$message.="Subject: $url\n";
$message.="Mime-Version: 1.0\n";
$message.="Content-Type: multipart/mixed; boundary=\"$boundary\"\n";
$message.=$text;
$message.="\n\n--$boundary\n";
open(MAIL,"| $sendmail -t") || die "can not open mail agent\n";
print MAIL $message;
close MAIL;
}
sub get_doc
{
my ($url)=@_;
my $ua = LWP::UserAgent->new;
my $request = HTTP::Request->new('GET', $url);
my $response = $ua->request($request);
my $document;
my $docheader;
if($response->is_success()){
$document = $response->content();
}elsif($response->is_error()){
$document = $response->error_as_HTML();
}else{
$document = $response->as_string();
}
my $typeofcontent = scalar $response->header('Content-Type');
my $langofcontent = $response->header('Content-Language');
$typeofcontent.=";" if(index($typeofcontent, ";")<0);
$typeofcontent =~ /(.*);(.*)/;
my $charset=$2;
$1 =~ /(.*[^,]),* (.*)/;
my $type=$1;
$typeofcontent="$type; $charset";
$docheader = "Content-Language: $langofcontent\n" if(defined $langofcontent);
$docheader .= "Content-Type: $typeofcontent\n";
return ($docheader, $document);
}
sub process_doc
{
my ($content)=@_;
my $head="";
my $body="";
my $picbody="";
my $pos =-1;
my $pos1=-1;
my $pos2=-1;
#?$content =~ s/\012//g;
#?$content =~ s/\015//g;
my $uc_content=uc($content);
my $nametag;
my $end;
my $begin = index($uc_content, "<", -1);
{
do{
#TODO LINK css
$nametag=substr($uc_content,$begin+1,1);
if($nametag eq "!"){ $end=index($uc_content,">",$begin); }
else{
$pos1=index($uc_content,">",$begin);
$pos2=index($uc_content," ",$begin);
if($pos1>$pos2){$pos=$pos2;}
else{$pos=$pos1;}
$nametag=substr($uc_content,$begin+1,$pos-$begin-1);
if($nametag eq "SCRIPT"){
$end=index($uc_content,"",$begin)+9;
}elsif($nametag eq "IMG"){
$pos1=index($uc_content,">",$begin);
$pos2=index($uc_content,"ALT",$begin);
if(($pos1>$pos2)&&($pos2>-1)){
$end=$pos2;
$end=index($uc_content,'"',$end);
$end=index($uc_content,'"',$end+1);
$end=index($uc_content,">",$end+1);
}else{ $end=$pos1; }
$tag=substr($uc_content,$begin,$end-$begin+1);
$pos=index($uc_content,"SRC",$begin);
$pos1=index($uc_content,'"',$pos);
$pos2=index($uc_content,'"',$pos1+1);
$tag=substr($content,$pos1+1,$pos2-$pos1-1);
$emb="cid:".$tag;
substr($content,$pos1+1,$pos2-$pos1-1)=$emb;
$end+=4; #IMG>
$uc_content=uc($content);
unless(defined $pictures{$tag}){
$pictures{$tag}="1";
$head="";
($head, $body)=get_doc($urldocroot.$tag);
$name = $tag;
$name =~ s/.*\///e;
$picbody.="\n\n--$boundary\n";
$picbody.=$head;
$picbody.= " name=\"_$name\"\n";
$picbody.="Content-Transfer-Encoding: base64\n";
$picbody.="Content-ID: <$tag>\n\n";
$picbody.=encode_base64($body);
}
}elsif($nametag eq "A"){
$end=index($uc_content,"",$begin)+4;
$tag=substr($uc_content,$begin,$end-$begin);
$pos=index($uc_content,"HREF",$begin);
$pos1=index($uc_content,'"',$pos);
$pos2=index($uc_content,'"',$pos1+1);
$tag=substr($content,$pos1+1,$pos2-$pos1-1);
if(index($tag,"mailto:")<0){
if($url =~ m/^http:\/\//i){
$emb = "mailto:".$service_from."?subject=get&body=www ".$tag;
}else{
$emb = "mailto:".$service_from."?subject=get&body=www ".$urldocroot.$tag;
}
substr($content,$pos1+1,$pos2-$pos1-1)=$emb;
$end+=(length($emb)-length($tag));
$uc_content=uc($content);
}
}elsif($nametag eq "LINK"){
$end=index($uc_content,">",$begin)+1; #>
$pos2=index($uc_content,"HREF",$begin);
$pos1=index($uc_content,'"',$pos2);
$pos2=index($uc_content,'"',$pos1+1);
$tag=substr($content,$pos1+1,$pos2-$pos1-1);
$emb="cid:".$tag;
substr($content,$pos1+1,$pos2-$pos1-1)=$emb;
$uc_content=uc($content);
unless(defined $pictures{$tag}){
$pictures{$tag}="1";
$head="";
($head, $body)=get_doc($urldocroot.$tag);
$name = $tag;
$name =~ s/.*\///e;
$picbody.="\n\n--$boundary\n";
$picbody.=$head;
$picbody.= " name=\"_$name\"\n";
$picbody.="Content-Transfer-Encoding: base64\n";
$picbody.="Content-ID: <$tag>\n\n";
$picbody.=encode_base64($body);
}
}else{
$end=index($uc_content,">",$begin);
}
}
$begin = index($uc_content, "<", $end);
}while(($begin > -1) && ($end > -1))
}
return ($picbody, $content);
}