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

时间:2012-01-25 13:45:35

标签: perl sockets cgi

我尝试编写一些相对简单的库函数来模拟LWP::UserAgent的{​​{1}}方法,因为LWP和相关的库在我们的某些托管中不可用。我可以依赖的只是Perl的核心功能,甚至其中一些是受限制的,但我似乎可以访问套接字,分支,信号等。

到目前为止,我设法创建了一个可以发送和接收数据的简单客户端和服务器(服务器只是用于测试)。问题是我想在整个get操作中设置超时,就像在LWP中一样,但我最初的尝试都没有结果。以下不起作用,我不相信它可以工作,但我会发布它,以防它可以修复:

get

警报信号似乎被连接,读取和其他一些人忽略了。在没有工作之后我使用LWP源代码 - 因为我觉得我正在咆哮错误的树 - 并在sub grab { my($addr, $port, $timeout) = @_; my $it; eval { local $SIG{ALRM} = sub { die "alarm\n"; }; 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 "alarm\n"; }; 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 "alarm\n"; } return $it; } 中找到了以下宝石,其中包括:

strawberry/perl/vendor/lib/LWP/Protocol/http.pm

所以看起来它通过使用select来解决其他子程序的一些限制吗?它也似乎没有分叉或使用信号,严格来说它仍然偶尔阻塞,但它试图确保它不会阻塞很长时间?我觉得我应该复制这段代码的要点并根据我的特定需求创建一个简化版本,但我开始非常警惕进入雷区。另请注意,我正在开发Windows,但将来部署到Linux / nix *以及Windows。

1 个答案:

答案 0 :(得分:0)

似乎很少有你可以简化:它的核心是使用5个arg版本的select作为perldoc -f select整齐地解释(摘要在答案的底部)。

但我不理解你的努力,除非是为了学习目的:你可以抓住LWP并将其与其他自定义库打包,基本上没有任何努力,在顶部使用“使用lib qw(foo / bar)”你编程。我怀疑你可以提出一些非常简单的东西,同时从协议的角度来看也是正确的。

如果您不想使用select()而不是fork,请在客户端进行get并让父进程在超时时终止子进程(如果您觉得如此倾向,您甚至可以使用线程)但这很奇怪,更不用说不必要了。

干杯,

-

perldoc -f select

   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) =