Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: Общие вопросы > Разбор запроса http

Автор: justauser 22.9.2014, 12:31

Начал разбираться с Perl (я не программист) и для тренировки решил написать простейший http сервер без использования спец. модулей. Пока получилось сделать сетевую чась (минимально). Сервер слушает порт 80, принимает подключения, форкается и выдает прописанный в скрипте index.html не разбирая запрос. Это работает в браузере, я проверил. Но запрос может быть на разные страницы поэтому его нужно разобрать на отдельные переменные. Пока я его просто печатаю в консоли
GET / HTTP/1.1
Host: localhost
User-Agent: Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:32.0) Gecko/20100101 Firefox/32.0
Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language: en-US,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive
а нужно все параметры разделить по отдельным переменным, но не соображу как. Можете написать пример?
Запрос получаю
$count = sysread(FH, $data, 1400);
вот $data и нужно разобрать.

p.s.
Заодно проверьте пожалуйста на ошибки то что я уже сделал

Код


#!/usr/bin/perl
use strict;
use warnings;
use Socket;
use POSIX;
my $host = "localhost";
my $port = "80";
my $length = 10;
my $pif;
my $sin = sockaddr_in($port,inet_aton($host));

  socket(F, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die $!;
  setsockopt(F, SOL_SOCKET, SO_REUSEADDR, 1); 
  bind(F,$sin)  || die $!;
  listen(F, $length) || die $!;
  
print "PID: $$\n\n";  
while (accept(FH,F) || die $!) {

$SIG{CHLD} = &REAPER;

#ветвление процесса
defined($pif=fork()) || die $!; 

if ($pif){
#родитель
 close(FH);
}
else
{    
#потомок
 print "Child-PID: $$\n\n";
 child();
}
}

close(F);
exit();

sub child{
    
 close(F);
my $fh;
my @fhn;
my $data;
my $count;

 $count = sysread(FH, $data, 1400);
 
 open($fh, "<", "/var/www/index.html");
 @fhn=<$fh>;
 print FH "HTTP/1.0 200 Ok\r\nContent-Type: text/html\r\nContent-Length: 82\r\nConnection: close\r\n\r\n";
 print FH @fhn;
 print $data;
 close($fh);
 close(FH);
 exit();
 }

sub REAPER {    
 while ((my $waitedpid = waitpid(-1,WNOHANG)) > 0) {
 $SIG{CHLD} = &REAPER;}
 }

Автор: arto 22.9.2014, 12:48

# perl -MData::Dumper -le 'print Dumper do { local$/="";my%a=map{split":? ",$_,2}split"\r?\n",<STDIN>;\%a}'
$VAR1 = {
          'User-Agent' => 'Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:32.0) Gecko/20100101 Firefox/32.0',
          'Accept-Language' => 'en-US,en;q=0.5',
          'Accept-Encoding' => 'gzip, deflate',
          'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
          'GET' => '/ HTTP/1.1',
          'Connection' => 'keep-alive',
          'Host' => 'localhost'
        };
#

Автор: justauser 22.9.2014, 12:56

Спасибо но мне без доп модулей нужно. А Data::Dumper отдельный модуль. Как можно $data разобрать стандартными средствами?

Автор: arto 22.9.2014, 13:11

оно разбирает стандартными средствами, а Dumper выводит в удобоваримом виде.

Автор: justauser 22.9.2014, 17:45

По вашему предложению сделал такой тестовый скрипт для разбора, вроде работает. Наверняка можно проще.

Код


#!/usr/bin/perl 
local$/="";
my @a=map{split":? ",$_,2}split"\r?\n",<STDIN>;
my $n=@a/2;
print "Найдено строк: ".$n."\n";
for ($x=0; $x < @a; ++$x){
    if ($a[$x] eq "GET"){
    $get=$a[++$x];
    } elsif ($a[$x] eq "Host"){
    $host=$a[++$x];
    } elsif ($a[$x] eq "User-Agent"){
    $agent=$a[++$x];
    } elsif ($a[$x] eq "Accept"){
    $acc=$a[++$x];
    } elsif ($a[$x] eq "Accept-Language"){
    $lang=$a[++$x];
    } elsif ($a[$x] eq "Accept-Encoding"){
    $enc=$a[++$x];
    } elsif ($a[$x] eq "Connection"){
    $connection=$a[++$x];
    } 
 }
print "GET: ".$get."\n";
print "Host: ".$host."\n";
print "User-Agent: ".$agent."\n";
print "Accept: ".$acc."\n";
print "Accept-Language: ".$lang."\n";
print "Accept-Encoding: ".$enc."\n";
print "Connection: ".$connection."\n";

Автор: noize 22.9.2014, 21:52

1. Добавьте пробелов в строки, иначе всё сливается в ###код
2. Используйте прагмы strict и warnings, не стоит начинать изучение языка с хардкора

Код


my @a=map{split":? ",$_,2}split"\r?\n",<STDIN>;

возьмите \r в скобки -

Код


split "(\r)?\n", <STDIN>

Автор: arto 22.9.2014, 23:51

а для чего (\r) ?

Автор: noize 23.9.2014, 00:17

думал, что интерпретатор может воспринять "\r" как 2 символа - "\" и "r" и тогда условие \r? проверяло бы на существование только 'r'. Сейчас проверил у себя локально - воспринимает как единый символ, так что скобка там в принципе не обязатальна, да.

Автор: arto 23.9.2014, 07:28

оно ещё и неверно работает:

# print "aa\r\nbb\r\n" | perl -0777 -lne 'print join "+", split "(\r)?\n"'
+bb+
# print "aa\r\nbb\r\n" | perl -0777 -lne 'print join "+", split "\r?\n"'
aa+bb
#

Автор: justauser 23.9.2014, 14:13

Сделал вариант с хэшем тоже работает.

Код


#!/usr/bin/perl

use strict;
use warnings;

local$/="";

my    ($get,$host,$agent,$acc,$lang,$enc,$connect);

my %a=map{split":? ",$_,2}split"\r?\n",<STDIN>;

    $get=$a{'GET'};

    $host=$a{'Host'};

    $agent=$a{'User-Agent'};

    $acc=$a{'Accept'};

    $lang=$a{'Accept-Language'};

    $enc=$a{'Accept-Encoding'};

    $connect=$a{'Connection'};

print "GET: ".$get."\n";
print "Host: ".$host."\n";
print "User-Agent: ".$agent."\n";
print "Accept: ".$acc."\n";
print "Accept-Language: ".$lang."\n";
print "Accept-Encoding: ".$enc."\n";
print "Connection: ".$connect."\n";

Но при доп. тестировании выявилась проблема с разбором если параметр объявлен но его значения в запросе нет.

GET / HTTP/1.1
Host: localhost
User-Agent: Mozilla/5.0 (X11; Ubuntu; Linux i686; rv:32.0) Gecko/20100101 Firefox/32.0
Accept:
Accept-Language: en-US,en;q=0.5
Accept-Encoding: gzip, deflate
Connection: keep-alive

Оба скрипта тогда неправильно работают. Получается нужно при разделении строки на поля проверять чтоб было обязательно два поля и если значение не задано нужно удалять всю строку или подставлять что-то свое типа "Undefined!" Не соображу как, может кто подскажет.

Автор: noize 23.9.2014, 14:49

Строки с 11 по 32 можно заменить так:

Код


for my $key ( keys %a ) {
    print "$key: " . ( $a{ $key } ? $a{ $key } : "Undef" ) . "\n";
}

тернарный оператор

Код


$a{ $key } ? $a{ $key } : "Undef"

проверяет наличие в массиве значения для ключа $key и печатает это значение. Если значения нет, печатает "Undef"

Автор: hobo1mts 24.9.2014, 06:39

Это ж классика жанра

Код


my %headers;
while (my ($k, $v) = /(.*?):\s*(.*)/ =~ <STDIN>) {
  $headers{$k} = $v;
}

Тут ещё нада добавить проверку длинных строк, которые продолжаются на следующей строке, начинаясь с пробельного символа.

Автор: DProf 25.9.2014, 16:43

Вообще для "не программиста" начинать изучение языка с написания http сервера, пусть и простого, странно, ИМХО. Возьмите лучше книжку с Ламой и сделайте задания-примеры ко всем главам. А потом ее вторую часть.