серверная часть:#!/usr/bin/perl
use strict;use Socket;
use Fcntl;my $proto = getprotobyname('tcp');
socket(SOCK, AF_INET, SOCK_STREAM, $proto) || die "socket: $!";
my $sin = sockaddr_in(8888, inet_aton('127.0.0.1'));
bind(SOCK, sockaddr_in(8888, INADDR_ANY));
# Теперь переводим сокет в non-block mode
fcntl(SOCK, F_SETFL, O_NONBLOCK) or die "fcntl: $!";listen(SOCK, SOMAXCONN) || die "listen: $!";
my @clients;
while (1) {
vec(my $rin = '', fileno(SOCK), 1) = 1;if (select($rin, undef, undef, 1)) {
my $paddr = accept(my $client, SOCK);
my ($port, $iaddr) = sockaddr_in($paddr);
push @clients, $client;
} else {
print "Time is out!\n";my $rin = fhbits(@clients);
if (my ($nfound) = select($rin, undef, undef, 3)) {
if ($nfound > 0) {
my ($len, $data) = (0, "");
$len = sysread($clients[$nfound - 1], $data, 4096, length($data)) || warn $!, "\n";
print $data, "\n";
}
}
}
}sub fhbits {
my @clients = @_;
my($bits);for (@clients) {
vec($bits,fileno($_),1) = 1;
}$bits;
}
клиент:#!/usr/bin/perl
$| = 1;
use strict;
use Socket;
use Carp;my $pid = $$;
my $remote = shift || 'localhost';
my $port = shift || 8888;
my $proto = getprotobyname('tcp');if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
my $iaddr = inet_aton($remote) || die "no host: $remote";
my $paddr = sockaddr_in($port, $iaddr);socket(Client, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(Client, $paddr) || die "connect: $!";my $line;
my $i = 1;
while ($i < 6) {
syswrite Client, "Hello$pid|", 4096 || die "Error: ", $!, "\n";$i++;
sleep(7);
}close (Client) || die "close: $!";
exit;Суть проблемы заключается в том, что на стороне сервера сначала коннектится первый клиент и успевает отправить сообщение "Hello...", а потом уже второй, и считываются сообщения от второго клиента 5 раз, и только после этого нормально считываются оставшиеся сообщения от первого клиента.
А хочется, чтоб это шло параллельно.
Вроде бы повесил и неблокирующий режим, но мож я его как-то не правильно повесил. Или ошибка в чем-то другом?
Как я понимаю, вы хотите получить сервер без ветвления, который должен обрабатывать несколько одновременных подключений.
Но ответвление нового процесса для каждого соединения делать не хотите.Есть для этого уже хороший готовый пример.
Приведен он в книге Тома Кристиансена и Натана Торкингтона, "Perl. Сборник рецептов. Для профессионалов" Пример 17.6#!/usr/bin/perl
use warnings;
use strict;
use POSIX;
use IO::Socket;
use IO::Select;
use Socket;
use Fcntl;
use Tie::RefHash;my $port = 8888;
# Прослушивать порт.
my $server = IO::Socket::INET->new(LocalPort => $port,
Listen => 10 )
or die "Can't make server socket: $@\n";# Начать с пустыми буферами
my %inbuffer = ();
my %outbuffer = ();
my %ready = ();tie %ready, 'Tie::RefHash';
nonblock($server);
my $select = IO::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($client);
close $client;
next;
}$inbuffer{$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}, 0);
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 {
# Не удалось записать все данные и не из-за блокировки.
# Очистить буферы и следовать дальше.
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};$select->remove($client);
close($client);
next;
}
}# Внеполосные данные?
foreach $client ($select->has_exception(0)) { # аргумент - тайм-аут
# Обработайте внеполосные данные, если хотите.
}
}# handle($socket) обрабатывает все необработанные запросы
# для клиента $client
sub handle {
# Запросы находятся в $ready{$client}
# Отправить вывод в $outbuffer{$client}
my $client = shift;
my $request;foreach $request (@{$ready{$client}}) {
# $request - текст запроса
# Занести текст ответа в $outbuffer{$client}
$outbuffer{$client} .= $request;
print $outbuffer{$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 | O_NONBLOCK)
or die "Can't make socket nonblocking: $!\n";
}Поскольку в этом примере каждая строка заканчивающаяся на \n рассматривается как запрос,
то для проверки в клиентской части нужно заменить строку
syswrite Client, "Hello$pid|", 4096 || die "Error: ", $!, "\n"; на
syswrite Client, "Hello$pid|\n", 4096 || die "Error: ", $!, "\n"; то есть добавить \nКстати, там же, пример с fork выглядит проще и легче.
>[оверквотинг удален]
> fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
>
> or die "Can't make socket nonblocking: $!\n";
> }
> Поскольку в этом примере каждая строка заканчивающаяся на \n рассматривается как запрос,
> то для проверки в клиентской части нужно заменить строку
> syswrite Client, "Hello$pid|", 4096 || die "Error: ", $!, "\n"; на
> syswrite Client, "Hello$pid|\n", 4096 || die "Error: ", $!, "\n"; то есть
> добавить \n
> Кстати, там же, пример с fork выглядит проще и легче.Ну на самом деле будет не ветвление а треды, там не все так просто как кажется на первый взгляд. И я в принципе могу согласиться с вашим решением, при условии, что вы мне еще продемонстрируете как получить timeleft на таймауте селекта. Допустим таймаут 10 секунд, и если событие срабатывает раньше - нужно еще зафиксировать timeleft
> Ну на самом деле будет не ветвление а тредыМногопоточный сервер там также приведён в качестве примера.
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use IO::Socket;my $listen = IO::Socket::INET->new (
LocalPort => 8888,
ReuseAddr => 1,
Listen => 10,
);sub handle_connection {
my $socket = shift;
my $output = shift;
my $exit = 0;
while (<$socket>) {
# Работать с $_
# Выводить данные в $output
# При завершении подключения присвоить $exit значение true
$output = $_;
print $output;
last if $exit;
}
}while ( my $socket = $listen->accept ) {
async(\&handle_connection, $socket)->detach;
}А что, с timeleft какая проблема?
> А что, с timeleft какая проблема?Проблем нет, вопрос лишь в том, какой функцией можно получить timeleft в библиотеке IO::Select. Сорри, пока детально разложить код времени не было, на следующей неделе
Люто. Приличные пасаны давно не дергают сокеты. Откройте для себя, например, AnyEvent от http://software.schmorp.de/ .