# (tmpio = [ GLOB, offset, [ length ] ])
package PublicInbox::DS;
use strict;
-use bytes;
-use POSIX qw(WNOHANG);
-use IO::Handle qw();
+use v5.10.1;
+use parent qw(Exporter);
+use bytes qw(length substr); # FIXME(?): needed for PublicInbox::NNTP
+use POSIX qw(WNOHANG sigprocmask SIG_SETMASK);
use Fcntl qw(SEEK_SET :DEFAULT O_APPEND);
use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
-use parent qw(Exporter);
-our @EXPORT_OK = qw(now msg_more);
-use 5.010_001;
use Scalar::Util qw(blessed);
use PublicInbox::Syscall qw(:epoll);
use PublicInbox::Tmpfile;
use Errno qw(EAGAIN EINVAL);
-use Carp qw(confess carp);
+use Carp qw(carp croak);
+our @EXPORT_OK = qw(now msg_more dwaitpid add_timer add_uniq_timer);
+my %Stack;
my $nextq; # queue for next_tick
my $wait_pids; # list of [ pid, callback, callback_arg ]
-my $later_queue; # list of callbacks to run at some later interval
-my $EXPMAP; # fd -> idle_time
-our $EXPTIME = 180; # 3 minutes
-my ($later_timer, $reap_timer, $exp_timer);
+my $reap_armed;
my $ToClose; # sockets to close when event loop is done
our (
%DescriptorMap, # fd (num) -> PublicInbox::DS object
$Epoll, # Global epoll fd (or DSKQXS ref)
- $_io, # IO::Handle for Epoll
+ $ep_io, # IO::Handle for Epoll
$PostLoopCallback, # subref to call at the end of each loop, if defined (global)
$LoopTimeout, # timeout of event loop in milliseconds
- $DoneInit, # if we've done the one-time module init yet
@Timers, # timers
+ %UniqTimer,
$in_loop,
);
=cut
sub Reset {
- %DescriptorMap = ();
- $in_loop = $wait_pids = $later_queue = undef;
- $EXPMAP = {};
- $nextq = $ToClose = $reap_timer = $later_timer = $exp_timer = undef;
- $LoopTimeout = -1; # no timeout by default
- @Timers = ();
-
- $PostLoopCallback = undef;
- $DoneInit = 0;
-
- $_io = undef; # closes real $Epoll FD
- $Epoll = undef; # may call DSKQXS::DESTROY
-
- *EventLoop = *FirstTimeEventLoop;
+ do {
+ $in_loop = undef; # first in case DESTROY callbacks use this
+ %DescriptorMap = ();
+ @Timers = ();
+ %UniqTimer = ();
+ $PostLoopCallback = undef;
+
+ # we may be iterating inside one of these on our stack
+ my @q = delete @Stack{keys %Stack};
+ for my $q (@q) { @$q = () }
+ $wait_pids = $nextq = $ToClose = undef;
+ $ep_io = undef; # closes real $Epoll FD
+ $Epoll = undef; # may call DSKQXS::DESTROY
+ } while (@Timers || keys(%Stack) || $nextq || $wait_pids ||
+ $ToClose || keys(%DescriptorMap) ||
+ $PostLoopCallback || keys(%UniqTimer));
+
+ $reap_armed = undef;
+ $LoopTimeout = -1; # no timeout by default
}
=head2 C<< CLASS->SetLoopTimeout( $timeout ) >>
immediately.
=cut
-sub SetLoopTimeout {
- return $LoopTimeout = $_[1] + 0;
-}
-
-=head2 C<< PublicInbox::DS::add_timer( $seconds, $coderef ) >>
-
-Add a timer to occur $seconds from now. $seconds may be fractional, but timers
-are not guaranteed to fire at the exact time you ask for.
-
-=cut
-sub add_timer ($$) {
- my ($secs, $coderef) = @_;
-
- my $fire_time = now() + $secs;
-
- my $timer = [$fire_time, $coderef];
-
- if (!@Timers || $fire_time >= $Timers[-1][0]) {
- push @Timers, $timer;
- return $timer;
- }
+sub SetLoopTimeout { $LoopTimeout = $_[1] + 0 }
- # Now, where do we insert? (NOTE: this appears slow, algorithm-wise,
- # but it was compared against calendar queues, heaps, naive push/sort,
- # and a bunch of other versions, and found to be fastest with a large
- # variety of datasets.)
- for (my $i = 0; $i < @Timers; $i++) {
- if ($Timers[$i][0] > $fire_time) {
- splice(@Timers, $i, 0, $timer);
- return $timer;
- }
- }
-
- die "Shouldn't get here.";
-}
+sub _add_named_timer {
+ my ($name, $secs, $coderef, @args) = @_;
+ my $fire_time = now() + $secs;
+ my $timer = [$fire_time, $name, $coderef, @args];
-# keeping this around in case we support other FD types for now,
-# epoll_create1(EPOLL_CLOEXEC) requires Linux 2.6.27+...
-sub set_cloexec ($) {
- my ($fd) = @_;
+ if (!@Timers || $fire_time >= $Timers[-1][0]) {
+ push @Timers, $timer;
+ return $timer;
+ }
- $_io = IO::Handle->new_from_fd($fd, 'r+') or return;
- defined(my $fl = fcntl($_io, F_GETFD, 0)) or return;
- fcntl($_io, F_SETFD, $fl | FD_CLOEXEC);
+ # Now, where do we insert? (NOTE: this appears slow, algorithm-wise,
+ # but it was compared against calendar queues, heaps, naive push/sort,
+ # and a bunch of other versions, and found to be fastest with a large
+ # variety of datasets.)
+ for (my $i = 0; $i < @Timers; $i++) {
+ if ($Timers[$i][0] > $fire_time) {
+ splice(@Timers, $i, 0, $timer);
+ return $timer;
+ }
+ }
+ die "Shouldn't get here.";
}
-sub _InitPoller
-{
- return if $DoneInit;
- $DoneInit = 1;
+sub add_timer { _add_named_timer(undef, @_) }
- if (PublicInbox::Syscall::epoll_defined()) {
- $Epoll = epoll_create();
- set_cloexec($Epoll) if (defined($Epoll) && $Epoll >= 0);
- } else {
- my $cls;
- for (qw(DSKQXS DSPoll)) {
- $cls = "PublicInbox::$_";
- last if eval "require $cls";
- }
- $cls->import(qw(epoll_ctl epoll_wait));
- $Epoll = $cls->new;
- }
- *EventLoop = *EpollEventLoop;
+sub add_uniq_timer { # ($name, $secs, $coderef, @args) = @_;
+ $UniqTimer{$_[0]} //= _add_named_timer(@_);
}
-=head2 C<< CLASS->EventLoop() >>
-
-Start processing IO events. In most daemon programs this never exits. See
-C<PostLoopCallback> below for how to exit the loop.
-
-=cut
-sub FirstTimeEventLoop {
- my $class = shift;
-
- _InitPoller();
-
- EventLoop($class);
+# caller sets return value to $Epoll
+sub _InitPoller () {
+ if (PublicInbox::Syscall::epoll_defined()) {
+ my $fd = epoll_create();
+ die "epoll_create: $!" if $fd < 0;
+ open($ep_io, '+<&=', $fd) or return;
+ my $fl = fcntl($ep_io, F_GETFD, 0);
+ fcntl($ep_io, F_SETFD, $fl | FD_CLOEXEC);
+ $fd;
+ } else {
+ my $cls;
+ for (qw(DSKQXS DSPoll)) {
+ $cls = "PublicInbox::$_";
+ last if eval "require $cls";
+ }
+ $cls->import(qw(epoll_ctl epoll_wait));
+ $cls->new;
+ }
}
sub now () { clock_gettime(CLOCK_MONOTONIC) }
sub next_tick () {
- my $q = $nextq or return;
- $nextq = undef;
- for (@$q) {
- # we avoid "ref" on blessed refs to workaround a Perl 5.16.3 leak:
- # https://rt.perl.org/Public/Bug/Display.html?id=114340
- if (blessed($_)) {
- $_->event_step;
- } else {
- $_->();
- }
- }
+ my $q = $nextq or return;
+ $nextq = undef;
+ $Stack{cur_runq} = $q;
+ for my $obj (@$q) {
+ # avoid "ref" on blessed refs to workaround a Perl 5.16.3 leak:
+ # https://rt.perl.org/Public/Bug/Display.html?id=114340
+ if (blessed($obj)) {
+ $obj->event_step;
+ } else {
+ $obj->();
+ }
+ }
+ delete $Stack{cur_runq};
}
# runs timers and returns milliseconds for next one, or next event loop
sub RunTimers {
- next_tick();
+ next_tick();
- return (($nextq || $ToClose) ? 0 : $LoopTimeout) unless @Timers;
+ return (($nextq || $ToClose) ? 0 : $LoopTimeout) unless @Timers;
- my $now = now();
+ my $now = now();
- # Run expired timers
- while (@Timers && $Timers[0][0] <= $now) {
- my $to_run = shift(@Timers);
- $to_run->[1]->($now) if $to_run->[1];
- }
+ # Run expired timers
+ while (@Timers && $Timers[0][0] <= $now) {
+ my $to_run = shift(@Timers);
+ delete $UniqTimer{$to_run->[1] // ''};
+ $to_run->[2]->(@$to_run[3..$#$to_run]);
+ }
- # timers may enqueue into nextq:
- return 0 if ($nextq || $ToClose);
+ # timers may enqueue into nextq:
+ return 0 if ($nextq || $ToClose);
- return $LoopTimeout unless @Timers;
+ return $LoopTimeout unless @Timers;
- # convert time to an even number of milliseconds, adding 1
- # extra, otherwise floating point fun can occur and we'll
- # call RunTimers like 20-30 times, each returning a timeout
- # of 0.0000212 seconds
- my $timeout = int(($Timers[0][0] - $now) * 1000) + 1;
+ # convert time to an even number of milliseconds, adding 1
+ # extra, otherwise floating point fun can occur and we'll
+ # call RunTimers like 20-30 times, each returning a timeout
+ # of 0.0000212 seconds
+ my $timeout = int(($Timers[0][0] - $now) * 1000) + 1;
- # -1 is an infinite timeout, so prefer a real timeout
- return $timeout if $LoopTimeout == -1;
+ # -1 is an infinite timeout, so prefer a real timeout
+ ($LoopTimeout < 0 || $LoopTimeout >= $timeout) ? $timeout : $LoopTimeout
+}
+
+sub sig_setmask { sigprocmask(SIG_SETMASK, @_) or die "sigprocmask: $!" }
- # otherwise pick the lower of our regular timeout and time until
- # the next timer
- return $LoopTimeout if $LoopTimeout < $timeout;
- return $timeout;
+sub block_signals () {
+ my $oldset = POSIX::SigSet->new;
+ my $newset = POSIX::SigSet->new;
+ $newset->fillset or die "fillset: $!";
+ sig_setmask($newset, $oldset);
+ $oldset;
}
# We can't use waitpid(-1) safely here since it can hit ``, system(),
# and other things. So we scan the $wait_pids list, which is hopefully
# not too big. We keep $wait_pids small by not calling dwaitpid()
# until we've hit EOF when reading the stdout of the child.
+
sub reap_pids {
- my $tmp = $wait_pids or return;
- $wait_pids = $reap_timer = undef;
- foreach my $ary (@$tmp) {
- my ($pid, $cb, $arg) = @$ary;
- my $ret = waitpid($pid, WNOHANG);
- if ($ret == 0) {
- push @$wait_pids, $ary; # autovivifies @$wait_pids
- } elsif ($cb) {
- eval { $cb->($arg, $pid) };
- }
- }
- # we may not be done, yet, and could've missed/masked a SIGCHLD:
- $reap_timer = add_timer(1, \&reap_pids) if $wait_pids;
+ $reap_armed = undef;
+ my $tmp = $wait_pids or return;
+ $wait_pids = undef;
+ $Stack{reap_runq} = $tmp;
+ my $oldset = block_signals();
+ foreach my $ary (@$tmp) {
+ my ($pid, $cb, $arg) = @$ary;
+ my $ret = waitpid($pid, WNOHANG);
+ if ($ret == 0) {
+ push @$wait_pids, $ary; # autovivifies @$wait_pids
+ } elsif ($ret == $pid) {
+ if ($cb) {
+ eval { $cb->($arg, $pid) };
+ warn "E: dwaitpid($pid) in_loop: $@" if $@;
+ }
+ } else {
+ warn "waitpid($pid, WNOHANG) = $ret, \$!=$!, \$?=$?";
+ }
+ }
+ sig_setmask($oldset);
+ delete $Stack{reap_runq};
}
# reentrant SIGCHLD handler (since reap_pids is not reentrant)
-sub enqueue_reap ($) { push @$nextq, \&reap_pids }; # autovivifies
+sub enqueue_reap () { $reap_armed //= requeue(\&reap_pids) }
sub in_loop () { $in_loop }
$ToClose = undef; # will be autovivified on push
@$close_now = map { fileno($_) } @$close_now;
- # order matters, destroy expiry times, first:
- delete @$EXPMAP{@$close_now};
-
# ->DESTROY methods may populate ToClose
delete @DescriptorMap{@$close_now};
}
$PostLoopCallback ? $PostLoopCallback->(\%DescriptorMap) : 1;
}
-sub EpollEventLoop {
- local $in_loop = 1;
- do {
- my @events;
- my $i;
- my $timeout = RunTimers();
-
- # get up to 1000 events
- my $evcount = epoll_wait($Epoll, 1000, $timeout, \@events);
- for ($i=0; $i<$evcount; $i++) {
- # it's possible epoll_wait returned many events, including some at the end
- # that ones in the front triggered unregister-interest actions. if we
- # can't find the %sock entry, it's because we're no longer interested
- # in that event.
- $DescriptorMap{$events[$i]->[0]}->event_step;
- }
- } while (PostEventLoop());
- _run_later();
+# Start processing IO events. In most daemon programs this never exits. See
+# C<PostLoopCallback> for how to exit the loop.
+sub event_loop (;$$) {
+ my ($sig, $oldset) = @_;
+ $Epoll //= _InitPoller();
+ require PublicInbox::Sigfd if $sig;
+ my $sigfd = PublicInbox::Sigfd->new($sig, 1) if $sig;
+ local @SIG{keys %$sig} = values(%$sig) if $sig && !$sigfd;
+ local $SIG{PIPE} = 'IGNORE';
+ if (!$sigfd && $sig) {
+ # wake up every second to accept signals if we don't
+ # have signalfd or IO::KQueue:
+ sig_setmask($oldset);
+ PublicInbox::DS->SetLoopTimeout(1000);
+ }
+ $_[0] = $sigfd = $sig = undef; # $_[0] == sig
+ local $in_loop = 1;
+ my @events;
+ do {
+ my $timeout = RunTimers();
+
+ # get up to 1000 events
+ epoll_wait($Epoll, 1000, $timeout, \@events);
+ for my $fd (@events) {
+ # it's possible epoll_wait returned many events,
+ # including some at the end that ones in the front
+ # triggered unregister-interest actions. if we can't
+ # find the %sock entry, it's because we're no longer
+ # interested in that event.
+
+ # guard stack-not-refcounted w/ Carp + @DB::args
+ my $obj = $DescriptorMap{$fd};
+ $obj->event_step;
+ }
+ } while (PostEventLoop());
}
=head2 C<< CLASS->SetPostLoopCallback( CODEREF ) >>
=head2 C<< CLASS->new( $socket ) >>
Create a new PublicInbox::DS subclass object for the given I<socket> which will
-react to events on it during the C<EventLoop>.
+react to events on it during the C<event_loop>.
This is normally (always?) called from your subclass via:
$self->{sock} = $sock;
my $fd = fileno($sock);
- _InitPoller();
-
+ $Epoll //= _InitPoller();
+retry:
if (epoll_ctl($Epoll, EPOLL_CTL_ADD, $fd, $ev)) {
if ($! == EINVAL && ($ev & EPOLLEXCLUSIVE)) {
$ev &= ~EPOLLEXCLUSIVE;
goto retry;
}
- die "couldn't add epoll watch for $fd: $!\n";
+ die "EPOLL_CTL_ADD $self/$sock/$fd: $!";
}
- confess("DescriptorMap{$fd} defined ($DescriptorMap{$fd})")
+ croak("FD:$fd in use by $DescriptorMap{$fd} (for $self/$sock)")
if defined($DescriptorMap{$fd});
$DescriptorMap{$fd} = $self;
}
+# for IMAP, NNTP, and POP3 which greet clients upon connect
+sub greet {
+ my ($self, $sock) = @_;
+ my $ev = EPOLLIN;
+ my $wbuf;
+ if ($sock->can('accept_SSL') && !$sock->accept_SSL) {
+ return CORE::close($sock) if $! != EAGAIN;
+ $ev = PublicInbox::TLS::epollbit() or return CORE::close($sock);
+ $wbuf = [ \&accept_tls_step, $self->can('do_greet')];
+ }
+ new($self, $sock, $ev | EPOLLONESHOT);
+ if ($wbuf) {
+ $self->{wbuf} = $wbuf;
+ } else {
+ $self->do_greet;
+ }
+ $self;
+}
#####################################################################
### I N S T A N C E M E T H O D S
# notifications about it
my $fd = fileno($sock);
epoll_ctl($Epoll, EPOLL_CTL_DEL, $fd, 0) and
- confess("EPOLL_CTL_DEL: $!");
+ croak("EPOLL_CTL_DEL($self/$sock): $!");
# we explicitly don't delete from DescriptorMap here until we
# actually close the socket, as we might be in the middle of
goto next_buf;
}
} elsif ($! == EAGAIN) {
- epwait($sock, epbit($sock, EPOLLOUT) | EPOLLONESHOT);
+ my $ev = epbit($sock, EPOLLOUT) or return $self->close;
+ epwait($sock, $ev | EPOLLONESHOT);
return 0;
} else {
return $self->close;
# common for clients to break connections without warning,
# would be too noisy to log here:
if ($! == EAGAIN) {
- epwait($sock, epbit($sock, EPOLLIN) | EPOLLONESHOT);
+ my $ev = epbit($sock, EPOLLIN) or return $self->close;
+ epwait($sock, $ev | EPOLLONESHOT);
rbuf_idle($self, $rbuf);
0;
} else {
$self->close;
}
-# n.b.: use ->write/->read for this buffer to allow compatibility with
-# PerlIO::mmap or PerlIO::scalar if needed
sub tmpio ($$$) {
- my ($self, $bref, $off) = @_;
- my $fh = tmpfile('wbuf', $self->{sock}, O_APPEND) or
- return drop($self, "tmpfile $!");
- $fh->autoflush(1);
- my $len = bytes::length($$bref) - $off;
- $fh->write($$bref, $len, $off) or return drop($self, "write ($len): $!");
- [ $fh, 0 ] # [1] = offset, [2] = length, not set by us
+ my ($self, $bref, $off) = @_;
+ my $fh = tmpfile('wbuf', $self->{sock}, O_APPEND) or
+ return drop($self, "tmpfile $!");
+ $fh->autoflush(1);
+ my $len = length($$bref) - $off;
+ my $n = syswrite($fh, $$bref, $len, $off) //
+ return drop($self, "write ($len): $!");
+ $n == $len or return drop($self, "wrote $n < $len bytes");
+ [ $fh, 0 ] # [1] = offset, [2] = length, not set by us
}
=head2 C<< $obj->write( $data ) >>
$bref->($self);
return 1;
} else {
- my $to_write = bytes::length($$bref);
+ my $to_write = length($$bref);
my $written = syswrite($sock, $$bref, $to_write);
if (defined $written) {
return 1 if $written == $to_write;
requeue($self); # runs: event_step -> flush_write
} elsif ($! == EAGAIN) {
- epwait($sock, epbit($sock, EPOLLOUT) | EPOLLONESHOT);
+ my $ev = epbit($sock, EPOLLOUT) or return $self->close;
+ epwait($sock, $ev | EPOLLONESHOT);
$written = 0;
} else {
return $self->close;
!$sock->can('stop_SSL')) {
my $n = send($sock, $_[1], MSG_MORE);
if (defined $n) {
- my $nlen = bytes::length($_[1]) - $n;
+ my $nlen = length($_[1]) - $n;
return 1 if $nlen == 0; # all done!
# queue up the unwritten substring:
my $tmpio = tmpio($self, \($_[1]), $n) or return 0;
sub epwait ($$) {
my ($sock, $ev) = @_;
epoll_ctl($Epoll, EPOLL_CTL_MOD, fileno($sock), $ev) and
- confess("EPOLL_CTL_MOD $!");
+ croak("EPOLL_CTL_MOD($sock): $!");
}
# return true if complete, false if incomplete (or failure)
my $sock = $self->{sock} or return;
return 1 if $sock->accept_SSL;
return $self->close if $! != EAGAIN;
- epwait($sock, PublicInbox::TLS::epollbit() | EPOLLONESHOT);
+ my $ev = PublicInbox::TLS::epollbit() or return $self->close;
+ epwait($sock, $ev | EPOLLONESHOT);
unshift(@{$self->{wbuf}}, \&accept_tls_step); # autovivifies
0;
}
my $sock = $self->{sock} or return;
return $self->close if $sock->stop_SSL(SSL_fast_shutdown => 1);
return $self->close if $! != EAGAIN;
- epwait($sock, PublicInbox::TLS::epollbit() | EPOLLONESHOT);
+ my $ev = PublicInbox::TLS::epollbit() or return $self->close;
+ epwait($sock, $ev | EPOLLONESHOT);
unshift(@{$self->{wbuf}}, \&shutdn_tls_step); # autovivifies
0;
}
}
}
-# must be called with eval, PublicInbox::DS may not be loaded (see t/qspawn.t)
-sub dwaitpid ($$$) {
- die "Not in EventLoop\n" unless $in_loop;
- push @$wait_pids, [ @_ ]; # [ $pid, $cb, $arg ]
+sub zflush {} # overridden by NNTPdeflate and IMAPdeflate
- # We could've just missed our SIGCHLD, cover it, here:
- requeue(\&reap_pids);
-}
+sub long_response_done {} # overridden by Net::NNTP
-sub _run_later () {
- my $run = $later_queue or return;
- $later_timer = $later_queue = undef;
- $_->() for @$run;
-}
-
-sub later ($) {
- push @$later_queue, $_[0]; # autovivifies @$later_queue
- $later_timer //= add_timer(60, \&_run_later);
-}
-
-sub expire_old () {
- my $now = now();
- my $exp = $EXPTIME;
- my $old = $now - $exp;
- my %new;
- while (my ($fd, $idle_at) = each %$EXPMAP) {
- if ($idle_at < $old) {
- my $ds_obj = $DescriptorMap{$fd};
- $new{$fd} = $idle_at if !$ds_obj->shutdn;
- } else {
- $new{$fd} = $idle_at;
- }
+sub long_step {
+ my ($self) = @_;
+ # wbuf is unset or empty, here; {long} may add to it
+ my ($fd, $cb, $t0, @args) = @{$self->{long_cb}};
+ my $more = eval { $cb->($self, @args) };
+ if ($@ || !$self->{sock}) { # something bad happened...
+ delete $self->{long_cb};
+ my $elapsed = now() - $t0;
+ $@ and $self->err("%s during long response[$fd] - %0.6f",
+ $@, $elapsed);
+ $self->out(" deferred[$fd] aborted - %0.6f", $elapsed);
+ $self->close;
+ } elsif ($more) { # $self->{wbuf}:
+ # control passed to ibx_async_cat if $more == \undef
+ requeue_once($self) if !ref($more);
+ } else { # all done!
+ delete $self->{long_cb};
+ $self->long_response_done;
+ my $elapsed = now() - $t0;
+ my $fd = fileno($self->{sock});
+ $self->out(" deferred[$fd] done - %0.6f", $elapsed);
+ my $wbuf = $self->{wbuf}; # do NOT autovivify
+ requeue($self) unless $wbuf && @$wbuf;
}
- $EXPMAP = \%new;
- $exp_timer = scalar(keys %new) ? later(\&expire_old) : undef;
}
-sub update_idle_time {
+sub requeue_once {
my ($self) = @_;
- my $sock = $self->{sock} or return;
- $EXPMAP->{fileno($sock)} = now();
- $exp_timer //= later(\&expire_old);
+ # COMPRESS users all share the same DEFLATE context.
+ # Flush it here to ensure clients don't see each other's data
+ $self->zflush;
+
+ # no recursion, schedule another call ASAP,
+ # but only after all pending writes are done.
+ # autovivify wbuf. wbuf may be populated by $cb,
+ # no need to rearm if so: (push returns new size of array)
+ requeue($self) if push(@{$self->{wbuf}}, \&long_step) == 1;
}
-sub not_idle_long {
- my ($self, $now) = @_;
+sub long_response ($$;@) {
+ my ($self, $cb, @args) = @_; # cb returns true if more, false if done
my $sock = $self->{sock} or return;
- my $idle_at = $EXPMAP->{fileno($sock)} or return;
- ($idle_at + $EXPTIME) > $now;
+ # make sure we disable reading during a long response,
+ # clients should not be sending us stuff and making us do more
+ # work while we are stream a response to them
+ $self->{long_cb} = [ fileno($sock), $cb, now(), @args ];
+ long_step($self); # kick off!
+ undef;
+}
+
+sub dwaitpid ($;$$) {
+ my ($pid, $cb, $arg) = @_;
+ if ($in_loop) {
+ push @$wait_pids, [ $pid, $cb, $arg ];
+ # We could've just missed our SIGCHLD, cover it, here:
+ enqueue_reap();
+ } else {
+ my $ret = waitpid($pid, 0);
+ if ($ret == $pid) {
+ if ($cb) {
+ eval { $cb->($arg, $pid) };
+ carp "E: dwaitpid($pid) !in_loop: $@" if $@;
+ }
+ } else {
+ carp "waitpid($pid, 0) = $ret, \$!=$!, \$?=$?";
+ }
+ }
}
1;