В последнее время появилось несколько постов по привлечению внимания к определённым языкам программирования на примере написания некоего несложного «web-сервера». Раз уж пошла такая пьянка perl пока не затронули, то добавлю и свои пять копеек :)
Будем писать несложное серверное приложение, маскирующееся под http-сервер.
Наш «сервер» будет слушать локальный порт 8080 и приветствовать всех обратившихся, либо отдавать содержимое запрошенного файла при его наличии (в папке, откуда был запущен скрипт-сервер).
Для начала простой и короткий код. Думаю, на данном этапе особо комментировать ничего не требуется, так что комментирование оставим на потом.
Это некрасивый код, так лучше не писать, данный пример только чтобы показать, что требуемый функционал при необходимости можно реализовать достаточно быстро и небольшим количеством кода.
Этот код надо облагородить и дополнить. Сделаем его немного более читабельным, добавим проверку удалось ли забиндиться на указанный порт (а то вдруг он уже занят), будем проверять существование файла перед попыткой его открыть, ну и хорошим тоном будет задействовать прагмы strict и warnings.
Всего на несколько строк больше, но зато скрипт стал немного культурнее.
Здесь у нас
подключаем нужный нам модуль. Он достаточно прост в использовании, поэтому выбрал именно его.
создаём сокет
биндим сокет на локалный 8080 порт и задаём длину очереди
ждём подключения
при подключении в $socket вернётся новый LWP::Socket()
читаем всё из сокета и выцепляем имя запрашиваемого файла
пишем в сокет заголовки и ответ
закрываем полученный «на сессию» LWP::Socket()
На этом даже можно было бы и закончить, но мы же хотим получше замаскироваться под http-сервер, а значит нам нужна мультипоточность, дабы выдерживать нагрузки :)
Для этого задействуем модуль FCGI::ProcManager, в результате у нас будет один «головной» процесс и пять дочерних. Для этого нужно добавить всего четыре строки:
И вот наш «сервер» готов. Можно пользоваться :). Осталось привести полный код, чтобы его можно было просто скопипастить в файл, запустить и убедиться, что всё работает.
Этот код с небольшими дополнениями:
— дополнены заголовки
— в качестве индексной страницы отдаётся «приветствие»
— в качестве остальных — что попросят
— если файл не найден сообщаем браузеру об этом 404 ошибкой
— добавлены комментарии
Инструкция по применению:
— скопировать код и вставить в файл
— запустить ( perl file.pl )
— в браузере открыть httр://127.0.0.1:8080/
Надеюсь, последний вариант никого не отпугнёт :)
P.S. Если кому интересно, то это дело с 10 child'ами скушало 15 метров оперативки, при тестировании запросами в 30 потоков смогло обрабатывать порядка 2000 запросов в секунду (10 потоков запрашивали существующие файлы). Запускал на локальной машине, на тесте оба ядра были загружены под потолок.
---------
Подсветка отсюда
Будем писать несложное серверное приложение, маскирующееся под http-сервер.
Наш «сервер» будет слушать локальный порт 8080 и приветствовать всех обратившихся, либо отдавать содержимое запрошенного файла при его наличии (в папке, откуда был запущен скрипт-сервер).
Для начала простой и короткий код. Думаю, на данном этапе особо комментировать ничего не требуется, так что комментирование оставим на потом.
- #!/usr/bin/perl
- use LWP::Socket;
- $headers = "HTTP/1.1 200 OK\r\nContent-Type: text/html\r\n\r\n";
- $sock = new LWP::Socket();
- $sock->bind('127.0.0.1', '8080');
- $sock->listen(10);
- while ( $socket = $sock->accept(10) ) {
- $content = "Hello from Habr";
- $file_name; $socket->read( \$file_name );
- $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;
- if ( open FILE, '<', $file_name ) {
- $content = join "", <FILE>; close FILE;
- }
- $socket->write( $headers . $content );
- $socket->shutdown();
- }
Это некрасивый код, так лучше не писать, данный пример только чтобы показать, что требуемый функционал при необходимости можно реализовать достаточно быстро и небольшим количеством кода.
Этот код надо облагородить и дополнить. Сделаем его немного более читабельным, добавим проверку удалось ли забиндиться на указанный порт (а то вдруг он уже занят), будем проверять существование файла перед попыткой его открыть, ну и хорошим тоном будет задействовать прагмы strict и warnings.
- #!/usr/bin/perl
- use strict;
- use warnings;
- use LWP::Socket;
- my $headers = "HTTP/1.1 200 OK\r\nContent-Type: text/html\r\n\r\n";
- my $sock = new LWP::Socket();
- die "Can't bind a socket" unless $sock->bind('127.0.0.1', '8080');
- $sock->listen(10);
- while ( my $socket = $sock->accept(10) ) {
- my $content = "Hello from Habr";
- my $file_name;
- $socket->read( \$file_name );
- $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;
- if ( -f $file_name and open FILE, '<', $file_name ) {
- $content = join "", <FILE>;
- close FILE;
- }
- $socket->write( $headers . $content );
- $socket->shutdown();
- }
- $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, в результате у нас будет один «головной» процесс и пять дочерних. Для этого нужно добавить всего четыре строки:
- #...
- use LWP::Socket;
- use FCGI::ProcManager qw/ pm_manage pm_pre_dispatch pm_post_dispatch /;
- my $headers = "HTTP/1.1 200 OK\r\nContent-Type: text/html\r\n\r\n";
- my $sock = new LWP::Socket();
- die "Can't bind a socket" unless $sock->bind('127.0.0.1', '8080');
- $sock->listen(10);
- pm_manage(n_processes => 5);
- while ( my $socket = $sock->accept(10) ) {
- pm_pre_dispatch();
- my $content = "Hello from Habr";
- #...
- $socket->shutdown();
- pm_post_dispatch();
- }
- $sock->shutdown();
И вот наш «сервер» готов. Можно пользоваться :). Осталось привести полный код, чтобы его можно было просто скопипастить в файл, запустить и убедиться, что всё работает.
Этот код с небольшими дополнениями:
— дополнены заголовки
— в качестве индексной страницы отдаётся «приветствие»
— в качестве остальных — что попросят
— если файл не найден сообщаем браузеру об этом 404 ошибкой
— добавлены комментарии
- #!/usr/bin/perl
- use strict;
- use warnings;
- use LWP::Socket;
- use FCGI::ProcManager qw/ pm_manage pm_pre_dispatch pm_post_dispatch /;
- # Prepare headers
- my $headers = "HTTP/1.1 %d OK\r\n"
- . "Server: FakeServer/2009-09-12\r\n"
- . "Content-Type: text/html\r\n"
- . "Content-Length: %d\r\n"
- . "Connection: close\r\n\r\n";
- # Prepare and open socket
- my $sock = new LWP::Socket();
- die "Can't bind a socket" unless $sock->bind('127.0.0.1', '8080');
- $sock->listen(10);
- # Create 5 childs
- pm_manage(n_processes => 5);
- # Accepts a new connection
- while ( my $socket = $sock->accept(10) ) {
- # Passing direction to child
- pm_pre_dispatch();
- # Default content
- my $content = "<html><body><h1>Hello from Habr</h1></body></html>";
- my $stat = 200;
- my $file_name;
- # Read from socket
- $socket->read( \$file_name );
- # Get wanted file name
- $file_name =~ s/GET \/([^ ]*) HTTP.+/$1/s;
- 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;
- }
- }
- # Puts headers and content into the socket
- $socket->write( sprintf( $headers, $stat, length $content ) );
- $socket->write( $content );
- $socket->shutdown();
- # Child's work complete
- pm_post_dispatch();
- }
- # Close socket
- $sock->shutdown();
Инструкция по применению:
— скопировать код и вставить в файл
— запустить ( perl file.pl )
— в браузере открыть httр://127.0.0.1:8080/
Надеюсь, последний вариант никого не отпугнёт :)
P.S. Если кому интересно, то это дело с 10 child'ами скушало 15 метров оперативки, при тестировании запросами в 30 потоков смогло обрабатывать порядка 2000 запросов в секунду (10 потоков запрашивали существующие файлы). Запускал на локальной машине, на тесте оба ядра были загружены под потолок.
---------
Подсветка отсюда