Глава 17 Сокеты

17.6. Использование сокетов UNIX

Проблема

Решение

• Вместо socketaddr_in используется socketaddr_un.
• Вместо IO::Socket::UNIX используется IO::Socket::INET.
• Вместо PF_INET используется PF_UNIX, а при вызове socket в качества

Комментарий

> Смотри также - Рецепты 17.1-17.5.

17.7. Идентификация другого конца сокета

Проблема

Решение

Комментарий

> Смотри также ------------------------------ Описание функций gethostbyaddr, gethostbyname и getpeername в perlfunc(1), описание функции inet_ntoa в стандартном модуле Socket; документация по стандартным модулям IO::Socket и Net::hostnet.

17.8. Определение вашего имени и адреса

Проблема

Решение

Комментарий

Смотри также -------------------------------- Описание функций gethostbyaddr и gethostbyname в perlfunc(l); документация но стандартным модулям Net::hostnet и Sys::Hostname.

17.9. Закрытие сокета после разветвления

Проблема

Решение

Комментарий

; # Хотя чтение все еще возможно.

> Смотри также --------------------------------
Описание функций close и shutdown в perlfunc(l); страница руководства shut-down(2) вашей системы (если есть).

7.10. Написание двусторонних клиентов

Проблема

Вы хотите написать полностью интерактивного клиента, в котором можно ввести строку, получить ответ, ввести другую строку, получить новый ответ и т. д. - словом, нечто похожее на telnet.

Решение

После того как соединение будет установлено, разветвите процесс. Один из близнецов только читает ввод и передает его серверу, а другой - читает выходные данные сервера и копирует их в поток вывода.

Комментарий

В отношениях "клиент/сервер" бывает трудно определить, чья сейчас очередь "говорить". Однозадачные решения, в которых используется версия select с четырьмя аргументами, трудны в написании и сопровождении. Однако нет причин игнорировать многозадачные решения, а функция fork кардинально упрощает эту проблему.
После подключения к серверу, с которым вы будете обмениваться данными, вызовите fork. Каждый из двух идентичных (или почти идентичных) процессов выполняет простую задачу. Родитель копирует все данные, полученные из сокета, в стандартный вывод, а потомок одновременно копирует все данные из стандартного ввода в сокет. Исходный текст программы приведен в примере 17.4. Пример 17.4. biclient
#!/usr/bin/perl -w
# biclient - двусторонний клиент с разветвлением
use strict;
use 10::Socket;
my ($host, $port, $kidpid, $handle, $line);
unless (@ARGV == 2) { die "usage: $0 host port" } ($host, $port) = @ARGV;
# Создать tcp-подключение для заданного хоста и порта
$handle = IO::Socket: :INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => $port) or die "can't connect to port $port on $host: $!";
$handle->autoflush(1); # Запретить буферизацию
print STDERR "[Connected to $host:$port]\n";
# Разделить программу на два идентичных процесса
die "can't fork: $!" unless defined($kidpid = fork());
if ($kidpid) {
# Родитель копирует сокет в стандартный вывод
while (defined ($line = <$handle>)) { print STDOUT $line;
} kill("TERM" => $kidpid); ft Послать потомку SIGTERM
}
else {
# Потомок копирует стандартный ввод в сокет
while (defined ($line = )) { print $handle $line:
} } exit:

Добиться того же эффекта с одним процессом намного труднее. Проще здать два процесса и поручить каждому простую задачу, нежели кодировать ьы-полнение двух задач в одном процессе. Стоит воспользоваться преимуществами мультизадачности и разделить программу на несколько подзадач, как многие сложнейшие проблемы упрощаются на глазах.
Функция kill в родительском блоке if нужна для того, чтобы послать сигнал потомку (в настоящее время работающему в блоке else), как только удаленный сервер закроет соединение со своего конца. Вызов kill в конце родительского блока ликвидирует порожденный процесс с завершением работы сервера.
Если удаленный сервер передает данные по байтам и вы хотите получать их немедленно, без ожидания перевода строки (которого вообще может не быть), замените цикл while родительского процесса следующей конструкцией:
my $byte:
while (sysread($handle, $byte, 1) == 1) { print STDOUT $byte;
}

