нашел такой скрипт
#!/usr/bin/perl -w
$|=1;
use strict;
use CGI qw( param );
#print "Content-type: text/html\\n\\n";
my(@anketa, $from, $subject);
&get_data;
# Настройки ##############################################
my $sendmail="/usr/sbin/sendmail -t"; #путь к программе sendmail
my $to=\'adres@mail.ru\'; # на какой адрес пересылается анкета
my $redirect=\'
http://www.site.ru/thanks.html\'; #Куда редиректит после отправки письма
#С каких страницы передаются данные
my @refers=(
\'
http://www.site.ru/forma1.html\',
\'
http://www.site.ru/forma2.html\',
\'
http://www.site.ru/forma3.html\',
\'
http://www.site.ru/forma4.html\'
);
##################################################
########
my $refer_x=$ENV{"HTTP_REFERER"};
# Проверяем откуда пршли данные
&secure;
# Формируем сообщение
my ($cx, $c, $message);
for ($cx=0;$cx<$c;$cx++){
$message.="$anketa[$cx][0] - $anketa[$cx][1]\\n";
}
# Отправляем
&sm;
# Редирект после отправки
print "Location: $redirect\\n\\n";
exit;
# Подпрограмма безопасности
sub secure{
##################################################
########
#Это написано из соображений безопасности. Н панацея, но всетаки...
my $saf_flag=0;
if(!$refer_x){$saf_flag=1}
for my $ref(@refers){
if("$ref" eq "$refer_x"){
$saf_flag=0;
last;
}
if("$ref" ne "$refer_x"){$saf_flag=1}
}
if($saf_flag){
#Че-нить пишем в браузер плохому парню
print "Content-type: text/html\\n\\n";
print "
Вы не имеете права пользоваться этим сервисом!!!
";
#Или можно сделать редирект на готовую страницу, тогда 2 следующих строки разкоментируй, а 2 вышестоящих - закомментируй
#my $fuck_page="
http://www.site.ru/fuck_off.html";
#print "Location: $fuck_page\\n\\n";
exit;
}
##################################################
#########
}
# Подпрограмма получения данных из формы
sub get_data{
my @np=param();
$c=0;
for my $x(@np){
if(($x!~/submit|subject|from/) && (param($x))){
$anketa[$c]=["$x", param($x)];
$c++;
}
}
}
# Непосредственно подпрограмма отправки
sub sm{
my $subject=param(\'subject\');
my $from=param(\'from\');
open (MAIL,"|$sendmail");
print MAIL "To: $to\\n";
print MAIL "From: $from\\n";
print MAIL "Subject: $subject\\n\\n";
print MAIL "$message";
close (MAIL);
}
сначала работало теперь всегда вылезает ВЫ НЕ МОГЕТЕ ПОЛЬЗОВАТЬСЯ ЭТИМ СЕРВИСОМ! из подпроги безопасности - попробовал ее потереть стала вылезать ошибка порта 80
