Построение Web-сайта
######################################
# Проверка ссылающегося URL &check_url;
# Получить дату &get_date;
# Разобрать содержимое формы &parse_form;
# Проверить обязательные поля &check_required;
# Возвратить HTML-страницу или перенаправить пользователя &return_html;
# Послать E-Mail &send_mail;
sub check_url {
# Локализировать флаг check_referer, который определяет,
# является ли пользователь допустимым .local ($check_referer) = 0;
# Если был – указан URL рекомендателя, убедиться, что для каждого
# допустимого рекомендателя в FormMail передан правильный URL.
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (Oreferers) {
if ($ENV{toTP_REFERER'} =~ m|https?: // ([^/] *) $referer | i) {
last;
} } }
else {
$check_referer = 1;
}
# Если HTTP_REFERER был недопустимым, возвратить ошибку.
if ($check_referer!= 1) { &error <bad_referer') }
}
sub get_date {
# Определить массивы для дней недели и месяцев года.
@days = ('Sunday','Monday','Tuesday','Wednesday',
'Thursday', 'Friday', 'Saturday');
@months =
('January','February',"March','April', 'May','June','July',
'August','September', 'October','November','December');
# Получить текущее время и формат часов, минут и секунд. Добавить
# 1900 к году, чтобы получить полный 4-цифровой год.
($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;
# Сформатировать дату.
$date = "$days[$wday], $months[$mon] $mday, $year at $time";
}
sub parse_form {
# Определить ассоциативный массив для конфигурации
# Config = ('recipient',", 'subject',",
'email',", 'realname', ",
'redirect 1, ' 1, 'bgсоlоr', ",
'background',", 'link_color',",
'vlink_color', ' ', 'text_color', ' ',
'alink_color',", 'title',",
'sort', ' ', 'print_conf ig', ' ',
'required', ", 'eny_report', ",
'return_link_title', ' ', 'return_link_url', ' ',
'print_blank_f ields', ' ', 'missing_f ields_redirect', ");
# Определить для формы REQUEST_METHOD (GET или POST) и распределить
# поля формы по парам имя-значение. Если REQUEST_METHOD не был ни
# GET, ни POST, выдать ошибку.
if ($ENV{'REQUEST_METHOD'} eg 'GET') {
# Разложить по парам имя-значение @pairs = split (/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eg 'POST') {
# Считать входную информацию read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Разложить по парам имя-значение
Opairs = split (/&/, $buf fer); } else {
&error ('request_method');
}
# Для каждой пары имя-значение
foreach $pair (Opairs) {
# Разложить пару по отдельным переменным local($name, $value) = split(/=/, $pair);
# Декодировать кодировку формы для переменных имени и значения
$name =~ tr/+/ /;
$name =~ s/% ([a-fA-FO-9] [a-fA-FO-9]) /packC'c", hex($l)) /eg;
$value =~ tr/+/ /;
$value =~ s/% ([a-fA-FO-9] [a-fA-FO-9])/pack("C", hex($l)) /eg;
# Если они пытаются использовать включения со стороны сервера,
# удалить их, чтобы они не были угрозой безопасности, если html
# будет возвращен. Еще одна брешь в защите перекрыта.
$value =~ s/<!-(. |\n)* › //g;
# Если имя поля указано в массиве %Config, по вызову
# defined ($Config{$name) }) будет возвращена 1 и нам нужно связать
# это значение с соответствующей переменной конфигурации. Если же
# это не конфигурационное поле формы, записать его в ассоциативный
# массив %Form, добавив перед значением ', ', если там уже есть
# какое-то значение. Также сохраним порядок полей формы в массиве
# @Field_Order, чтобы можно было использовать этот порядок при
# обычной сортировке.
if (defined($Config{$name))) { $Conf ig{$name) = $value,-
else {
if ($Form{$name) && $value) {
$Form{$name) = "$Form{$name}, $'value";
elsif ($value) {
push(@Field_Order,$name); $Form{$name} = $value;
} }