> Смотри также -------------------------------
Описание функций sysread и fork в perlfunc(l); документация по стандартному модулю IO::Socket; рецепты 16.5; 16.10; 17.11.

17.11. Разветвляющие серверы

Проблема

Требуется написать сервер, который для работы с очередным клиентом ответвляет специальный подпроцесс.

Решение

Ответвляйте подпроцессы в цикле accept и используйте обработчик $SIG{CHLD} для чистки потомков.
# Создать сокет SERVER, вызвать bind и прослушивать ...
use POSIX qw(: sys_wait_h);
sub REAPER {
1 until (-1 == waitpid(-1, WNOHANG));
$SIG{CHLD} = \&REAPER; # если $l >= 5.002
}
$SIG{CHLD} = \&REAPER;
while ($hisaddr = accept(CLIENT, SERVER)) {
next if $pid = fork; # Родитель
die "fork: $!" unless defined $pid; # Неудача
# otherwise child
close(SERVER); # He нужно для потомка
# ... Сделать что-то
exit; # Выход из потомка
} continue {
close(CLIENT); # He нужно для родителя
}

Комментарий

Подобный подход очень часто используется в потоковых (SOCK_STREAM) серверах на базе сокетов Интернета и UNIX. Каждое входящее подключение получает собственный дубликат сервера. Общая модель выглядит так:
1. Принять потоковое подключение.
2. Ответвить дубликат для обмена данными с этим потоком.
3. Вернуться к п. 1.
Такая методика не используется с датаграммными сокетами (SOCK_ DGRAM) из-за особенностей обмена данными в них. Из-за времени, затраченного на разветвление, эта модель непрактична для UDP-серверов. Вместо продолжительных соединений, обладающих определенным состоянием, серверы SOCK_DGRAM работают с непредсказуемым набором датаграмм, обычно без определенного состояния. В этом варианте наша модель принимает следующий вид:
1. Принять датаграмму.
2. Обработать датаграмму.
3. Вернуться к п. 1.
Новое соединение обрабатывается порожденным процессом. Поскольку сокет SERVER никогда не будет использоваться этим процессом, мы немедленно закрываем его. Отчасти это делается из стремления к порядку, но в основном - для того, чтобы серверный сокет закрывался при завершении родительского (серверного) процесса. Если потомки не будут закрывать сокет SERVER, операционная система будет считать его открытым даже после завершения родителя. За подробностями обращайтесь к рецепту 17.9.
%SIG обеспечивает чистку таблицы процессов после завершения потомков (см. главу 16).

> Смотри также --------------------------------
Описание функций fork и accept в perlfunc(1), рецепты 16.15; 16.19; 17.12-17.13.

17.12. Серверы с предварительным ветвлением

Проблема

Вы хотите написать сервер, параллельно обслуживающий нескольких клиентов (как и в предыдущем разделе), однако подключения поступают так быстро, что ветвление слишком сильно замедлит работу сервера.

Решение

