17.13. Серверы без ветвления 629

к Корректно убрать мусор и завершиться.

# Этот выход ОЧЕНЬ важен, в противном случае потомок начнет

# плодить все больше и больше потомков, что в конечном счете

# приведет к переполнению таблицы процессов, exit;

Комментарий

Программа получилась большой, но ее логика проста: родительский процесс никогда не работает с клиентами сам, а вместо этого ответвляет $PREFORK потомков. Родитель следит за количеством потомков и своевременно плодит процессы, чтобы заменить мертвых потомков. Потомки завершаются после обработки $MAX CLIENTS PER CHILD клиентов.

Пример 17.5 более или менее прямолинейно реализует описанную логику. Единственная проблема связана с обработчиками сигналов: мы хотим, чтобы родитель перехватывал SIGINT и убивал своих потомков, и устанавливает для этого свой обработчик сигнала &HUNTSMAN. Но в этом случае нам приходится соблюдать меры предосторожности, чтобы потомок не унаследовал тот же обработчик после ветвления. Мы используем сигналы POSIX, чтобы заблокировать сигнал на время ветвления (см. рецепт 16.20).

Используя этот код в своих программах, проследите, чтобы в make new child никогда не использовался выход через return. В этом случае потомок вернется, станет родителем и начнет плодить своих собственных потомков. Система переполнится процессами, прибежит разъяренный системный администратор - и вы будете долго и мучительно жалеть, что не обратили должного внимания на этот абзац.

В некоторых операционных системах (в первую очередь - Solaris) несколько потомков не могут вызывать accept для одного сокета. Чтобы гарантировать, что лишь один потомок вызывает accept в произвольный момент времени, придется использовать блокировку файлов.

> Смотри также-

Описание функции select вperlfunc{\); страница руководства fcntl{2) вашей системы (если есть); документация по стандартным модулям Fcntl, Socket, IO::Select, IO:;Socket и Tie::Refflash; рецепты 17.11-17.12.

17.13. Серверы без ветвления

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

Решение

Создайте массив открытых клиентов, воспользуйтесь select для чтения информации по мере ее поступления и работайте с клиентом лишь после получения полного запроса от него, как показано в примере 17.6.

Пример 17.6. nonforker

#!/usr/bin/perl -w

# nonforker - мультиплексный сервер без ветвления use POSIX;

use 10; .Socket; use 10;:Select; use Socket; use Fcntl; use Tie::RefHash;

Sport = 1685; # Замените no своему усмотрению

# Прослушивать порт.

Sserver = 10;;Socket;;INET->new(LocalPort => Sport,

Listen => 10 ) or die "Cant make server socket; $@\n";

# Начать с пустыми буферами %inbuffer =0; %outbuffer =0;

%ready = ();

tie %ready, Tie:;RefHash;

nonblock(Sserver);

Sselect = 10::Select->new(Sserver);

# Главный цикл: проверка чтения/принятия, проверка записи,

# проверка готовности к обработке while (1) {

my Sclient; my $rv; my Sdata;

# Проверить наличие новой информации на имеющихся подключениях

# Есть ли что-нибудь для чтения или подтверждения? foreach Sclient ($select->can read(1)) {

if (Sclient == Sserver) {

# Принять новое подключение

Sclient = $server->accept(); $select->add($client); nonblock(Sclient); } else {

# Прочитать данные Sdata = ;

Srv = $client->recv($data, POSIX;;BUFSIZ, 0); unless (defined($rv) && length Sdata) {

17.13. Серверы без ветвления 631

к Это должен быть конец файла, поэтому закрываем клиента delete $inbuffer{$client}; delete Soutbuffer{$client}; delete $ready{$client};

$select->remove($client);

close Sclient;

next;

$inbuffer{$client} .= Sdata;

# Проверить, говорят ли данные в буфере или только что й прочитанные данные о наличии полного запроса, ожидающего й выполнения. Если да - заполнить Sready{Sclient} й запросами, ожидающими обработки, while ($inbuffer{$client} = s/(.An) ) { push( @{Sready{Sclient}}, SI );

Й Есть ли полные запросы для обработки? foreach Sclient (keys %ready) { handle(Sclient);

Й Сбрасываемые буферы ?

foreach Sclient ($select->can write(1)) {

Й Пропустить этого клиента, если нам нечего сказать

next unless exists $outbuffer{$client};

Srv = $client->send(Soutbuffer{Sclient}, 0); unless (defined $rv) {

Й Пожаловаться, но следовать дальше.

warn "I was told I could write, but I cant.\n";

next;

if (Srv == length Soutbuffer{$client}

{$! == POSIX::EWOULDBLOCK) {

substr($outbuffer{$client}, 0, Srv) = ;

delete Soutbuffer{Sclient} unless length Soutbuffer{$client}; } else {

Й He удалось записать все данные и не из-за блокировки, й Очистить буферы и следовать дальше, delete Sinbuffer{Sclient}; delete SoutbufferiSclient}; delete $ready{$client};

Sselect->rernove( Sclient);