Почти-web-сервер своими руками

    В последнее время появилось несколько постов по привлечению внимания к определённым языкам программирования на примере написания некоего несложного «web-сервера». Раз уж пошла такая пьянка perl пока не затронули, то добавлю и свои пять копеек :)
    Будем писать несложное серверное приложение, маскирующееся под http-сервер.


    Наш «сервер» будет слушать локальный порт 8080 и приветствовать всех обратившихся, либо отдавать содержимое запрошенного файла при его наличии (в папке, откуда был запущен скрипт-сервер).

    Для начала простой и короткий код. Думаю, на данном этапе особо комментировать ничего не требуется, так что комментирование оставим на потом.
    1. #!/usr/bin/perl
    2. use LWP::Socket;
    3.  
    4. $headers = "HTTP/1.1 200 OK\r\nContent-Type: text/html\r\n\r\n";
    5. $sock = new LWP::Socket();
    6. $sock->bind('127.0.0.1', '8080');
    7. $sock->listen(10);
    8.  
    9. while ( $socket = $sock->accept(10) ) {
    10.     $content = "Hello from Habr";
    11.     $file_name; $socket->read( \$file_name );
    12.     $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;
    13.     if ( open FILE, '<', $file_name ) {
    14.         $content = join "", <FILE>; close FILE;
    15.     }
    16.     $socket->write( $headers . $content );
    17.     $socket->shutdown();
    18. }

    Это некрасивый код, так лучше не писать, данный пример только чтобы показать, что требуемый функционал при необходимости можно реализовать достаточно быстро и небольшим количеством кода.

    Этот код надо облагородить и дополнить. Сделаем его немного более читабельным, добавим проверку удалось ли забиндиться на указанный порт (а то вдруг он уже занят), будем проверять существование файла перед попыткой его открыть, ну и хорошим тоном будет задействовать прагмы strict и warnings.
    1. #!/usr/bin/perl
    2.  
    3. use strict;
    4. use warnings;
    5.  
    6. use LWP::Socket;
    7.  
    8. my $headers = "HTTP/1.1 200 OK\r\nContent-Type: text/html\r\n\r\n";
    9.  
    10. my $sock = new LWP::Socket();
    11. die "Can't bind a socket" unless $sock->bind('127.0.0.1', '8080');
    12. $sock->listen(10);
    13.  
    14. while ( my $socket = $sock->accept(10) ) {
    15.     my $content = "Hello from Habr";
    16.     my $file_name;
    17.     $socket->read( \$file_name );
    18.     $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;
    19.     if ( -$file_name and open FILE, '<', $file_name ) {
    20.         $content = join "", <FILE>;
    21.         close FILE;
    22.     }
    23.     $socket->write( $headers . $content );
    24.     $socket->shutdown();
    25. }
    26.  
    27. $sock->shutdown();

    Всего на несколько строк больше, но зато скрипт стал немного культурнее.

    Здесь у нас

    use LWP::Socket;
    подключаем нужный нам модуль. Он достаточно прост в использовании, поэтому выбрал именно его.

    my $sock = new LWP::Socket();
    создаём сокет

    $sock->bind('127.0.0.1', '8080');
    $sock->listen(10);

    биндим сокет на локалный 8080 порт и задаём длину очереди

    while ( my $socket = $sock->accept(10) ) {
    ждём подключения
    при подключении в $socket вернётся новый LWP::Socket()

    $socket->read( \$file_name );
    $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;

    читаем всё из сокета и выцепляем имя запрашиваемого файла

    $socket->write( $headers . $content );
    пишем в сокет заголовки и ответ

    $socket->shutdown();
    закрываем полученный «на сессию» LWP::Socket()

    На этом даже можно было бы и закончить, но мы же хотим получше замаскироваться под http-сервер, а значит нам нужна мультипоточность, дабы выдерживать нагрузки :)
    Для этого задействуем модуль FCGI::ProcManager, в результате у нас будет один «головной» процесс и пять дочерних. Для этого нужно добавить всего четыре строки:
    1. #...
    2.  
    3. use LWP::Socket;
    4. use FCGI::ProcManager qw/ pm_manage pm_pre_dispatch pm_post_dispatch /;
    5.  
    6. my $headers = "HTTP/1.1 200 OK\r\nContent-Type: text/html\r\n\r\n";
    7.  
    8. my $sock = new LWP::Socket();
    9. die "Can't bind a socket" unless $sock->bind('127.0.0.1', '8080');
    10. $sock->listen(10);
    11.  
    12. pm_manage(n_processes => 5);
    13.  
    14. while ( my $socket = $sock->accept(10) ) {
    15.     pm_pre_dispatch();
    16.     my $content = "Hello from Habr";
    17.  
    18. #...
    19.  
    20.     $socket->shutdown();
    21.     pm_post_dispatch();
    22. }
    23.  
    24. $sock->shutdown();

    И вот наш «сервер» готов. Можно пользоваться :). Осталось привести полный код, чтобы его можно было просто скопипастить в файл, запустить и убедиться, что всё работает.
    Этот код с небольшими дополнениями:
    — дополнены заголовки
    — в качестве индексной страницы отдаётся «приветствие»
    — в качестве остальных — что попросят
    — если файл не найден сообщаем браузеру об этом 404 ошибкой
    — добавлены комментарии
    1. #!/usr/bin/perl
    2.  
    3. use strict;
    4. use warnings;
    5.  
    6. use LWP::Socket;
    7. use FCGI::ProcManager qw/ pm_manage pm_pre_dispatch pm_post_dispatch /;
    8.  
    9. # Prepare headers
    10. my $headers = "HTTP/1.1 %d OK\r\n"
    11.             . "Server: FakeServer/2009-09-12\r\n"
    12.             . "Content-Type: text/html\r\n"
    13.             . "Content-Length: %d\r\n"
    14.             . "Connection: close\r\n\r\n";
    15.  
    16. # Prepare and open socket
    17. my $sock = new LWP::Socket();
    18. die "Can't bind a socket" unless $sock->bind('127.0.0.1', '8080');
    19. $sock->listen(10);
    20.  
    21. # Create 5 childs
    22. pm_manage(n_processes => 5);
    23.  
    24. # Accepts a new connection
    25. while ( my $socket = $sock->accept(10) ) {
    26.     # Passing direction to child
    27.     pm_pre_dispatch();
    28.     # Default content
    29.     my $content = "<html><body><h1>Hello from Habr</h1></body></html>";
    30.     my $stat = 200;
    31.     my $file_name;
    32.     # Read from socket
    33.     $socket->read( \$file_name );
    34.     # Get wanted file name
    35.     $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;
    36.  
    37.     if ( $file_name ) {
    38.         if ( -$file_name and open FILE, '<', $file_name ) {
    39.             # Read from file
    40.             $content = join "", <FILE>;
    41.             close FILE;
    42.         }
    43.         else {
    44.             $content = "File not found";
    45.             $stat = 404;
    46.         }
    47.     }
    48.     # Puts headers and content into the socket
    49.     $socket->write( sprintf( $headers, $stat, length $content ) );
    50.     $socket->write( $content );
    51.     $socket->shutdown();
    52.  
    53.     # Child's work complete
    54.     pm_post_dispatch();
    55. }
    56.  
    57. # Close socket
    58. $sock->shutdown();


    Инструкция по применению:
    — скопировать код и вставить в файл
    — запустить ( perl file.pl )
    — в браузере открыть httр://127.0.0.1:8080/

    Надеюсь, последний вариант никого не отпугнёт :)

    P.S. Если кому интересно, то это дело с 10 child'ами скушало 15 метров оперативки, при тестировании запросами в 30 потоков смогло обрабатывать порядка 2000 запросов в секунду (10 потоков запрашивали существующие файлы). Запускал на локальной машине, на тесте оба ядра были загружены под потолок.

    ---------
    Подсветка отсюда
    Share post

    Comments 46

      +5
      Ждем вебсервер на bash'е
        0
        А это идея, bash вроде умеет работать с сокетами :)
          +1
          По моему уже был веб-сервер на баше и даже на шеле, стоит спросить гугл.
          +10
          while :;do nc -p8080 -vnlc'r=read;e=«echo -e»;$r a b c;while [ -n "`$e $a|tr -d "\r\n"`" ];do $r a;done;f=`$e $b|sed s/.//`;h=«HTTP/1.0»;z=«404 Not Found\n»;[ -z $f ]&&(ls|while $r n;do [ -f $n ]&&$e "$n";done)||([ -f $f ]&&($e "$h 200 OK\r\nContent-Type: `file -ib $f`\n";cat $f)||$e "$h $z\n$z")';done

          Источник, если хабрапарсер закушает кавычки: alexey.sveshnikov.ru/blog/2007/08/30/bash-httpd-2/
          0
          на JS
            0
            С год или два назад на ЛОРе проскакивал. Если не ошибаюсь, catap его писал (возможно, тот самый catap).
            –9
            я не понял, а почему код не картинкой? если программа на перл, то или фигурка сисястой девушки, или пивные бутылки, или еще что-нибудь, у кого на что фантазии хватит. думал в перле такая индентация…
              +3
              :)
              В текущем виде проще объяснить что к чему и проще понять что да как ;)

              > думал в перле такая индентация…
              Кроме отступов для «картинки» нужны и символы подходящие
                +2
                pastebin.com/m79a90bbf
                программа из топика)
                  –1
                  красота )))
                    0
                    Поделитесь, чем «преобразовывали»
                      +2
                      Acme::EyeDrops
                • UFO just landed and posted this here
                    +4
                    1. Уолл Л., Кристиансен Т., Орвант Д. Программирование на Perl — шедевр а не книга
                    • UFO just landed and posted this here
                      +3
                      2. Learning Perl
                      3. Шварц Р., Фой Б., Феникс Т. Perl — изучаем глубже.2-е изд
                      4. High order Perl
                      • UFO just landed and posted this here
                        0
                        Пока я спал уже ответили :)
                          +1
                          В июле вышла книга «The difinitive guide to Catalyst» Kieren Diment and Matt S Trout
                          +1
                          Вместо
                          use LWP::Socket;
                          use FCGI::ProcManager
                          лучше использовать Net::Server
                            0
                            а вместо этого — use HTTP::Daemon
                              0
                              perl way :)
                                +1
                                именно :) настоящий perl way:
                                — захотелось что-то сделать? найди уже делающий это модуль на CPAN и успокойся
                            +3
                            хех…
                            Аккуратно, не проверяется запрашиваемое имя файла… дырищааа, запроси /etc/passwd и получишь :)

                            P.S. но вообще то уже давно есть (gentoo dev-perl/HTTP-Server-Simple под лицензией Artistic GPL-2)
                              +2
                              Может у автора включен SELinux и он может не думать о таких проблемах… :)
                                +2
                                А это и не web-сервер, а просто пример скрипта ;) Он не предназначен для использования на продакшен-серверах. Это скорее серверная часть, которая по запросу может делать что ей скажут, в данном случае отдавать любой запрошенный файл. Я сперва сделал, чтобы файл брался только из папки со скриптом, но решил не удлинять код и оставил то, что сейчас в посте :)
                                –1
                                У вас HTTP протокол нарушается.

                                Я бы кстати не стал использовать вот такое «на коленке», когда есть полнеценный и навороченный Perlbal. Это не считая фреймворков для написания своих серверов (HTTP::Daemon, HTTP::Server, AnyEvent::HTTPD, ...).
                                Ну и к тому же здесь уже была серия статей «пишем fcgi приложение».
                                  0
                                  А такой вопрос. Мне нужно чтоб по любому запросу отсылался файл нулевого содержания.
                                  Правильно ли я сделал, т.е. вместо этой части
                                      if ( $file_name ) {
                                          if ( -f $file_name and open FILE, '<', $file_name ) {
                                              # Read from file
                                              $content = join "", <FILE>;
                                              close FILE;
                                          }
                                          else {
                                              $content = "File not found";
                                              $stat = 404;
                                          }
                                  

                                  Использую эту?

                                      if ( open FILE, '<', "/tmp/null" ) {
                                          $content = join "", <FILE>; close FILE;
                                    0
                                    вам нужно вместо этого написать $content = ''
                                      0
                                      Пасиба. Вечером испытаем на кошках
                                      0
                                      вместо join "", можно использовать конструкцию

                                      $content = do { local $/; <$f> }
                                      –1
                                      > $content = join "",;

                                      не оптимально, лутше файл читать по частям и писать сразу, а не копить в переменной.

                                        0
                                        Сперва думал проверять размер файла, большой — читать и сразу писать, маленький читать полностью, но это немного увеличило бы кол-во кода.
                                        +1
                                        #!/usr/bin/perl
                                        
                                        use strict;
                                        use warnings;
                                        $|++;
                                        
                                        
                                        use IO::Socket::INET;
                                        use EV;
                                        
                                        
                                        my $sock = IO::Socket::INET->new(Listen => 10000, LocalPort => 8882, Blocking => 0, Proto => 'tcp') or die "Can't bind : $@\n";
                                        
                                        my @evs;
                                        push(@evs,EV::io $sock,EV::READ,\&accept);
                                        
                                        sub accept
                                        {
                                                my $newsock = $sock->accept;
                                                $newsock->blocking(0);
                                                push(@evs,EV::io $newsock,EV::READ,\&request);
                                                $evs[-1]->data(scalar(@evs)-1);
                                        };
                                        
                                        sub request
                                        {
                                                my $data;
                                                $_[0]->fh->sysread($data,128);
                                        
                                                my $content = "HTTP/1.1 200 OK\r\n"
                                                                . "Server: EV/2009-09-12\r\n"
                                                                . "Content-Type: text/html\r\n"
                                                                . "Connection: close\r\n\r\n"
                                                                . "<html><body><h1>Hello from Habr</h1></body></html>";
                                                $_[0]->fh->syswrite($content);
                                                $_[0]->fh->close;
                                                undef $evs[$_[0]->data()];
                                                undef $_[0];
                                        };
                                        
                                        
                                        EV::loop();
                                        

                                        1 поток:
                                        #ab -n 10000 -c 30 http://localhost:8882/

                                        Requests per second: 7099.00 [#/sec] (mean)

                                        пример очень упрощен, отсутсвуют какие либо проверки, но скорость говорит за себя
                                        если ещё добавить prefork…


                                          0
                                          Не там скорость меряете ;)
                                          Уберите из «поста» чтение из сокета и обращение к диску, подозреваю, что скорость заметно увеличится…

                                          > пример очень упрощен
                                          от того и скорость :)
                                            0
                                            paste.org.ru/?8jfpe7
                                            Requests per second: 4483.65 [#/sec] (mean)
                                              +1
                                              Не понимаю чего Вы хотите этим сказать, но Вы продолжаете не там мерять скорость… У Вашего скрипта немного другой функционал, да и про «железо» Вы забыли, вряд ли оно у нас савпадает.

                                              Код из поста, но 10 child'ов

                                              $ siege -c 30 -b -f _urls
                                              Transaction rate: 3847.76 trans/sec
                                              Successful transactions: 25193
                                              Failed transactions: 0

                                              $ siege -c 30 -b -i -f _urls
                                              Transaction rate: 3783.66 trans/sec
                                              Successful transactions: 119578
                                              Failed transactions: 0

                                              $ ab2 -n 10000 -c 30 httр://127.0.0.1:8080/
                                              Requests per second: 3900.84 [#/sec] (mean)

                                              Перебираемые урлы — «главная страница», несуществующая страница, существующая страница
                                              Как видите, скорость не сильно различается.

                                              «Облегчённый сервер»
                                              (просто выдача «приветствия»)

                                              $ siege -c 30 -b 127.0.0.1:8080
                                              Transaction rate: 4867.47 trans/sec
                                              Successful transactions: 36506
                                              Failed transactions: 0

                                              $ ab2 -n 10000 -c 30 httр://127.0.0.1:8080/
                                              Requests per second: 5647.83 [#/sec] (mean)


                                              Ваш код
                                              (копипаст и изменение порта)

                                              $ siege -c 30 -b 127.0.0.1:8080
                                              Transaction rate: 3111.36 trans/sec
                                              Successful transactions: 15059
                                              Failed transactions: 0

                                              $ ab2 -n 10000 -c 30 httр://127.0.0.1:8080/
                                              Requests per second: 3201.50 [#/sec] (mean)
                                                0
                                                А если в вашем коде исправить:
                                                EV: error in callback (ignoring): Modification of a read-only value attempted at tmp.pl line 51.
                                                т.е. убрать строку
                                                undef $_[0];
                                                то результат увеличится примерно на тысячу ;)

                                                Попробуйте на своём компьютере, результаты должны быть ещё выше.
                                                  0
                                                  * «облегчённый сервер» работает в один поток, забыл это сразу указать
                                              0
                                              Код из топика не претендует на идеальный, самый быстрый и самый правильный. Я старался продемонстрировать простоту и лаконичность perl'а. И если уж сокращать функционал и код, то на мой взгляд приведённый ниже код будет более предпочтителен для новичка.

                                              1. #!/usr/bin/perl
                                              2.  
                                              3. use strict;
                                              4. use warnings;
                                              5.  
                                              6. use LWP::Socket;
                                              7.  
                                              8. my $sock = new LWP::Socket();
                                              9. die "Can't bind a socket" unless $sock->bind('127.0.0.1', '8080');
                                              10. $sock->listen(10);
                                              11.  
                                              12. while ( my $socket = $sock->accept(3) ) {
                                              13.     $socket->write( "HTTP/1.1 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n"
                                              14.                                . "<html><body><h1>Hello from Habr</h1></body></html>" );
                                              15.     $socket->shutdown();
                                              16. }
                                              17.  
                                              18. $sock->shutdown();


                                              P.S. Я не имею ничего против Вашего кода, не поймите меня неправильно, я просто поясняю идею поста. Если Вы с таким написанием несложного кода несогласны, напишите пост на эту тему, с удовольствием почитаю (думаю, что не только я один).
                                              0
                                              как это можно понять?
                                                0
                                                Хорошую скорость при очень малых ресурсах, можно получить используя неблокирующие сокеты.

                                                На счёт чтения файла по кускам; к этому следует также запрещать буферизацию вывода.
                                                  0
                                                  Ну к коду всё-таки надо относиться не как к образцовому написанию сетевого приложения :) Здесь я пытался показать, что не такой уж и страшный perl, его не надо бояться, написать код на перле можно различными способами, в том числе и так, чтобы всё нормально читалось… А "$|++;" пришлось бы поподробнее описывать и чтобы всё было совсем хорошо не помешало описать и прочие предопределённый переменные, типа $/, $_, $!, $', а это уже в этой статье будет лишним.
                                                  –1
                                                  пардон за оффтопик, но моя душа радуется: торнадо, торнадо…
                                                  www.tornadoweb.org/
                                                    0
                                                    это к теме non-blocking web server

                                                  Only users with full accounts can post comments. Log in, please.