#!/usr/bin/perl
##############################################################################
# PCSend                           Version 1.11                              #
# Создан Free Cat (Art) 04/2003 - 05/2003                                    # 
# исправления до 1.1 Free Cat (Art) 06/2003                                  # 
# 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 PCSend script on their web site.          #

@referers = ('2a.ru', 'www.2a.ru', '2agroup.com', 'www.2agroup.com');

# Эти пути - физические относительно cgi-bin 
# (т.е. как расположены файлы на диске  относительно cgi-bin)
#ссылки на шаблоны и переменные для формирования страницы отправки открытки
@HTML1Part=('../ssi/HeadHeadRefA.inc');
@HTML1APart=('../ssi/HeadHeadRefB.inc');
$TitleString='Отправка Открыточки';
$TitleStringBadReffer='Нет ссылки - доступ закрыт';
$TitleStringFinalPage='Ваша открытка отправлена';
@HTML2Part=('../ssi/HeadMidd.inc',
            '../css/Sglobal.css',
            '../css/LeftG.css',                   
            '../js/NError.js',                   
            '../js/Common_code_1.js',                   
            '../js/ChilMenu.js',                   
            '../ssi/HeadFoot.inc',                   
            '../ssi/BodyTitle.inc',                   
            '../ssi/ChilMenuObj2th.inc',                   
            '../ssi/PageStartHead.inc');
$TitleIMG='../images/2thTitles/TAnna.jpg'; # путь в сайте относительно cgi-bin
@HTML3Part=('../ssi/PageStartMid1.inc',
            '../ssi/2thMenu.inc',
            '../ssi/PageStartMid2.inc');
$LeftBlank='298';
@HTML4Part=('../ssi/PageStartFoot.inc',
            '../ssi/PageContHead.inc',
            '../ssi/AllCountersS.inc',
            '../ssi/PageContMidd.inc');
@HTML5Part=('../ssi/CopyNTable.inc',
            '../ssi/PageFoot.inc');
@Mail1Part=('../ssi/HeadHead.inc');
$TitleMailString='Вам пришла открытка с сайта 2a.ru';
@Mail2Part=('../ssi/HeadMidd.inc',
            '../css/Sglobal.css',
            '../js/NError.js',                   
            '../ssi/HeadFoot.inc',                   
            '../ssi/BodyTitle.inc');
@Mail3Part=('../PostCards/ssi/MailHead.inc',
            '../PostCards/ssi/MailMidd1.inc');
@Mail4Part=('../PostCards/ssi/MailMidd2.inc');
@Mail5Part=('../PostCards/ssi/MailFoot.inc');
@Mail6Part=('../ssi/CopyNTableGlob.inc',
            '../ssi/PageFootShort.inc');
$IMGBaseAbs='../PostCards/images/';
#ссылки - конец
# физические пути - конец 
# параметры ответственные за открытку
$IMGBaseDir = '../PostCards/images/';  # путь в сайте относительно cgi-bin
$URLBaseDir = '../PostCards/';  # путь в сайте относительно cgi-bin

#путь к самому скрипту
$CGIURL = "http://2a.ru/cgi-bin/PCSend.pl";

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

#переменная направления вывода функции NSSI_Out
# 0 - STDOUT 1 - MAIL
$NSSI_Select=0;
#переменная вывода финальной страницы
# 1 - да 0 - нет
$OutPage=0;
#массив письма из формы 
$MailRem;
# размер файла картинки - предположительный MAX
$MaxFileSize=250000;

# дальше переменные, относящияеся к логу
$Ylog=1 ; # лог : 1 - да, 0 - нет
$LogFileAbs="../../PCData/PCLog.log"; # абсолютный путь к файлу лога
$date_command = "/bin/date";
$ShortDate = `$date_command +"%D %T %Z"`; chop($shortdate);

# Переменные
# category - категория открытки (обычно 2 буквы - обозначают подкаталог
#            в базовом каталоге и приставку к индексу)
# number - имя файла открытки без расширения
# back - имя html-файла для возврата
# action - действие : 2 - отправка (с проверкой полей)  иначе - просто показ 
# EML_Out - адрес, по которому производится отправка открытки
# EML_In - адрес, с которого "отправляется" открытка
# EML_InName - имя "отправившего" открытку
# EML_Rem - комментарий к открытке, письмо
##############################################################################

