Статьи » Программирование » Perl » FAQ по разделу CGI интерфейс

Как мне сделать аутентификацию на Перле, а не средствами веб-сервера?:
Для того, чтобы браузер выдал запрос логина и пароля, скрипт должен выдать следующие заголовки:
print "WWW-Authenticate: Basic realm=\"что то там\"\n";
print "Status: 401 Unauthorized\n\n";
print "Ошибка авторизации!\n";
При этом "что то там" - это имя области авторизации, по правилам для области с одним именем должен всегда срабарывать один и тот же пароль. Проблема заключается в том, что ответ пользователя сидит в заголовке HTTP-запроса, в поле Authorization, которое скрипту через переменные окружения не передаётся. Для сервера Апаче эта проблема решается прописыванием в файле конфигурации следующих строк:
RewriteEngine on
RewriteCond %{HTTP:Authorization} ^(.*)
RewriteRule ^(.*) - [E=HTTP_CGI_AUTHORIZATION:%1]
Всё что он делает - это добавляет в переменную окружения HTTP_CGI_AUTHORIZATION, в которую пишется содержимое HTTP заголовка Authorization, таким образом означенное поле становится доступным для анализа внутри скрипта. Формат этого поля следующий: "login:password", причём эта строка закодирована в Base64, получить эти составляющие можно так:
use MIME::Base64;
$ENV{HTTP_CGI_AUTHORIZATION} =~ s/basic\s+//i;
($REMOTE_USER,$REMOTE_PASSWD) =
split(/:/,decode_base64($ENV{HTTP_CGI_AUTHORIZATION}));
Вот простейший скрипт, проверяющий авторизацию. В качестве "правильных значений" используются:
Login - "user"
Password - "userpas"
use MIME::Base64;
$ENV{HTTP_CGI_AUTHORIZATION} =~ s/basic\s+//i;
($REMOTE_USER,$REMOTE_PASSWD) =
split(/:/,decode_base64($ENV{HTTP_CGI_AUTHORIZATION}));

# проверяем значения $REMOTE_USER и $REMOTE_PASSWD
if (!UserAccess($REMOTE_USER,$REMOTE_PASSWD)) {
print "WWW-Authenticate: Basic realm=\"что то там\"\n";
print "Status: 401 Unauthorized\n\n";
print "Ошибка авторизации!\n";
exit;
}

# код, который выполняется при успешной авторизации
print "Content-type: text/html\n\n";
print "Привет, $REMOTE_USER!";
exit;

# простейшая проверка:
# совпадают ли введенные значения с "user" и "userpas"
sub UserAccess {
my $aUser = $_[0];
my $aPass = $_[1];

$res = ( $aUser eq "user" && $aPass eq "userpas" ? 1 : 0);
return $res;
}
Замечание:
=========
Если Вы работаете под ОС Windows и используете Apache для Windows, Вам нужно, для загрузки модуля Rewrite, раскомментировать в файле httpd.conf строку:
LoadModule rewrite_module modules/ApacheModuleRewrite.dll



Я пытаюсть скриптом вывести картинку, а мне вместо нее выдается стандартная битая картинка браузера.:
В этом есть две причины, во-первых необходимо выдавать правильные заголовки, во-вторых на некоторых веб-серверах необходимо переводить потоки ввода-вывода в бинарный режим, лучше это делать всегда. Если Вы берете файл из картинки, можете воспользоваться следующим примером:
print "Content-type: image/gif\n";
# Для JPEG будет image/jpeg
print "Content-length: 7256\n\n";
open (IMG,"image.gif");
binmode IMG;
binmode STDOUT;
print;
close (IMG);
Заголовок Content-length в принципе необязателен, но желателен. Он должен содержать реальный размер файла в байтах. Его можно получить воспользовавшись конструкцией -s

Как сделать upload картинки через форму?:
В случае, если вам не претит воспользоваться модулем CGI, это будет выглядеть примерно так:
use CGI qw/:standard/;

