Question

我们有一个打开侦听器套接字的Perl系统，然后生成线程以实际接受并作用于连接。我们在Windows Server 2008上运行，并运行Perl 5.8.8（这是一个相当古老的系统）。

（顺便说一句，这在我们正在使用分叉的Linux上运行良好 - 但在Windows上实现 fork 并不是最佳的。）

我们正在使用以下代码创建套接字：

use Socket;

...;

unless (
    ($rSock) = IO::Socket::INET->new(
        LocalPort => $aChannelConfig{$sChannel}->{nPort},
        Proto     => 'tcp',
        Type      => SOCK_STREAM,
        Reuse     => 1,
        Listen    => $aChannelConfig{$sChannel}->{nListen},
    )
    and $rSock
    )
{
    $sErrNote = "Cannot create tcp listener socket: sChannel=$sChannel sService=>$aChannelConfig{$sChannel}->{nPort} Err=$!";
}

当生成的进程接受套接字时，只有第一个正常工作。

问题是后续进程只是从IO :: Socket :: accept获取undef - 在下面的核心IO :: Socket :: accept代码中，对 的调用_accept _ 返回undef（我们没有使用超时）。

sub accept {
    @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
    my $sock    = shift;
    my $pkg     = shift || $sock;
    my $timeout = ${*$sock}{'io_socket_timeout'};
    my $new     = $pkg->new( Timeout => $timeout );
    my $peer    = undef;

    print("!!! in IO::Socket::accept sock=$socket pkg=$pkg timeout=$timeout new=$new\n");
    if ( defined $timeout ) {
        require IO::Select;

        my $sel = new IO::Select $sock;

        unless ( $sel->can_read($timeout) ) {
            $@ = 'accept: timeout';
            $! = ( exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1 );
            return;
        }
    }

    $peer = accept( $new, $sock )
        or return;

    return wantarray
        ? ( $new, $peer )
        : $new;
}

据推测，我们需要对套接字选项做一些事情，以允许不同的线程接受。

有人可以给我一些指示吗？

修改我们创建线程的呼吁是：

my $thr = server::start_thread(\&_start_server_process,$sServerType,$sIcPipe,$rIcSock,'thread');


sub start_thread {

    my $thr = threads->create(@_) or return;

    return $thr;

}

编辑2 成功和不成功呼叫的日志输出如下：

Successful accept:
2014-09-22 08:55:32,575 p:2532.5    e:2532.5   s:OA.2  DEBUG : CADETserver::channel_accept - !!! - TCP socket accept. Channel=oa rH=IO::Socket::INET=GLOB(0x743c4ac)
2014-09-22 08:55:32,635 p:2532.5    e:2532.5   s:OA.2  DEBUG : CADETserver::channel_accept - !!! - TCP socket accept result. Channel=oa $@= $rClient=IO::Socket::INET=GLOB(0x9fb2d3c)

Unsuccessful accept:
2014-09-22 08:55:32,575 p:2532.6    e:2532.6   s:OA.3  DEBUG : CADETserver::channel_accept - !!! - TCP socket accept. Channel=oa rH=IO::Socket::INET=GLOB(0x7aef7d4)
2014-09-22 08:55:32,606 p:2532.6    e:2532.6   s:OA.3  DEBUG : CADETserver::channel_accept - !!! - TCP socket accept result. Channel=oa $@= $rClient=

请注意，我们只是获取 undef 客户端套接字并且 $ @

中没有记录错误

产生上述日志输出的代码如下所示 - 正如您所看到的，我们只是在没有参数的情况下调用 accept 。

my $rH = $rHndlHandles{$sCurrServerType}{$rSock};
$l4p->debug("!!! - TCP socket accept. Channel=$sChannel rH=$rH");
my $rClient;
eval {
    local $SIG{__DIE__} = 'IGNORE';
    $rClient =  $rH->accept();
};
$l4p->debug('!!! - TCP socket accept result. Channel=' . $sChannel . ' $@=' .$@ . ' $rClient=' . $rClient );

有趣的是 我正在研究问题是我们如何将套接字设置为非阻塞。我们目前的代码如下：

ioctl ($rSock, 0x8004667E, \$temp); # set non-blocking

当我将其更改为：

    use constant FIONREAD => 0x4004667f;
    my $numbytes = "\x00" x 4; # pack('L',0) works too
    ioctl($rSock, FIONREAD, unpack('I',pack('P',$numbytes)));
    my $nbytes = unpack('I',$numbytes);

（感谢PerlMonks上的bithiftleft - http://www.perlmonks.org/?node_id=780083）

这允许套接字接受OK，但套接字不能可靠地通信。

那么......是否与我们如何将套接字设置为非阻塞有关？

Perl Socket接受Windows上的线程失败

0 个答案: