#!/usr/bin/perl
##############################################################################
# PCSend                           Version 1.001                             #
# Создан Free Cat (Art) 02/2004                                              # 
# Use parts of Matt's Script Archive`s                                       #
##############################################################################
# $mailprog - абсолютный путь к sendmail    
$mailprog = '/usr/sbin/sendmail';

# @referers allows forms to be located only on servers which are defined     #
# in this field.  This security fix from the last version which allowed      #
# anyone on any server to use your FBSend script on their web site.          #

@referers = ('vietwingchun.com', 'www.vietwingchun.com');
#@referers = ('vietwingchun.com', 'www.vietwingchun.com', 'www.anna-craft.com', 'anna-craft.com');
@Env_Report = ('REMOTE_ADDR','REMOTE_HOST','HTTP_USER_AGENT',
               'HTTP_REFER','HTTP_ACCEPT_LANGUAGE','HTTP_UA_PIXELS',
               'HTTP_UA_COLOR','HTTP_UA_OS','HTTP_UA_CPU','HTTP_FROM',
               'REMOTE_USER','REMOTE_IDENT'); # 1.001

#почтовые настройки
@MailAdressesAddr = ('anna928@2a.ru');
#@MailAdressesAddr = ('FC@2a.ru');
@MailAdressesName = ('Vietwingchun FeedBack');
$MailAdressesNum = '1';

$WebMailAddress = 'mailInternal@vietwingchun.com' ;
$WebMailName = 'Mail from Site' ;
$WebMailSubj = 'Mail from Users(via vietwingchun.com)' ;

# Эти пути - физические относительно cgi-bin 
# (т.е. как расположены файлы на диске  относительно cgi-bin)
#ссылки на шаблоны и переменные для формирования страницы отправки сообщения
@HTML1Part=('../ssi/HeadHeadRefA.inc');
@HTML1APart=('../ssi/HeadHeadRefB.inc');
$TitleString='Write Letter';
$TitleStringBadReffer='Bad referer - access denied';
$TitleStringFinalPage='Your letter sended';
@HTML2Part=('../ssi/HeadMidd.inc',
            '../css/Sglobal.css',
            '../css/LeftG.css',                   
            '../js/NError.js',                   
            '../ssi/HeadFoot.inc',                   
            '../ssi/BodyTitle.inc',                   
            '../ssi/HeadInfoHead.inc');
$TitleImg='../images/TitleKungFu.jpg'; 
@HTML3Part=('../ssi/HeadInfoMid1.inc',
            '../ssi/SwitchEngE.inc',                   
            '../ssi/AllCountersS.inc',                   
            '../ssi/SwitchRusE.inc',                   
            '../ssi/HeadInfoFoot.inc',                   
            '../ssi/2thMenu.inc',                   
            '../ssi/BodyInfoHead1.inc');
$LineColor='#97CAFF';
@HTML3APart=('../ssi/BodyInfoHead2.inc');
$LineImg='../images/LineKungFu.jpg'; 
@HTML4Part=('../ssi/BodyInfoMid1.inc');
@HTML5Part=('../ssi/BodyInfoMid2.inc',
            '../ssi/Copy_main.inc',                   
            '../ssi/BodyInfoFoot.inc');
#ссылки - конец
# физические пути - конец 
# параметры ответственные за открытку
$URLRetDir = '../'; # путь в сайте  относительно cgi-bin - куда выходить по окончанию
$URLErrDir = '../'; # путь в сайте  относительно cgi-bin - куда выходить по ошибке

#путь к самому скрипту
$CGIURL = "http://vietwingchun.com/cgi-bin/FBSendVWC.pl";
#$CGIURL = "http://anna-craft.com/vietwingchun/cgi-bin/FBSendVWC.pl";

#переменная корректности refers : 1 - нет, 0 - да
$ReferCorrect=0;
#переменные корректности E-mail адресов : 0 - правильный адрес 1 - нет
$Corr_In=0; # отправитель
$Corr_Cont=0; # содержимое
$ERR_AttribStart='<font color="#FF0000">';
$ERR_AttribEnd='</font>';

#переменная вывода финальной страницы
# 1 - да 0 - нет
$OutPage=0;

# Переменные
# action - действие : 2 - отправка (с проверкой полей)  иначе - прием письма
# EML_In - адрес, с которого "отправляется" письмо
# EML_Subj - комментарий к письму
# EML_Rem - письмо
##############################################################################

# проверка URL откуда скрипт вызвался
&Check_URL;
# разбор переданных параметров
&ParseIN;
# получение даты
&Get_Date;
#формирование письма 
if($Form{'action'}==2 && !($ReferCorrect)) {
   $Corr_In=$Corr_Cont=0;
   # проверка почтового адреса и cодержимого
   if (!EML_Check($Form{'EML_In'})) {$Corr_In=1;}
   if (!$Form{'EML_Rem'}) {$Corr_Cont=1;}
   if (!($Corr_In||$Corr_Cont)) { 
     &PCSend_mail;
     $OutPage=1;
   }
 }
# вывод базовой страницы
&BasePage;

######################подпрограмы##################################