# Код для HTML-формы
print "Content-Type: text/html\n\n";
print "
";
print " ";
print " ";
print "
";

#end of print form

insert_image() if (param());

sub insert_image {
# путь к директории для закачки директория
# должна иметь право на запись для
# пользователя, под которым работает веб-сервер
my $downpath = "tmp/";

my $in=param('picture');

# выделяем имя файла из параметра
my ($name) = $in =~ m#([^\\/:]+)$#;

open(OUT,">$downpath$name");
binmode(OUT);
# читаем входной поток и пишем в файл
while () {
print OUT $_;
}
close(OUT);

# выводим надпись о закачке файла
print "Upload file: $name";
}
Замечание:
Часто возникает проблема: "При закачке картинок 00 меняется на 20(пробел), соответственно картинка не смотрится..."

Это следствие перекодирования http-сервером принимаемых данных.
Если у Вас русский Apache, то эта проблема "лечится" выставлением директивы:
CharsetRecodeMultipartForms off



Как получить документ с другого сервера с помощью perl-сценария?:
Воспользуйтесь модулем LWP (Library for WWW accesss in Perl).

#!/usr/bin/perl
use LWP;
$au=LWP::UserAgent->new();
$au->agent("PerlAU/0.1");

$url="http://askme.webclub.ru";
$document=$au->request(HTTP::Request->new(GET=>$url));
if ($document->is_success) {
print "Content-type: text/html\n\n";
print $document->content;
} else {
print "Content-type: text/html\n\n";
print "Couldn't fetch $url\n";
}
Второй вариант решения:
=====================
Использовать соединение через Socket:

#!/usr/bin/perl
print "Content-type: text/html\n\n";

$host = "askme.webclub.ru";
$port = "80";
$document="http://askme.webclub.ru";

use IO::Socket;
$remote=IO::Socket::INET->new("$host:$port");
unless ($remote) {die "can't connect to http demon on $host at port $port: $!"}
$remote->autoflush(1);
print $remote "GET $document HTTP/1.0\n\n";
while () {print}
close $remote;
Замечание:
=========
Учтите! В этом случае Вы получите ответ сервера полностью, включая HTTP заголовок ответа!



Как мне отправить POST запрос из моего perl-сценария в другую CGI-программу?:
Для отправки данных стоит восполльзоваться модулем LWP (Library for WWW accesss in Perl).
Большинство модулей в этой библиотеке являются объектно-ориентированными. Эмулируемый Агент пользователя, посланные запросы и ответы, полученные от сервера WWW, представлены объектами.

Вариант 1
========
Пусть мы хотим послать запрос в скрипт endpost.cgi следующего вида:

endpost.cgi - принимающий запрос скрипт
#!/usr/bin/perl
use CGI ':standart';
$query=CGI->new();
print "Content-type: text/html\n\n";
if ($query->param("login") && $query->param("passwd")) {
if ($query->param("login") eq 'gorynych' &&

$query->param("passwd") eq 'gorynych') {
print "данные успешно переданы!";
exit;
}
}
$text = $query->param("text");
print << "EOF";
Укажите правильный псевдоним и пароль для передачи!








Введите текст:     
Введите псевдоним:     
Введите пароль:     





EOF

