Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

use select() instead of alarm()

  • Loading branch information...
commit 56a889d96cb873e874f040a20007e568e11cd8f2 1 parent 0dab391
Kazuho Oku kazuho authored

Showing 1 changed file with 39 additions and 21 deletions. Show diff stats Hide diff stats

  1. +39 21 lib/Starlet/Server.pm
60 lib/Starlet/Server.pm
@@ -12,7 +12,7 @@ use List::Util qw(max sum);
12 12 use Plack::Util;
13 13 use Plack::TempBuffer;
14 14 use Plack::Middleware::ContentLength;
15   -use POSIX qw(EINTR);
  15 +use POSIX qw(EINTR EAGAIN EWOULDBLOCK);
16 16 use Socket qw(IPPROTO_TCP TCP_NODELAY);
17 17
18 18 use Try::Tiny;
@@ -263,39 +263,57 @@ sub _handle_response {
263 263 }
264 264 }
265 265
266   -# returns 1 if socket is ready, undef on timeout
267   -sub do_timeout {
268   - my ($self, $cb, $timeout) = @_;
269   - local $SIG{ALRM} = sub {};
270   - my $wait_until = time + $timeout;
271   - alarm($timeout);
272   - my $ret;
273   - while (1) {
274   - if ($ret = $cb->()) {
275   - last;
276   - } elsif (! (! defined($ret) && $! == EINTR)) {
277   - undef $ret;
278   - last;
  266 +# returns value returned by $cb, or undef on timeout or network error
  267 +sub do_select {
  268 + my ($self, $cb, $rin, $win, $ein, $timeout) = @_;
  269 + my ($nfound, $ret);
  270 + while ($timeout > 0) {
  271 + my ($rout, $wout, $eout);
  272 + my $start_at = time;
  273 + $nfound = select(
  274 + $rout = $rin, $wout = $win, $eout = $ein, $timeout,
  275 + );
  276 + if ($nfound) {
  277 + if ($ret = $cb->()) {
  278 + last;
  279 + } elsif (
  280 + ! (! defined($ret)
  281 + && ($! == EINTR || $! == EAGAIN || $! == EWOULDBLOCK))) {
  282 + undef $ret;
  283 + last;
  284 + }
279 285 }
280   - # got EINTR
281   - my $left = $wait_until - time;
282   - last if $left <= 0;
283   - alarm($left + $alarm_interval);
  286 + $timeout -= (time - $start_at);
284 287 }
285   - alarm(0);
286 288 $ret;
287 289 }
288 290
289 291 # returns (positive) number of bytes read, or undef if the socket is to be closed
290 292 sub read_timeout {
291 293 my ($self, $sock, $buf, $len, $off, $timeout) = @_;
292   - $self->do_timeout(sub { $sock->sysread($$buf, $len, $off) }, $timeout);
  294 + my $rin = '';
  295 + vec($rin, fileno($sock), 1) = 1;
  296 + return $self->do_select(
  297 + sub { $sock->sysread($$buf, $len, $off) },
  298 + $rin,
  299 + '',
  300 + $rin,
  301 + $timeout,
  302 + );
293 303 }
294 304
295 305 # returns (positive) number of bytes written, or undef if the socket is to be closed
296 306 sub write_timeout {
297 307 my ($self, $sock, $buf, $len, $off, $timeout) = @_;
298   - $self->do_timeout(sub { $sock->syswrite($buf, $len, $off) }, $timeout);
  308 + my $win = '';
  309 + vec($win, fileno($sock), 1) = 1;
  310 + $self->do_select(
  311 + sub { $sock->syswrite($buf, $len, $off) },
  312 + '',
  313 + $win,
  314 + $win,
  315 + $timeout,
  316 + );
299 317 }
300 318
301 319 # writes all data in buf and returns number of bytes written or undef if failed

0 comments on commit 56a889d

Please sign in to comment.
Something went wrong with that request. Please try again.