Pull to refresh

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

Perl *
В последнее время появилось несколько постов по привлечению внимания к определённым языкам программирования на примере написания некоего несложного «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 потоков запрашивали существующие файлы). Запускал на локальной машине, на тесте оба ядра были загружены под потолок.

---------
Подсветка отсюда
Tags:
Hubs:
Total votes 38: ↑29 and ↓9 +20
Views 8.9K
Comments Comments 46