在受限环境中对TCP套接字执行非阻塞I/O

Question

我试图编写一些相对简单的库函数来模拟LWP::UserAgent的get方法，因为LWP和相关的库在我们的一些主机上不可用。我所能依赖的只是Perl的核心函数，甚至其中一些函数是受限制的，但我似乎可以访问套接字、fork、信号等。

到目前为止，我已经创建了一个简单的客户端和服务器（服务器只是用于测试），可以发送和接收数据。问题是，我想像在LWP中那样对整个get操作设置超时，但我最初的尝试没有结果。以下内容不起作用，我不相信它能起作用，但我会发布它，以防它被修复：

sub grab {
    my($addr, $port, $timeout) = @_;
    my $it;
    eval {
        local $SIG{ALRM} = sub {
            die "alarmn";
        };
        alarm $timeout if $timeout;
        my $iaddr = inet_aton($addr)
        or die "client no host: $!";
        my $paddr = sockaddr_in($port, $iaddr)
        or die "client sockaddr_in: $!";
        my $proto = getprotobyname("tcp");
        socket(Client, PF_INET, SOCK_STREAM, $proto)
        or die "Client socket: $!";
        local $SIG{ALRM} = sub {
            close(Client);
            die "alarmn";
        };
        connect(Client, $paddr)
        or die "Client connect: $!";
        while(my $line = <Client>) {
            $it .= $line;
        }
        print alarm(0), " seconds left n";
        close(Client) or die "Client close: $!";
    };
    if($@) {
        die unless $@ eq "alarmn";
    }
    return $it;
}

警报信号似乎被诸如连接、读取之类的东西忽视了，可能还有其他一些东西。在这失败后，我不得不阅读LWP源代码，因为我觉得我找错了树，并在strawberry/perl/vendor/lib/LWP/Protocol/http.pm中发现了以下内容：

sub sysread {
    my $self = shift;
    if (my $timeout = ${*$self}{io_socket_timeout}) {
        die "read timeout" unless $self->can_read($timeout);
    }
    else {
        # since we have made the socket non-blocking we
        # use select to wait for some data to arrive
        $self->can_read(undef) || die "Assert";
    }
    sysread($self, $_[0], $_[1], $_[2] || 0);
}
sub can_read {
    my($self, $timeout) = @_;
    my $fbits = '';
    vec($fbits, fileno($self), 1) = 1;
    SELECT:
    {
        my $before;
        $before = time if $timeout;
        my $nfound = select($fbits, undef, undef, $timeout);
        if ($nfound < 0) {
            if ($!{EINTR} || $!{EAGAIN}) {
                # don't really think EAGAIN can happen here
                if ($timeout) {
                    $timeout -= time - $before;
                    $timeout = 0 if $timeout < 0;
                }
                redo SELECT;
            }
            die "select failed: $!";
        }
        return $nfound > 0;
    }
}

所以它看起来像是通过使用select绕过了其他子例程的一些限制？它似乎也不会分叉或使用信号，严格地说，它仍然偶尔会阻塞，但它试图确保它不会阻塞很长时间？我觉得我应该复制这段代码的要点，并为我的特定需求创建一个简化版本，但我开始对遇到雷区感到非常警惕。还要注意，我正在Windows上进行开发，但将来可能会部署到Linux/nix*以及Windows。

Answer 1

似乎没有什么可以简化的：它的核心是使用5 arg版本的select，正如perldoc-f select巧妙地解释的那样（答案底部的摘要）。

但除非是为了学习，否则我无法理解你的努力：你可以毫不费力地获取LWP并将其与其他自定义库打包，在程序顶部添加一个"use lib qw（foo/bar）"。我怀疑你是否能想出一个更简单的方法，同时从协议的角度来看也是正确的。

如果你不想使用select（），那么你可以使用fork，在客户端中执行get，并让父级在超时时杀死子级（如果你觉得有兴趣的话，你甚至可以使用线程），但这很奇怪，更不用说没有必要了。

干杯，

--

perldoc-f选择

   select RBITS,WBITS,EBITS,TIMEOUT
           This calls the select(2) system call with the bit masks specified, 
           which can be constructed using "fileno" and "vec", along these lines:
               $rin = $win = $ein = ’’;
               vec($rin,fileno(STDIN),1) = 1;
               vec($win,fileno(STDOUT),1) = 1;
               $ein = $rin │ $win;
           If you want to select on many filehandles you might wish to write a subroutine:
               sub fhbits {
                   my(@fhlist) = split(’ ’,$_[0]);
                   my($bits);
                   for (@fhlist) {
                       vec($bits,fileno($_),1) = 1;
                   }
                   $bits;
               }
               $rin = fhbits(’STDIN TTY SOCK’);
           The usual idiom is:
               ($nfound,$timeleft) =