# проверка URL откуда скрипт вызвался
&Check_URL;
# разбор переданных параметров
&ParseIN;
#формирование письма 
if($Form{'action'}==2 && !($ReferCorrect)) {
  $Corr_In=$Corr_Out=0;
  # проверка почтовых адресов
  if (!EML_Check($Form{'EML_In'})) {$Corr_In=1;}
  if (!EML_Check($Form{'EML_Out'})) {$Corr_Out=1;}
  if ($Ylog) { &PCLog; }
  if (!($Corr_In||$Corr_Out)) { 
    &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;
  }
 # создаём строку для вывода в HTML-виде
 if($Form{'action'}==2) { # переводим переводы строк в <br> и удаляем лишнее
   $MailRem = $Form{'EML_Rem'};
   $MailRem =~ s/\n/<br>/g; 
   $MailRem =~ s/\r//g; }
 # удаляем лишние переводы строки
 $Form{'EML_Rem'} =~ s/\r//g;
}

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

if ($ReferCorrect) {
print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"10; url=../index.shtml\">";
}
if ($OutPage) {
print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"3; url=$URLBaseDir$Form{'back'}.shtml\">";
}

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 $LeftBlank;
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>ОШИБКА!</b>$ERR_AttribEnd</center><br>";
  print "<i>&nbsp;&nbsp;&nbsp;&nbsp;Для нормальной работы скрипта необходимо наличие адреса вашего сайта в массиве <b>\@referers</b>. Исправьте этот массив для нормальной работы скрипта.<br>";
  print "&nbsp;&nbsp;&nbsp;&nbsp;Добавьте значение <b><u>$YHost</u></b> к массиву <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>Ваша открытка отправлена.<br>Вы можете отправить ещё несколько.</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=\"size3\" height=\"470\" align=\"center\" valign=\"middle\">";
  print "<img src=\"$IMGBaseDir/$Form{'category'}/$Form{'number'}.jpg\"></TD></TR>";
  print "<TR><TD class=\"size3\" height=\"30\" align=\"center\" valign=\"middle\">";
  if($Corr_In||$Corr_Out) {
  print "$ERR_AttribStartНекоторые поля(отмечены красным) содержат неверные значения. Пожалуйста исправьте.$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=\"category\" value=\"$Form{'category'}\">";
  print "<INPUT class=\"size3\" type=\"hidden\" name=\"number\" value=\"$Form{'number'}\">";
  print "<INPUT class=\"size3\" type=\"hidden\" name=\"back\" value=\"$Form{'back'}\">";
  print "<INPUT class=\"size3\" type=\"hidden\" name=\"action\" value=\"2\">";
  if($Corr_Out) { print "$ERR_AttribStart";}
  print "E-mail друга :";
  if($Corr_Out) { print "$ERR_AttribEnd";}
  print " <INPUT class=\"size3\" name=\"EML_Out\" size=\"27\" value=\"$Form{'EML_Out'}\">&nbsp;&nbsp;&nbsp;&nbsp;";
  if($Corr_In) { print "$ERR_AttribStart";}
  print "Ваш E-mail :";
  if($Corr_In) { print "$ERR_AttribEnd";}
  print " <INPUT class=\"size3\" name=\"EML_In\" size=\"27\" value=\"$Form{'EML_In'}\">";
  print "</TD></TR><TR><TD class=\"size3\">";
  print "Ваше имя :&nbsp;&nbsp;&nbsp;&nbsp;<INPUT class=\"size3\" name=\"EML_InName\" size=\"47\" value=\"$Form{'EML_InName'}\"><font class=\"size2\" color=\"#FF0090\">&nbsp;&nbsp;(не обязательно)</font>";
  print "</TD></TR><TR><TD class=\"size3\">";
  print "&nbsp;&nbsp;&nbsp;&nbsp&nbsp;&nbsp;&nbsp;&nbsp&nbsp;&nbsp;&nbsp;&nbsp&nbsp;&nbsp;&nbsp;&nbsp&nbsp;&nbsp;&nbsp;&nbsp&nbsp;&nbsp;Ваше сообщение :";
  print "</TD></TR><TR><TD class=\"size3\">";
  if($Form{'action'}==2) {
    print "<TEXTAREA class=\"size3\" name=\"EML_Rem\" rows=\"8\" cols=\"70\">$Form{'EML_Rem'}</TEXTAREA>";
  }else{
    print "<TEXTAREA class=\"size3\" name=\"EML_Rem\" rows=\"8\" cols=\"70\">Порадуйся и ты ;-)</TEXTAREA>";
  }
  print "</TD></TR><TR><TD class=\"size3\" align=\"center\">";
  print "<INPUT class=\"size3\" type=\"submit\" value=\"Отправить!\" 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 {
# отправка открыточки
$NSSI_Select=1;
#файл изображения
binmode IMGFileB;
# Open The Mail Program
open(MAIL,"|$mailprog -t");
#open(MAIL,">1_1.eml");

print MAIL "To: $Form{'EML_Out'}\n";
print MAIL "From: $Form{'EML_In'} ($Form{'EML_InName'})\n";
print MAIL "Reply-To: $Form{'EML_In'}\n";
print MAIL "Subject: Вам пришла открытка(с сайта 2a.ru)\n";
print MAIL <<"(EndMail)";
MIME-Version: 1.0
Content-Type: multipart/related;
	type="multipart/alternative";
	boundary="----=_NextPart_000_0036_01C1739F.7769C7E0"

This is a multi-part message in MIME format.

------=_NextPart_000_0036_01C1739F.7769C7E0
Content-Type: multipart/alternative;
	boundary="----=_NextPart_001_0037_01C1739F.777A90C0"

------=_NextPart_001_0037_01C1739F.777A90C0
Content-Type: text/html;
	charset="windows-1251"
Content-Transfer-Encoding: 8-bit

(EndMail)
foreach $parts (@Mail1Part) {&NSSI_Out;}
print MAIL $TitleMailString;
foreach $parts (@Mail2Part) {&NSSI_Out;}
foreach $parts (@Mail3Part) {&NSSI_Out;}

print MAIL "$Form{'EML_In'}\">$Form{'EML_In'}</a>";
if($Form{'EML_InName'}) {print MAIL " от $Form{'EML_InName'}";}

if($Form{'EML_Rem'}) {
  foreach $parts (@Mail4Part) {&NSSI_Out;}
  print MAIL "$MailRem\n"; }

foreach $parts (@Mail5Part) {&NSSI_Out;}
foreach $parts (@Mail6Part) { &NSSI_Out;}
print MAIL "\n\n";

print MAIL <<"(EndMailG)";
------=_NextPart_001_0037_01C1739F.777A90C0
Content-Type: image/jpeg;
	name="Vasha_Otkrytka.jpg"
Content-Transfer-Encoding: base64
Content-Location: Vasha_Otkrytka.jpg

(EndMailG)

if(open(IMGFileB,"<$IMGBaseAbs$Form{'category'}/$Form{'number'}.jpg")){
    binmode(IMGFileB);
    # @SLINES=<IMGFileB>;
     binmode(MAIL);
#    while (read IMGFileB, $instr , 1024) {
    while (read IMGFileB, $instr, $MaxFileSize) {

    # open(OUTF,">1_1.jpg");
    # binmode(OUTF);
    # print OUTF "$instr"; 
    # close OUTF;

      $OutLine=E_base64($instr);
      print MAIL "$OutLine";
      }
    # open(OUTF,">1_1.jpg");
    # binmode(OUTF);
    # print OUTF while (<IMGFileB>); 
    # close OUTF;


    close(IMGFileB);
    # $OutLine=E_base64(@SLINESB);
    # print MAIL "$OutLine";
    #print MAIL "@SLINESB";
}

print MAIL <<"(EndMailGF)";

------=_NextPart_001_0037_01C1739F.777A90C0
(EndMailGF)

close (MAIL);
}

sub NSSI_Out {
if(open(INCFile,"$parts")){
  @SLINES=<INCFile>;
  close(INCFile);
  $SSIZE=@SLINES;
  for($i=0;$i<=$SSIZE;$i++) {
     if($NSSI_Select) {
       print MAIL "$SLINES[$i]"; }  # добавить encoding
     else {
       print "$SLINES[$i]"; }
    }
  }
}

sub E_base64 {
    my $res = "";
    my $eol = "\n";

    pos($_[0]) = 0;
    while ($_[0] =~ /(.{1,45})/gs) {
	$res .= substr(pack('u', $1), 1);
	chop($res);
    }
    $res =~ tr|` -_|AA-Za-z0-9+/|;

    ### Fix padding at the end:
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;

    ### Break encoded string into lines of no more than 76 characters each:
    $res =~ s/(.{1,76})/$1$eol/g if (length $eol);
    return $res;
} 

sub PCLog {
# вывод лог-файла
open (LOG, ">>$LogFileAbs");
print LOG "$ShortDate ";
print LOG "IMG: $Form{'category'}/$Form{'number'}.jpg ";
print LOG "From: $Form{'EML_In'} ($Form{'EML_InName'})";
if($Corr_In) { print  LOG "[ERR!]";}
print LOG " To: $Form{'EML_Out'} ";
if($Corr_Out) { print  LOG "[ERR!]";}
print LOG "\n";
close (LOG);
} 
