Perl IO :: Проблема синхронизации сокетов

Question

Я столкнулся со странной проблемой. Я написал небольшой демон на Perl, который связывает порт на сервере. На том же сервере работает LAMP, и клиент для моего демона Perl - это php-файл, который открывает сокет с демоном, передает некоторую информацию и затем закрывает соединение. В демоне Perl я регистрирую каждое соединение в файле журнала для дальнейшего использования.

Моя самая большая проблема заключается в следующем: между моментом, когда php-скрипт заканчивает свое выполнение, проходит 15-20 секунд, пока демон не регистрирует соединение.

Клиент PHP:

$sh = fsockopen("127.0.0.1", 7890, $errno, $errstr, 30);
if (!$sh) 
{
echo "$errstr ($errno)<br />\n";
} 
else 
{

    $out = base64_encode('contents');
    fwrite($sh, $out);
    fclose($sh);
}

Демон Perl (только часть сокета)

#!/usr/bin/perl

use strict;
use warnings;
use Proc::Daemon;
use Proc::PID::File;
use IO::Socket;
use MIME::Base64;
use Net::Address::IP::Local;

MAIN:
{
#setup some vars to be used down...
if (Proc::PID::File->running())
        {
                exit(0);
        }


        my $sock = new IO::Socket::INET(
                        LocalHost => $ip,
                        LocalPort => $port,
                        Proto => 'tcp',
                        Listen => SOMAXCONN,
                        Reuse => 1);

        $sock or die "no socket :$!";
        my($new_sock, $c_addr, $buf);

for (;;) 
        {

                # setup log file 
                open(LH, ">>".$logs);

                print "SERVER started on $ip:$port \n";
                print LH "SERVER started on $ip:$port \n";

                while (($new_sock, $c_addr) = $sock->accept())
                {
                        my ($client_port, $c_ip) =sockaddr_in($c_addr);
                        my $client_ipnum = inet_ntoa($c_ip);
                        my $client_host =gethostbyaddr($c_ip, AF_INET);

                        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime time;
                        $year += 1900;
                        $mon += 1;
                        print "$year-$mon-$mday $hour:$min:$sec [".time()."] - got a connection from: [$client_ipnum]";

                        open(AL, ">>".$accessLog);
                        print AL "$year-$mon-$mday $hour:$min:$sec [".time()."] - got a connection from: [$client_ipnum]\n";
                        close AL;

                        while (defined ($buf = <$new_sock>))
                        {
                                print "contents:",  decode_base64($buf), " \n";
                                open(FH, ">".$basepath."file_" . time() .".txt")  or warn "Can't open ".$basepath."file_".time().".txt for writing: $!";
                                print FH decode_base64($buf);
                                close FH;
                        }
                }
                close LH;

        }

}

Что я делаю неправильно, а затем приводит к разрыву в 20 секунд между php, закрывающим сокет после его записи, и скриптом Perl, регистрирующим соединение. Любая идея? Будьте нежны, я новичок в Perl:)

Answer 1

$ new_sock явно не закрывается и поэтому не закрывается до вызова accept. Это может привести к зависанию некоторых вещей до истечения времени ожидания. (Я не уверен, произойдет ли закрытие при входе, чтобы принять или выйти из него.)

Также вы используете оператор «<>» для чтения данных из сокета. Что произойдет, если во входе нет новых строк?

Лучший способ увидеть, что на самом деле происходит, - запустить процесс в «strace -e trace = network» и попытаться сопоставить сетевой системный вызов с операторами perl и php.

Answer 2

Я не вижу ни одного вызова для очистки буфера, не могли бы вы проверить, исчезает ли задержка при очистке после регистрации?