#end
post.cgi - посылающий запрос скрипт
#!/usr/bin/perl
$text = StrEscaped("Есть многое на свете, друг Гораций,
что и не снилось нашим мудрецам!");
$url = "http://your.host.com/cgi-bin/endpost.cgi";
$passwd = "gorynych";
$login = "gorynyc";

# создадим нового Агента пользователя
use LWP::UserAgent;
$ua = LWP::UserAgent->new;

my $req = HTTP::Request->new(POST=>$url);
# указываем тип контекста
$req->content_type('application/x-www-form-urlencoded');
# вводим сам контекст для передачи
$req->content("text=$text&login=gorynych&passwd=gorynych");
my $res = $ua->request($req);

# получаем ответ от выводим его
print "Content-type: text/html\n\n";
print $res->content;
# если вы хотите получить полный ответ, с заголовком HTTP,
# воспользуйтесь вызовом print $res->as_string

# вспомогательные процедуры
sub StrEscaped {
# используем эту процедуру для преобразования
# передаваемых символов кириллицы
my ($str)=@_;
$str=~s/([^0-9A-Za-z\?&=:;])/sprintf("%%%x", ord($1))/eg;
return $str
}
Вариант 2
========
Пусть Вам нужно отправить псевдоним и пароль в некую CGI программу, которая проверяет переданные значения и возвращает 1 в случае успеха и 0 при вводе некоректных значений.

Модифицируем наш сценарий:

1. добавим в начало разбор параметров
use CGI ':standart';
$query = CGI->new();
# если были переданы POST параметры "login" и "passwd"
# заносим их в соответствующие переменные
if ($query->param("login") && $query->param("passwd")) {
$login=$query->param("login");
$passwd=$query->param("passwd");
}
# вводим значения, если переменные неопределенны
$passwd = "user" unless $login;
$login = "passwd" unless $passwd;

use LWP::UserAgent;
$ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(POST=>$url);
$req->content_type('application/x-www-form-urlencoded');
$req->content("text=$text&login=$login&passwd=$passwd");
my $res = $ua->request($req);
...вместо того, чтобы выводить контекст ответа, мы будем его проверять:
$res = $res->content;
if ($res eq 1) {
print "данные успешно переданы!";
} else {
# возвращаем текст в читаемый вид
# и выводим форму для ввода, указывая в качестве
# принимающего сценария наш новый post.cgi
$text = StrUnescaped($text);
print << "EOF";
Укажите правильный псевдоним и пароль для передачи!








Введите текст:     
Введите псевдоним:     
Введите пароль:     





EOF

#end
}

sub StrUnescaped {
my ($str)=@_;
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $str
}Замечание:
=========
"Ленивые люди" используют модуль HTTP::Request::Common, для отправки POST запроса (он сам оперирует заголовками и преобразованием символов и использует предустановленный content_type).

Это выглядит так:
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
my $req = POST $url,
[ text => "$text",
login => "$login",
passwd => "$passwd"
];


Вторая cookie не передается, что неправильно я сделал?:

Если вы используете библиотеку CGI.pm и функции hedaer(), redirect() из нее, то учтите, что вызов процедуры header - означает выдачу заголовка HTTP, который заканчивается комбинацией \n\n, означающей конец заголовка.

Пример:
my $c_login=cookie(-NAME=>"login", -VALUE=>$l);
my $c_passwd=cookie(-NAME=>"password",-VALUE=>$p);

print("Location: /cgi-bin/script.cgi\n\n");
print header(-COOKIE=>$c_login);
# вторая кука не поставиться!
print header(-COOKIE=>$c_passwd);
Если уж Вы так хотите писать, используя CGI.pm, то пишите:
use CGI qw(:cgi);
...

$c1 = cookie( -NAME => 'one',
-VALUE => 'value1',
-EXPIRES => '+1M'
);
$c2 = cookie( -NAME => 'two',
-VALUE => 'value2',
-EXPIRES => '+1M'
);

$redirect = "/cgi-bin/script.cgi";

print redirect( -URL => $redirect,
-COOKIE => [$c1, $c2]
);
Результат, выдаваемый сервером, будет таким:
-----------------------
Status: 302 Moved
Set-Cookie: one=value1; path=/; expires=Sat, 24-Feb-2001 09:21:43 GMT
Set-Cookie: two=value2; path=/; expires=Sat, 24-Feb-2001 09:21:43 GMT
Date: Thu, 25 Jan 2001 09:21:43 GMT
location: /cgi-bin/script.cgi