sub Check_URL {
  # Localize the check_referer flag which determines if user is valid.     #
  local($check_referer) = 0;
  # If a referring URL was specified, for each valid referer, make sure    #
  # that a valid referring URL was passed to PCSend.                       #
  if ($ENV{'HTTP_REFERER'}) {
      foreach $referer (@referers) {
          if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$referer|i) {
              $check_referer = 1;
              last;
          }
      }
  }
  else {
      $check_referer = 1;
  }
  # If the HTTP_REFERER was invalid, send back an error.                   #
  if($check_referer != 1) { $ReferCorrect=1; }
    else { $ReferCorrect=0; }
}

sub ParseIN {

 if ($ENV{'REQUEST_METHOD'} eq 'GET') {
   # Split the name-value pairs
    @pairs = split(/&/, $ENV{'QUERY_STRING'});
  }
  else {
    # Get the input
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    # Split the name-value pairs
    @pairs = split(/&/, $buffer);
  }

  foreach $pair (@pairs) {
    # Split the pair up into individual variables.                       #
    local($name, $value) = split(/=/, $pair);
    # Decode the form encoding on the name and value variables.          #
    $name =~ tr/+/ /;
    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    # If they try to include server side includes, erase them, so they
    # aren't a security risk if the html gets returned.  Another 
    # security hole plugged up.
    $value =~ s/<!--(.|\n)*-->//g;

    if(name!='EML_Rem') { # если не текст письма
      # всяческая защита
      # убирается нуль-символ
      $value =~ s/\0//g;
      # убираются управляющие символы
      $value =~ s/([\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r])/\\$1/g;
      # убираются двойные точки для выхода на верхний уровень
      $value =~ s/\.\.//g;
      # убирается "труба"
      $value =~ s/(\|)/\\$1/g;
      }

    $Form{$name} = $value;
  }
 # удаляем лишние переводы строки
 $Form{'EML_Rem'} =~ s/\r//g;
}

sub BasePage {
print "Content-type: text/html\n\n";
foreach $parts (@HTML1Part) {&NSSI_Out;}

if ($ReferCorrect) {
print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"10; url=$URLErrDir\">";
}
if ($OutPage) {
print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"3; url=$URLRetDir\">";
}
print "<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=windows-1251\">";


foreach $parts (@HTML1APart) {&NSSI_Out;}
if ($ReferCorrect) {
  print $TitleStringBadReffer; 
  } elsif ($OutPage) {
  print $TitleStringFinalPage;
  } else {
  print $TitleString;
}

foreach $parts (@HTML2Part) {&NSSI_Out;}
print $TitleImg;
foreach $parts (@HTML3Part) {&NSSI_Out;}
print $LineColor;
foreach $parts (@HTML3APart) {&NSSI_Out;}
print $LineImg;
foreach $parts (@HTML4Part) {&NSSI_Out;}

# здесь собственно  рабочая часть
if ($ReferCorrect) {
# неверный referer
  if ($ENV{'HTTP_REFERER'} =~ m|^https?://([\w\.]+)|i) { $YHost = $1; }
  print "<TABLE width=\"630\" border=\"0\" cellspacing=\"0\" cellpadding=\"5\" frame=\"void\" nowrap>";
  print "<TR><TD class=\"size3\">";
  print "<center>$ERR_AttribStart<b>ERROR!</b>$ERR_AttribEnd</center><br>";
  print "<i>&nbsp;&nbsp;&nbsp;&nbsp;For normal script work strong necessary presence the address of your site in array <b>\@referers</b>. Please correct this array for normal script work.<br>";
  print "&nbsp;&nbsp;&nbsp;&nbsp;Add value <b><u>$YHost</u></b> into array <b>\@referers</b>.</i><br>";
  print "</TD></TR></TABLE>";
  } elsif ($OutPage) {
# финальная страница
  print "<TABLE width=\"630\" border=\"0\" cellspacing=\"0\" cellpadding=\"5\" frame=\"void\" nowrap>";
  print "<TR><TD class=\"size3\">";
  print "<center><b>Your letter sended.</b></center><br>";
  print "</TD></TR></TABLE>";
  } else {
# стандартная страница
  print "<TABLE width=\"630\" border=\"0\" cellspacing=\"0\" cellpadding=\"10\" frame=\"void\" nowrap>";
  print "<TR><TD class=\"size5\" align=\"center\">Write Letter<br></TD></TR>";
  print "<TR><TD class=\"size3\" height=\"15\" align=\"center\" valign=\"middle\">";
  if($Corr_In||$Corr_Cont) {
  print "$ERR_AttribStart To any fields(marked red color) write illegal value. Correct please. $ERR_AttribEnd";
    }
  print "</TD></TR></TABLE>";
  print "<form method=\"POST\" action=\"$CGIURL\">";
  print "<TABLE width=\"630\" border=\"0\" cellspacing=\"0\" cellpadding=\"5\" frame=\"void\" nowrap>";
  print "<TR><TD class=\"size3\">";
  print "<INPUT class=\"size3\" type=\"hidden\" name=\"action\" value=\"2\">";
  print "To : \&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp;\&nbsp\;\&nbsp\;"; 
  print "<select class=\"size1\" name=\"EML_OutNum\">";
  print "  <option Selected value=\"0\">Huynh Ngoc An";
  print "</select><br><font class=\"size1\"><br></font>";

  if($Corr_In) { print "$ERR_AttribStart";}
  print "From : ";
  if($Corr_In) { print "$ERR_AttribEnd";}
  print "\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;";
  print " <INPUT class=\"size3\" name=\"EML_In\" size=\"57\"  maxlength=\"100\" value=\"$Form{'EML_In'}\"><br>";
  print "<font class=\"size2\" color=\"#FE0468\">* to fill in necessarily</font><br>";
  print "Subject : \&nbsp\;\&nbsp\;\&nbsp\;<input class=\"size3\" type=\"text\" name=\"EML_Subj\" size=\"57\" maxlength=\"160\" value=\"$Form{'EML_Subj'}\"><br>";
  if($Corr_Cont) { print "$ERR_AttribStart";}
  print "Your letter :<br>";
  if($Corr_Cont) { print "$ERR_AttribEnd";}
  print "<font class=\"size2\" color=\"#FE0468\">* to fill in necessarily</font><br>";
  print "<TEXTAREA class=\"size3\" name=\"EML_Rem\" rows=\"6\" cols=\"70\">$Form{'EML_Rem'}</TEXTAREA>";
  print "</TD></TR><TR><TD class=\"size3\" align=\"center\">";
  print "<INPUT class=\"size3\" type=\"submit\" value=\"SEND!\" name=\"Отправить!\">";
  print "</TD></TR></TABLE></form>";
}
# здесь собственно  конец рабочей части
foreach $parts (@HTML5Part) {&NSSI_Out;}
}

sub EML_Check {
# Initialize local email variable with input to subroutine.              #
$email = $_[0];
# If the e-mail address contains:                                        #

if ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||

  # the e-mail address contains an invalid syntax.  Or, if the         #
  # syntax does not match the following regular expression pattern     #
  # it fails basic syntax verification.                                #

    $email !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/) {

  # Basic syntax requires:  one or more characters before the @ sign,  #
  # followed by an optional '[', then any number of letters, numbers,  #
  # dashes or periods (valid domain/IP characters) ending in a period  #
  # and then 2 or 3 letters (for domain suffixes) or 1 to 3 numbers    #
  # (for IP addresses).  An ending bracket is also allowed as it is    #
  # valid syntax to have an email address like: user@[255.255.255.0]   #

  # Return a false value, since the e-mail address did not pass valid  #
  # syntax.                                                            #
    return 0;
  }
else {
  # Return a true value, e-mail verification passed.                   #
    return 1;
  }
}

