HTML page
 |
 |
17.6. Использование сокетов UNIX
Проблема
Вы хотите обмениваться данными с другими процессами, находящимися исключительно на локальном компьютере.Решение
Воспользуйтесь сокетами UNIX. При этом можно использовать программы ц приемы из предыдущих рецептов для сокетов Интернета со следующими изменениями:- Вместо socketaddr_in используется socketaddr_un.
- Вместо IO::Socket::UNIX используется IO::Socket::INET.
- Вместо PF_INET используется PF_UNIX, а при вызове socket в качества
Комментарий
Имена сокетов UNIX похожи на имена файлов в файловой системе. Фактически в большинстве систем они реализуются в виде специальных файлов; именно это и делает оператор Pcrl -S - он проверяет, является ли файл сокетом UNIX.Передайте имя файла в качестве адресного аргумента 10: : Socket: :UNIX->new или закодируйте его функцией sockaddr_un и передайте его connect. Посмотрим, как создаются серверные и клиентские сокеты UNIX в модуле IO::Socket::UNIX:
use I0::Socket;
unlink "/tmp/mysock";
$server = i0::socket::unix->new(LocalAddr => "/tmp/mysock",
Type => SOCK_DGRAM,
Listen => 5 )
or die $@;
$client = 10::socket::unix->new(PeerAddr => "/tmp/mysock",
Type => SOCK_DGRAM, Timeout => 10 )
or die $@;
Пример использования традиционных функций для создания потоковых сокетов выглядит так:
use Socket;
socket(SERVER, PF_UNIX, SOCK_STREAM, 0);
unlink "/tmp/mysock";
bind(SERVER, sockaddr_un("/tmp/mysock"))
or die "Can't create server: $!";
socket(CLIENT, PFJJNIX, SOCK_STREAM, 0);
connect(CLIENT, sockaddr_un("/tmp/mysack"))
or die "Can't connect to /tmp/mysock: $!"; Если вы не уверены полностью в правильном выборе протокола, присвойте аргументу Proto при вызове 10: :Socket: :UNIX->new значение 0 для сокетов PF_UNIX. Сокеты UNIX могут быть как датаграммными (SOCK_DGRAM), так и потоковыми (SOCK_STREAM), сохраняя при этом семантику аналогичных сокетов Интернета. Изменение области не меняет характеристик типа сокета. Поскольку многие системы действительно создают специальный файл в файловой системе, вы должны удалить этот файл перед попыткой привязки сокета функцией bind. Хотя при этом возникает опасность перехвата (между вызовами unlink и bind кто-то может создать файл с именем вашего сокета), это не вызывает особых погрешностей в системе безопасности, поскольку bind не перезаписывает существующие файлы.
> Смотри также - Рецепты 17.1-17.5.
17.7. Идентификация другого конца сокета
Проблема
Имеется сокет. Вы хотите идентифицировать компьютер, находящийся на другом конце.Решение
Если вас интересует только IP-адрес удаленного компьютера, поступите следующим образом:use Socket;
$other_end = getpeername(socket)
or die "Couldn't identify other end: $!\n";
(Sport, $iaddr) = unpack_sockaddr_in($other_end);
$ip_address = inet_ntoa($iaddr);
Имя хоста определяется несколько иначе:
use Socket;
$other_end = getpeername(socket)
or die "Couldn't identify other end: $!\n";
(Sport, $iaddr) = unpack_sockaddr_in($other_end);
$actual_ip = inet_ntoa($iaddr);
$claimed_hostname = gethostbyaddr($iaddr, af_inet);
@name_lookup = gethostbyname($claimed_hostname)
or die "Could not look up $clainied_hostnarne : $!\n";
@resolved_ips = map { inet_ntoa($_) }
@name_lookup[ 4 .. $ftips_for_hostname ];
Комментарий
В течение долгого времени задача идентификации подключившихся компьютеров считалась более простой, чем на самом деле. Функция getpeername возвращает IP-адрес удаленного компьютера в упакованной двоичной структуре (или undef в случае ошибки). Распаковка выполняется функцией inet_ntoa. Если вас интересует имя удаленного компьютера, достаточно вызвать gethostbyaddr и поискать его в таблицах DNS, не так ли?Не совсем. Это лишь половина решения. Поскольку поиск по имени выполняется на сервере DNS владельца имени, а поиск по IP-адресу - на сервере DNS владельца адреса, приходится учитывать возможность, что компьютер, к которому вы подключились, выдает неверные имена. Например, компьютер evil.crackers.org может принадлежать злобным киберпиратам, которые сказали своему серверу DNS, что их IP-адрес (1.2.3.4) следует идентифицировать как trusted.dod.gov. Если ваша программа доверяет trusted.dod.gov, то при подключении с evil.crackers.org функция getpeername вернет правильный IP-адрес (1.2.3.4), однако gethostbyaddr вернет ложное имя.
Чтобы справиться с этой проблемой, мы берем имя (возможно, ложное), полученное от gethostbyaddr, и снова вызываем для него функцию gethostbyname. В примере с evil.crackers.org поиск для trusted.dod.gov будет выполняться на сервере DNS dod.gov и вернет настоящий IP-адрес (адреса) tmsted.dod.gov. Поскольку многие компьютеры имеют несколько IP-адресов (очевидный пример - распределенные Web-серверы), мы не можем использовать упрощенную форм^ gethostbyname: <br>$packed_ip = gethostbyname($name) or die "couldn't look up $name : $!\n";
$ip_address = inet_ntoa($packed_ip); До настоящего момента предполагалось, что мы рассматриваем приложение с сокетами Интернета, Функцию getpeername также можно вызвать для сокета UNIX. Если па другом конце была вызвана функция bind, вы получите имя файла, к которому была выполнена привязка. Однако если на другом конце функция bind не вызывалась, то getpeername может вернуть пустую (неупакованную) строку, упакованную строку со случайным мусором, или undef как признак ошибки... или ваш компьютер перезагрузится (варианты перечислены по убыванию вероятности и возрастанию неприятностей). В нашем компьютерном деле это называется "непредсказуемым поведением". Но даже этого уровня паранойи и перестраховки недостаточно. При желании можно обмануть сервер DNS, не находящийся в вашем непосредственном распоряжении, поэтому при идентификации и аутентификации не следует полагаться на имена хостов. Настоящие параноики и мизантропы обеспечивают безопасность с помощью криптографических методов.
> Смотри также ------------------------------ Описание функций gethostbyaddr, gethostbyname и getpeername в perlfunc(1), описание функции inet_ntoa в стандартном модуле Socket; документация по стандартным модулям IO::Socket и Net::hostnet.
17.8. Определение вашего имени и адреса
Проблема
Требуется узнать ваше (полное) имя хоста.Решение
Сначала получите свое (возможно, полное) имя хоста. Воспользуйтесь либо стандартным модулемSys::Hostname:
use Sys::Hostname;
$hostname = hostname();
либо функцией uname модуля POSIX:
use POSIX qw(uname);
($kernel, $hostname, $release, $version, $hardware) = uname();
$hostname = (uname)[1];
Затем превратите его в IP-адрес и преобразуйте в каноническую форму:
use Socket; # Для AF_INET
$address = gethostbyname($hostname)
or die "Couldn't resolve $hostname : $!";
$hostname = gethostbyaddr($address, af_inet)
or die "Couldn't re-resolve $hostname : $!";
Комментарий
Для улучшения переносимости модуль Sys::Hostname выбирает оптимальный способ определения имени хоста, руководствуясь сведениями о вашей системе. Он пытается получить имя хоста несколькими различными способами, но часть из них связана с запуском других программ. Это может привести к появлению меченых данных (см. рецепт 19.1). С другой стороны, POSIX: : uname работает только в POSIX-системах и не гарантирует получения полезных данных в интересующем нас поле nodename. Впрочем, на многих компьютерах это значение все же приносит пользу и не страдает от проблем меченых данных в отличие от Sys::Hostname.Однако после получения имени хоста следует учесть возможность того, что в нем отсутствует имя домена. Например, Sys::Hostname вместо guanaco.camelids.org может вернуть просто guanaco. Чтобы исправить ситуацию, преобразуйте имя в IP-адрес функцией gethostbyname, а затем - снова в имя функцией gethostbyaddr. Привлечение DNS гарантирует получение полного имени.
Смотри также -------------------------------- Описание функций gethostbyaddr и gethostbyname в perlfunc(l); документация но стандартным модулям Net::hostnet и Sys::Hostname.
17.9. Закрытие сокета после разветвления
Проблема
Ваша программа разветвилась, и теперь другому концу необходимо сообщить о завершении отправки данных. Вы попытались вызвать close для сокета, но удаленный конец не получает ни EOF, ни SIGPIPE.Решение
Воспользуйтесь функцией shutdown:shutdown(SOCKET, 0); # Прекращается чтение данных
shutdown(SOCKET, 1); # Прекращается запись данных
shutdown(SOCKET, 2); # Прекращается работа с сокетом
Используя объект IO::Socket, также можно написать:
$socket->shutdown(0); # Прекращается чтение данных
Комментарий
При разветвлении (forking) процесса потомок получает копии всех открытых файловых манипуляторов родителя, включая сокеты. Вызывая close для файла или сокета, вы закрываете только копию манипулятора, принадлежащую текущему процессу. Если в другом процессе (родителе или потомке) манипулятор остался открытым, операционная система не будет считать файл или сокет закрытым.Рассмотрим в качестве примера сокет, в который посылаются данные. Если он открыт в двух процессах, то один из процессов может закрыть его, и операционная система все равно не будет считать сокет закрытым, поскольку он остается открытым в другом процессе. До тех пор пока он не будет закрыт другим процессом, процесс, читающий из сокета, не получит признак конца файла. Это может привести к недоразумениям и взаимным блокировкам.
Чтобы избежать затруднений, либо вызовите close для незакрытых манипуляторов, либо воспользуйтесь функцией shutdown. Функция shutdown является более радикальной формой close - она сообщает операционной системе, что, даже несмотря на наличие копий манипулятора у других процессов, он должен быть помечен как закрытый, а другая сторона должна получить признак конца файла при чтении или SIGPIPE при записи.
Числовой аргумент shutdown позволяет указать, какие стороны соединения закрываются. Значение 0 говорит, что чтение данных закончено, а другой конец сокета при попытке передачи данных должен получить SIGPIPE. Значение 1 говорит о том, что закончена запись данных, а другой конец сокета при попытке чтения данных должен получать признак конца файла. Значение 2 говорит о завершении как чтения, так и записи.
Представьте себе сервер, который читает запрос своего клиента до конца файла и затем отправляет ответ. Если клиент вызовет close, сокет станет недоступным для ввода/вывода, поэтому ответ от сервера не доберется до клиента. Вместо этого клиент должен вызвать shutdown, чтобы закрыть соединение наполовину.
print SERVER "my request\n"; # Отправить данные
shutdown(SERVER, 1); # Отправить признак конца данных;
# запись окончена.
$answer =
> Смотри также --------------------------------
Описание функций 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 =
} } 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
# Поддерживать численность процессов,
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)
|
|
|