Организуйте пул заранее разветвленных потомков, как показано в примере 17.5. Пример 17.5. preforker
#!/usr/bin/perl
# preforker - сервер с предварительным ветвлением
use I0::Socket;
use Symbol;
use POSIX;
# Создать сокет SERVER, вызвать bind и прослушивать порт.
$server = 10::Socket::INET->new(LocalPort => 6969,
Type => SOCK_STREAM,
Proto => 'tcp',
Reuse => 1,
Listen => 10 ) or die "making socket: $@\n";
# Глобальные переменные
$PREFORK =5; # Количество поддерживаемых потомков
$MAX_CLIENTS_PER_CHILD =5; # Количество клиентов, обрабатываемых
# каждым потомком.
%children =(); # Ключами являются текущие
# идентификаторы процессов-потомков
$children =0; # Текущее число потомков
sub REAPER { # Чистка мертвых потомков
$SIG{CHLD} = \&REAPER;
my $pid = wait;
$children --;
delete $children{$pid};
}
sub HUNTSMAN { # Обработчик сигнала SIGINT
local($SIG{CHLD}) = 'IGNORE'; # Убиваем своих потомков
kill 'INT' => keys %children;
exit; # Корректно завершиться }
# Создать потомков.
for (1 .. $PREFORK) { make_new_child():
}
# Установить обработчики сигналов.
$SIG$SIG{INT} = \&HUNTSMAN;
# Поддерживать численность процессов,
while (1) {
sleep; # Ждать сигнала (например,
# смерти потомка).
for ($i = $children; $i < $PREFORK; $i++) {
make_new_child(); # Заполнить пул потомков.
}
}
sub make_new_chil(3 { my $pid;
my $sigset;
# Блокировать сигнал для fork.
$sigset = POSIX::SigSet->new(SIGINT);
sigprocmask(SIG_BLOCK, $sigset)
or die "Can't block SIGINT for fork: $!\n";
die "fork: $!" unless defined ($pid = fork);
if ($pid) {
# Родитель запоминает рождение потомка и возвращается,
sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = 1;
$children++:
return;
} else {
# Потомок *не может* выйти из этой подпрограммы.
$SIG{INT} = 'DEFAULT'; # Пусть SIGINT убивает процесс,
# как это было раньше.
# Разблокировать сигналы
sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";
# Обрабатывать подключения, пока их число не достигнет
# $MAX_CLIENTS_PER_CHILD.
for ($1=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
$client = $server->accept() or last;
# Сделать что-то с соединением.
}
# Корректно убрать мусор и завершиться.
# Этот выход ОЧЕНЬ важен, в'противном случае потомок начнет
# плодить все больше и больше потомков, что в конечном счете
# приведет к переполнению таблицы процессов.
exit;
}
}

Комментарий

Программа получилась большой, но ее логика проста: родительский процесс никогда не работает с клиентами сам, а вместо этого ответвляет $PREFORK потомков. Родитель следит за количеством потомков и своевременно плодит процессы, чтобы заменить мертвых потомков. Потомки завершаются после обработки $MAX_CLIENTS_PER_CHILD клиентов.
Пример 17.5 более или менее прямолинейно реализует описанную логику. Единственная проблема связана с обработчиками сигналов: мы хотим, чтобы родитель перехватывал SIGINT и убивал своих потомков, и устанавливает для этого свой обработчик сигнала &HUNTSMAN. Но в этом случае нам приходится соблюдать меры предосторожности, чтобы потомок не унаследовал тот же обработчик после ветвления. Мы используем сигналы POSIX, чтобы заблокировать сигнал на время ветвления (см. рецепт 16.20).
Используя этот код в своих программах, проследите, чтобы в make_new_child никогда не использовался выход через return. В этом случае потомок вернется, станет родителем и начнет плодить своих собственных потомков. Система переполнится процессами, прибежит разъяренный системный администратор - и вы будете долго и мучительно жалеть, что не обратили должного внимания на этот абзац.
В некоторых операционных системах (в первую очередь - Solaris) несколько потомков не могут вызывать accept для одного сокета. Чтобы гарантировать, что лишь один потомок вызывает accept в произвольный момент времени, придется использовать блокировку файлов.

> Смотри также -------------------------------
Описание функции select в perlfunc(1); страница руководства fcntl(2) вашей системы (если есть); документация по стандартным модулям Fcnti, Socket, IO::Select, IO::Socket и Tie::RefHash; рецепты 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 Fcnti;
use Tie::RefHash;
Sport = 1685; # Замените по своему усмотрению
# Прослушивать порт.
$server = 10::Socket::INET->new(LocalPort => $port,
Listen => 10 ) or die "Can't make server socket: $@\n";
# Начать с пустыми буферами
%inbuffer =(); o %outbuffer =();
%ready = ();
tie %ready, 'Tie::RefHash';
nonblock($server);
$select = 10::Select->new($server);
# Главный цикл: проверка чтения/принятия, проверка записи,
# проверка готовности к обработке while (1) {
my $client;
my $rv;
my $data;
# Проверить наличие новой информации на имеющихся подключениях
# Есть ли что-нибудь для чтения или подтверждения?
foreach $client ($select->can_read(1)) {
if ($client == $server) {
# Принять новое подключение
$client = $server->accept();
$select->add($client);
nonblock($client);
} else {
# Прочитать данные $data = '';
$rv = $client->recv($data, POSIX::BUFSIZ, 0);
unless (defined($rv) && length $data) {
# Это должен быть конец файла, поэтому закрываем клиента
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove($cllent);
close $client;
next;
}
$inburfer{$client} = $data;
# Проверить, говорят ли данные в буфере или только что
# прочитанные данные о наличии полного запроса, ожидающего
# выполнения. Если да - заполнить
$ready{$client}
# запросами, ожидающими обработки.
while ($inbuffer{$client} =- s/(,*\n)//) { push( @{$ready{$client}}, $1 );
}
}
}
# Есть ли полные запросы для обработки?
foreach $client (keys %ready) { handle($client);
}
# Сбрасываемые буферы ?
foreach $client ($select->can_write(1)) {
# Пропустить этого клиента, если нам нечего сказать
next unless exists $outbuffer{$client};
$rv = $client->send($outbuffer{$client}, O):
unless (defined $rv) {
# Пожаловаться, но следовать дальше.
warn "I was told I could write, but I can't.\n";
next;
} if ($rv == length $outbuffer{$client} ||
{$! == POSIX::EWOULDBLOCK) {
substr($outbuffer{$client}, 0, $rv) = '';
delete $outbuffer{$client} unless length $outbuffer{$client};
} else {
# He удалось записать все данные и не из-за блокировки.
# Очистить буферы и следовать дальше.
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};
$select->remove($cllent);
close($client);
next;
}
}
# Внеполосные данные?
foreach $client ($select->has_exception(0)) { # аргумент - тайм-аут
# Обработайте внеполосные данные, если хотите.
}
}
# handle($socket) обрабатывает все необработанные запросы
# для клиента
$client sub handle {
# Запрос находится в $ready{$client}
# Отправить вывод в $outbuffer{$client}
my $client = shift;
mу $request;
foreach $request (@{$ready{$client}}) {
# $request - текст запроса
# Занести текст ответа в $outbuffec{$client}
} delete $ready{$client};
}
# nonblock($socket) переводит сокет в неблокирующий режим
sub nonblock {
my $socket = shift;
my $flags;
$flags = fcntl($socket, F_GETFL, 0)
or die "Can't get flags for socket: $!\n";
fcntl($socket, F_SETFL, $flags | 0_NONBLOCK)
or die "Can't make socket nonblocking: $!\n";
}

Комментарий

Как видите, одновременно обрабатывать несколько клиентов в одном процессе сложнее, чем ответвлять специальные процессы-дубликаты. Приходится выполнять много работы за операционную систему - например, делить время между разными подключениями и следить, чтобы чтение осуществлялось без блокировки.
Функция select сообщает, в каких подключениях есть данные, ожидающие чтения, какие подключения позволяют записать данные или имеют непрочитанные внеполосные данные. Мы могли бы использовать встроенную функцию Perl select, но это усложнит работу с манипуляторами. Поэтому мы используем стандартный (для версии 5.004) модуль IO::Select.
Функции getsockopt и setsockopt включают неблокирующий режим для серверного сокета. Иначе заполнение буферов сокета одного клиента привело бы к приостановке работы сервера до очистки буферов. Однако применение неблокирующего ввода/вывода означает, что нам придется разбираться с неполными операциями чтения/записи. Мы не сможем просто использовать оператор о, блокирующий до того, как станет возможным чтение всей записи, или print для вывода всей записи. Буфер %inbuffer содержит неполные команды, полученные от клиентов, %outbuffer - неотправленные данные, а % ready - массивы необработанных сообщений.
Чтобы использовать этот код в своей программе, выполните три действия. Во-первых, измените вызов IO::Socket::INET и включите в него порт своего сервера. Во-вторых, измените код, который переносит записи из in buffer в очередь ready. В настоящее время каждая строка (текст, заканчивающийся \п) рассматривается как запрос. Если ваши запросы не являются отдельными строками, внесите необходимые изменения.
while ($inbuffer{$client} =~ s/(.*\n)//) { push( @{$ready{$client}}, $1 );
}
Наконец, измените середину цикла в handler так, чтобы в ней действительно создавался ответ на запрос. В простейшей программе эхо-вывода это выглядит так:
$outbuffer{$client} .= $request;
Обработка ошибок предоставляется читателю в качестве упражнения для самостоятельной работы. На данный момент предполагается, что любая ошибка при чтении или записи завершает подключение клиента. Вероятно, это слишком сурово, поскольку "ошибки" вроде EINTR или EAGAIN не должны приводить к разрыву соединения (впрочем, при использовании select вы никогда не должны получать EAGAIN).

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

17.14. Написание распределенного сервера

Проблема

Требуется написать сервер для компьютера с несколькими IP-адресами, чтобы он мог выполнять различные операции для каждого адреса.

Решение

Не привязывайте сервер к определенному адресу. Вместо этого вызовите bind с аргументом INADDR_ANY. После того как подключение будет принято, вызов getsockname для клиентского сокета позволяет узнать, к какому адресу он подключился:
use Socket;
socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);
bind(SERVER, sockaddr_in($server_port, INADDR_ANY)) or die "Binding: $!\n";
# Цикл принятия подключений
while (accept(CLIENT, SERVER)) {
$my_socket_address = getsockname(CLIENT);
(Sport, $myaddr) = sockaddr_in($my_socket_address);
}

