StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PODoing non-blocking I/O on a TCP socket in a restricted environment
text
Body
copied!<p>I trying to write some relatively simple library functions to emulate <code>LWP::UserAgent</code>'s <code>get</code> method, because <a href="https://en.wikipedia.org/wiki/Library_for_WWW_in_Perl" rel="nofollow">LWP</a> and associated libraries are not available on some of our hosting. All I can rely on are Perl's core functions and even some of those are restricted, but I do appear to have access to sockets, fork, signals and the like.</p> <p>I have so far managed to create a simple client and server (the server is just for testing) that can send and receive data. The problem is I want to set a timeout on the whole <code>get</code> operation like in LWP, but my initial attempts have been fruitless. The following does not work and I don't believe it can work, but I will post it just in case it can be fixed:</p> <pre><code>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; } </code></pre> <p>The alarm signal seems to get ignored by the likes of connect, read and possibly some of the others. I resorted to reading the LWP source code after this failed to work - because I felt like I was barking up the wrong tree - and found the following, amongst other gems, in <code>strawberry/perl/vendor/lib/LWP/Protocol/http.pm</code>:</p> <pre><code>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; } } </code></pre> <p>So it looks like it works round some of the limitations of other subroutines by using select? It also doesn't appear to fork or use signals and strictly speaking it still blocks occasionally, but it tries to make sure that it won't block for long? I feel like I should copy the gist of this code and create a simplified version for my specific needs, but I am starting to get pretty wary of running into minefields. Also note that I am developing on Windows, but deploying to Linux/nix* as well as maybe Windows in the future.</p>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload