Вы хотите обмениваться данными с другими процессами, находящимися исключительно на локальном компьютере.
Решение
Воспользуйтесь сокетами UNIX. При этом можно использовать программы ц приемы из предыдущих рецептов для сокетов Интернета со следующими изменениями:
Вместо socketaddr_in используется socketaddr_un.
Вместо IO::Socket::UNIX используется IO::Socket::INET.
Вместо PF_INET используется PF_UNIX, а при вызове socket в качества
аргумента передается PF_UNSPEC. " Клиенты SOCK_STREAM не обязаны вызывать bind для локального адреса
перед вызовом connect.
Комментарий
Имена сокетов 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 кто-то может создать фа
Имеется сокет. Вы хотите идентифицировать компьютер, находящийся на другом конце.
Решение
Если вас интересует только 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 в случае ошибки). Распаковка вы
Не совсем. Это лишь половина решения. Поскольку поиск по имени выполняется на сервере DNS владельца имени, а поиск по IP-адресу - на сервере DNS владельца адреса, приходится учитывать возможность, что компьютер, к которому вы подключились, выдает неве
Чтобы справиться с этой проблемой, мы берем имя (возможно, ложное), полученное от gethostbyaddr, и снова вызываем для него функцию gethostbyname. В примере с evil.crackers.org поиск для trusted.dod.gov будет выполняться на сервере DNS dod.gov и вернет
<br>$packed_ip = gethostbyname($name) or die "Couldn't look up $name : $!\n";
$ip_address = inet_ntoa($packed_ip);
До настоящего момента предполагалось, что мы рассматриваем приложение с сокетами Интернета, Функцию getpeername также можно вызвать для сокета UNIX. Если па другом конце была вызвана функция bind, вы получите имя файла, к которому была выполнена привязка.
Но даже этого уровня паранойи и перестраховки недостаточно. При желании можно обмануть сервер DNS, не находящийся в вашем непосредственном распоряжении, поэтому при идентификации и аутентификации не следует полагаться на имена хостов. Настоящие параноики
> Смотри также ------------------------------
Описание функций gethostbyaddr, gethostbyname и getpeername в perlfunc(1), описание функции inet_ntoa в стандартном модуле Socket; документация по стандартным модулям IO::Socket и Net::hostnet.
Сначала получите свое (возможно, полное) имя хоста. Воспользуйтесь либо стандартным модулем 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 выбирает оптимальный способ определения имени хоста, руководствуясь сведениями о вашей системе. Он пытается получить имя хоста несколькими различными способами, но часть из них связана с запуском других про
С другой стороны, POSIX: : uname работает только в POSIX-системах и не гарантирует получения полезных данных в интересующем нас поле nodename. Впрочем, на многих компьютерах это значение все же приносит пользу и не страдает от проблем меченых данных в отл
Однако после получения имени хоста следует учесть возможность того, что в нем отсутствует имя домена. Например, Sys::Hostname вместо guanaco.camelids.org может вернуть просто guanaco. Чтобы исправить ситуацию, преобразуйте имя в IP-адрес функцией geth
Смотри также --------------------------------
Описание функций gethostbyaddr и gethostbyname в perlfunc(l); документация но стандартным модулям Net::hostnet и Sys::Hostname.
Ваша программа разветвилась, и теперь другому концу необходимо сообщить о завершении отправки данных. Вы попытались вызвать close для сокета, но удаленный конец не получает ни EOF, ни SIGPIPE.
Решение
Воспользуйтесь функцией shutdown:
shutdown(SOCKET, 0); # Прекращается чтение данных
shutdown(SOCKET, 1); # Прекращается запись данных
shutdown(SOCKET, 2); # Прекращается работа с сокетом
Используя объект IO::Socket, также можно написать:
$socket->shutdown(0); # Прекращается чтение данных
Комментарий
При разветвлении (forking) процесса потомок получает копии всех открытых файловых манипуляторов родителя, включая сокеты. Вызывая close для файла или сокета, вы закрываете только копию манипулятора, принадлежащую текущему процессу. Если в другом процессе
Рассмотрим в качестве примера сокет, в который посылаются данные. Если он открыт в двух процессах, то один из процессов может закрыть его, и операционная система все равно не будет считать сокет закрытым, поскольку он остается открытым в другом процес
Чтобы избежать затруднений, либо вызовите close для незакрытых манипуляторов, либо воспользуйтесь функцией shutdown. Функция shutdown является более радикальной формой close - она сообщает операционной системе, что, даже несмотря на наличие копий мани
Числовой аргумент shutdown позволяет указать, какие стороны соединения закрываются. Значение 0 говорит, что чтение данных закончено, а другой конец сокета при попытке передачи данных должен получить SIGPIPE. Значение 1 говорит о том, что закончена зап
Представьте себе сервер, который читает запрос своего клиента до конца файла и затем отправляет ответ. Если клиент вызовет close, сокет станет недоступным для ввода/вывода, поэтому ответ от сервера не доберется до клиента. Вместо этого клиент должен в
print SERVER "my request\n"; # Отправить данные
shutdown(SERVER, 1); # Отправить признак конца данных;
# запись окончена.
$answer = ; # Хотя чтение все еще возможно.
> Смотри также --------------------------------
Описание функций close и shutdown в perlfunc(l); страница руководства shut-down(2) вашей системы (если есть).
Вы хотите написать полностью интерактивного клиента, в котором можно ввести строку, получить ответ, ввести другую строку, получить новый ответ и т. д. - словом, нечто похожее на telnet.
Решение
После того как соединение будет установлено, разветвите процесс. Один из близнецов только читает ввод и передает его серверу, а другой - читает выходные данные сервера и копирует их в поток вывода.
Комментарий
В отношениях "клиент/сервер" бывает трудно определить, чья сейчас очередь "говорить". Однозадачные решения, в которых используется версия select с четырьмя аргументами, трудны в написании и сопровождении. Однако нет причин игнорировать многозадачные решен
После подключения к серверу, с которым вы будете обмениваться данными, вызовите 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.
Требуется написать сервер, который для работы с очередным клиентом ответвляет специальный подпроцесс.
Решение
Ответвляйте подпроцессы в цикле 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-серверов. Вместо продолжительных соединений, обладающих определе
1. Принять датаграмму.
2. Обработать датаграмму.
3. Вернуться к п. 1.
Новое соединение обрабатывается порожденным процессом. Поскольку сокет SERVER никогда не будет использоваться этим процессом, мы немедленно закрываем его. Отчасти это делается из стремления к порядку, но в основном - для того, чтобы серверный сокет за
%SIG обеспечивает чистку таблицы процессов после завершения потомков (см. главу 16).
> Смотри также --------------------------------
Описание функций fork и accept в perlfunc(1), рецепты 16.15; 16.19; 17.12-17.13.
Вы хотите написать сервер, параллельно обслуживающий нескольких клиентов (как и в предыдущем разделе), однако подключения поступают так быстро, что ветвление слишком сильно замедлит работу сервера.
Решение
Организуйте пул заранее разветвленных потомков, как показано в примере 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 потомков. Родитель следит за количеством потомков и своевременно плодит процессы, чтобы заменить мертвых потомк
Пример 17.5 более или менее прямолинейно реализует описанную логику. Единственная проблема связана с обработчиками сигналов: мы хотим, чтобы родитель перехватывал SIGINT и убивал своих потомков, и устанавливает для этого свой обработчик сигнала &HUNTS
Используя этот код в своих программах, проследите, чтобы в make_new_child никогда не использовался выход через return. В этом случае потомок вернется, станет родителем и начнет плодить своих собственных потомков. Система переполнится процессами, прибе
В некоторых операционных системах (в первую очередь - Solaris) несколько потомков не могут вызывать accept для одного сокета. Чтобы гарантировать, что лишь один потомок вызывает accept в произвольный момент времени, придется использовать блокировку фа
> Смотри также -------------------------------
Описание функции select в perlfunc(1); страница руководства fcntl(2) вашей системы (если есть); документация по стандартным модулям Fcnti, Socket, IO::Select, IO::Socket и Tie::RefHash; рецепты 17.11-17.12.
Сервер должен обрабатывать несколько одновременных подключений, но вы не хотите ответвлять новый процесс для каждого соединения.
Решение
Создайте массив открытых клиентов, воспользуйтесь 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, но это усложнит работу с мани
Функции getsockopt и setsockopt включают неблокирующий режим для серверного сокета. Иначе заполнение буферов сокета одного клиента привело бы к приостановке работы сервера до очистки буферов. Однако применение неблокирующего ввода/вывода означает, что
Чтобы использовать этот код в своей программе, выполните три действия. Во-первых, измените вызов IO::Socket::INET и включите в него порт своего сервера. Во-вторых, измените код, который переносит записи из in buffer в очередь ready. В настоящее время
while ($inbuffer{$client} =~ s/(.*\n)//) { push( @{$ready{$client}}, $1 );
} Наконец, измените середину цикла в handler так, чтобы в ней действительно создавался ответ на запрос. В простейшей программе эхо-вывода это выглядит так:
$outbuffer{$client} .= $request; Обработка ошибок предоставляется читателю в качестве упражнения для самостоятельной работы. На данный момент предполагается, что любая ошибка при чтении или записи завершает подключение клиента. Вероятно, это слишком сурово, поскольку "ошибки" вроде E
> Смотри также --------------------------------
Описание функции select в perlfunc(1); страница руководства fcntl(2) вашей системы (если есть); документация по стандартным модулям Fcnti, Socket, IO::Select, IO::Socket и Tie::Refflash; рецепты 17.11-17.12.
Требуется написать сервер для компьютера с несколькими 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 принимаются подключения для всех адресов данного компьютера, поэтому для
При использовании модуля 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)