Комментарий

Если функция getpeername (см. рецепт 17.7) возвращает адрес удаленного конца сокета, то функция getsockname возвращает адрес локального конца. При вызове bind с аргументом INADDR_ANY принимаются подключения для всех адресов данного компьютера, поэтому для определения адреса, к которому подключился клиент, можно использовать функцию getsockname. При использовании модуля IO::Socket::INET программа будет выглядеть так:
$server = 10::Socket::INET->new(
LocalPort => $server_port,
Type => SOCK_STREAM,
Proto => 'tcp',
Listen => 10)
or die "Can't create server socket: $@\n";
while ($client = $server->accept()) {
$my_socket_address = $client->sockname(), (Sport, $myaddr) =
sockaddr_in($my_socket_address);
# . . .
}
Если не указать локальный порт при вызове 10: : Socket: : INET->new, привязка сокета будет выполнена для INADDR_ANY.
Если вы хотите, чтобы при прослушивании сервер ограничивался конкретным виртуальным хостом, не используйте INADDR_ANY. Вместо этого следует вызвать bind для конкретного адреса хоста:
use Socket;
$port = 4269; # Порт
$host = "specific.host.com"; # Виртуальный хост
socket(Server, PF_INET, SOCK_STREAM, getprotobyname("tcp"))
or die "socket: $!";
bind(Server, sockaddr_in($port, inet_aton($host)))
or die "bind: $!";
while ($client_address = accept(Client, Server)) {
# ...
}
> Смотри также -------------------------------
Описание функции getsockname в perlfunc(1); документация по стандартным модулям Socket и IO::Socket; раздел "Sockets" uperlipc(1)

---

© copyright 2000 Soft group