sub PCSend_mail {
# отправка письма
# Open The Mail Program
open(MAIL,"|$mailprog -t");

if(($Form{'EML_OutNum'}<0)||((($Form{'EML_OutNum'}+1)>$MailAdressesNum))) 
 { $EML_Out=@MailAdressesAddr[0]; }
else
 { $EML_Out=@MailAdressesAddr[$Form{'EML_OutNum'}];}

print MAIL "To: $EML_Out\n";
print MAIL "From: \"$WebMailName\" \<$WebMailAddress\>\n";
print MAIL "Reply-To: $Form{'EML_In'}\n";
print MAIL "Content-Type: text\/plain; charset=Windows-1251\n";
print MAIL "Content-Transfer-Encoding: 8bit\n";
print MAIL "Subject: $WebMailSubj\n\n";

print MAIL "Отправитель: $Form{'EML_In'}\n";
print MAIL "Тема письма: $Form{'EML_Subj'}\n";
print MAIL "Отправлено : $date\n\n";

print MAIL "$Form{'EML_Rem'}\n";
#1.001 - start
print MAIL "=" x 76 . "\n";
print MAIL "Данные системы отправителя:\n\n";
# Send any specified Environment Variables to recipient.                 #
foreach $env_report (@Env_Report) {
  if ($ENV{$env_report}) {
        print MAIL "$env_report: $ENV{$env_report}\n";
     }
 }
#1.001 - end
close (MAIL);
}

sub Get_Date {

    # Define arrays for the day of the week and month of the year.           #
    @days   = ('Воскресенье','Понедельник','Вторник','Среда',
               'Четверг','Пятница','Суббота');
    @months = ('Январь','Февраль','Март','Апрель','Май','Июнь','Июль',
	         'Август','Сентябрь','Октябрь','Ноябрь','Декабрь');

    # Get the current time and format the hour, minutes and seconds.  Add    #
    # 1900 to the year to get the full 4 digit year.                         #
    ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
    $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
    $year += 1900;

    # Format the date.                                                       #
    $date = "$days[$wday], $mday $months[$mon], $year в $time";
}

sub NSSI_Out {
if(open(INCFile,"$parts")){
  @SLINES=<INCFile>;
  close(INCFile);
  $SSIZE=@SLINES;
  for($i=0;$i<=$SSIZE;$i++) {
     print "$SLINES[$i]"; }
  }
}
