# (tmpio = [ GLOB, offset, [ length ] ])
package PublicInbox::DS;
use strict;
+use v5.10.1;
+use parent qw(Exporter);
use bytes;
use POSIX qw(WNOHANG);
use IO::Handle qw();
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);
+our @EXPORT_OK = qw(now msg_more dwaitpid);
my $nextq; # queue for next_tick
my $wait_pids; # list of [ pid, callback, callback_arg ]
$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
$in_loop,
);
=cut
sub Reset {
+ $in_loop = undef; # first in case DESTROY callbacks use this
%DescriptorMap = ();
- $in_loop = $wait_pids = $later_queue = $reap_armed = undef;
+ $wait_pids = $later_queue = $reap_armed = undef;
$EXPMAP = {};
$nextq = $ToClose = $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;
}
=head2 C<< CLASS->SetLoopTimeout( $timeout ) >>
immediately.
=cut
-sub SetLoopTimeout {
- return $LoopTimeout = $_[1] + 0;
-}
+sub SetLoopTimeout { $LoopTimeout = $_[1] + 0 }
=head2 C<< PublicInbox::DS::add_timer( $seconds, $coderef, $arg) >>
fcntl($_io, F_SETFD, $fl | FD_CLOEXEC);
}
+# caller sets return value to $Epoll
sub _InitPoller
{
- return if $DoneInit;
- $DoneInit = 1;
-
if (PublicInbox::Syscall::epoll_defined()) {
- $Epoll = epoll_create();
- set_cloexec($Epoll) if (defined($Epoll) && $Epoll >= 0);
+ my $fd = epoll_create();
+ set_cloexec($fd) if (defined($fd) && $fd >= 0);
+ $fd;
} else {
my $cls;
for (qw(DSKQXS DSPoll)) {
last if eval "require $cls";
}
$cls->import(qw(epoll_ctl epoll_wait));
- $Epoll = $cls->new;
+ $cls->new;
}
- *EventLoop = *EpollEventLoop;
}
=head2 C<< CLASS->EventLoop() >>
C<PostLoopCallback> below for how to exit the loop.
=cut
-sub FirstTimeEventLoop {
- my $class = shift;
-
- _InitPoller();
-
- EventLoop($class);
-}
sub now () { clock_gettime(CLOCK_MONOTONIC) }
my $timeout = int(($Timers[0][0] - $now) * 1000) + 1;
# -1 is an infinite timeout, so prefer a real timeout
- return $timeout if $LoopTimeout == -1;
-
- # otherwise pick the lower of our regular timeout and time until
- # the next timer
- return $LoopTimeout if $LoopTimeout < $timeout;
- return $timeout;
+ ($LoopTimeout < 0 || $LoopTimeout >= $timeout) ? $timeout : $LoopTimeout;
}
# We can't use waitpid(-1) safely here since it can hit ``, system(),
my $ret = waitpid($pid, WNOHANG);
if ($ret == 0) {
push @$wait_pids, $ary; # autovivifies @$wait_pids
- } elsif ($cb) {
- eval { $cb->($arg, $pid) };
+ } elsif ($ret == $pid) {
+ if ($cb) {
+ eval { $cb->($arg, $pid) };
+ warn "E: dwaitpid($pid) in_loop: $@" if $@;
+ }
+ } else {
+ warn "waitpid($pid, WNOHANG) = $ret, \$!=$!, \$?=$?";
}
}
# we may not be done, yet, and could've missed/masked a SIGCHLD:
}
# reentrant SIGCHLD handler (since reap_pids is not reentrant)
-sub enqueue_reap { $reap_armed //= requeue(\&reap_pids) }
+sub enqueue_reap () { $reap_armed //= requeue(\&reap_pids) }
sub in_loop () { $in_loop }
$PostLoopCallback ? $PostLoopCallback->(\%DescriptorMap) : 1;
}
-sub EpollEventLoop {
+sub EventLoop {
+ $Epoll //= _InitPoller();
local $in_loop = 1;
+ my @events;
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++) {
+ 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.
- $DescriptorMap{$events[$i]->[0]}->event_step;
+ $DescriptorMap{$fd}->event_step;
}
} while (PostEventLoop());
_run_later();
$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 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 {
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;
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 ]
-
- # We could've just missed our SIGCHLD, cover it, here:
- goto &enqueue_reap; # tail recursion
+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, \$!=$!, \$?=$?";
+ }
+ }
}
sub _run_later () {