httpd|nntpd: avoid missed signal wakeups

Our attempt at using a self-pipe in signal handlers was
ineffective, since pure Perl code execution is deferred
and Perl doesn't use an internal self-pipe/eventfd.  In
retrospect, I actually prefer the simplicity of Perl in
this regard...

We can use sigprocmask() from Perl, so we can introduce
signalfd(2) and EVFILT_SIGNAL support on Linux and *BSD-based
systems, respectively.  These OS primitives allow us to avoid a
race where Perl checks for signals right before epoll_wait() or
kevent() puts the process to sleep.

The (few) systems nowadays without signalfd(2) or IO::KQueue
will now see wakeups every second to avoid missed signals.

1 files changed, 84 insertions, 19 deletions

diff --git a/lib/PublicInbox/DSKQXS.pm b/lib/PublicInbox/DSKQXS.pm
index 84e146f8..a56079e2 100644
--- a/lib/PublicInbox/DSKQXS.pm
+++ b/lib/PublicInbox/DSKQXS.pm
@@ -8,18 +8,20 @@
 # like epoll to simplify the code in DS.pm.  This is NOT meant to be
 # an all encompassing emulation of epoll via IO::KQueue, but just to
 # support cases public-inbox-nntpd/httpd care about.
-# A pure-Perl version using syscall() is planned, and it should be
-# faster due to the lack of syscall overhead.
+#
+# It also implements signalfd(2) emulation via "tie".
+#
+# A pure-Perl version using syscall() is planned.
 package PublicInbox::DSKQXS;
 use strict;
 use warnings;
-use parent qw(IO::KQueue);
 use parent qw(Exporter);
+use Symbol qw(gensym);
 use IO::KQueue;
+use Errno qw(EAGAIN);
 use PublicInbox::Syscall qw(EPOLLONESHOT EPOLLIN EPOLLOUT EPOLLET
-        EPOLL_CTL_ADD EPOLL_CTL_MOD EPOLL_CTL_DEL);
+        EPOLL_CTL_ADD EPOLL_CTL_MOD EPOLL_CTL_DEL SFD_NONBLOCK);
 our @EXPORT_OK = qw(epoll_ctl epoll_wait);
-my $owner_pid = -1; # kqueue is close-on-fork (yes, fork, not exec)
 
 sub EV_DISPATCH () { 0x0080 }
 
@@ -41,29 +43,90 @@ sub kq_flag ($$) {
 
 sub new {
         my ($class) = @_;
-        die 'non-singleton use not supported' if $owner_pid == $$;
-        $owner_pid = $$;
-        $class->SUPER::new;
+        bless { kq => IO::KQueue->new, owner_pid => $$ }, $class;
+}
+
+# returns a new instance which behaves like signalfd on Linux.
+# It's wasteful in that it uses another FD, but it simplifies
+# our epoll-oriented code.
+sub signalfd {
+        my ($class, $signo, $flags) = @_;
+        my $sym = gensym;
+        tie *$sym, $class, $signo, $flags; # calls TIEHANDLE
+        $sym
+}
+
+sub TIEHANDLE { # similar to signalfd()
+        my ($class, $signo, $flags) = @_;
+        my $self = $class->new;
+        $self->{timeout} = ($flags & SFD_NONBLOCK) ? 0 : -1;
+        my $kq = $self->{kq};
+        $kq->EV_SET($_, EVFILT_SIGNAL, EV_ADD) for @$signo;
+        $self;
+}
+
+sub READ { # called by sysread() for signalfd compatibility
+        my ($self, undef, $len, $off) = @_; # $_[1] = buf
+        die "bad args for signalfd read" if ($len % 128) // defined($off);
+        my $timeout = $self->{timeout};
+        my $sigbuf = $self->{sigbuf} //= [];
+        my $nr = $len / 128;
+        my $r = 0;
+        $_[1] = '';
+        do {
+                while ($nr--) {
+                        my $signo = shift(@$sigbuf) or last;
+                        # caller only cares about signalfd_siginfo.ssi_signo:
+                        $_[1] .= pack('L', $signo) . ("\0" x 124);
+                        $r += 128;
+                }
+                return $r if $r;
+                my @events = eval { $self->{kq}->kevent($timeout) };
+                # workaround https://rt.cpan.org/Ticket/Display.html?id=116615
+                if ($@) {
+                        next if $@ =~ /Interrupted system call/;
+                        die;
+                }
+                if (!scalar(@events) && $timeout == 0) {
+                        $! = EAGAIN;
+                        return;
+                }
+
+                # Grab the kevent.ident (signal number).  The kevent.data
+                # field shows coalesced signals, and maybe we'll use it
+                # in the future...
+                @$sigbuf = map { $_->[0] } @events;
+        } while (1);
 }
 
+# for fileno() calls in PublicInbox::DS
+sub FILENO { ${$_[0]->{kq}} }
+
 sub epoll_ctl {
         my ($self, $op, $fd, $ev) = @_;
+        my $kq = $self->{kq};
         if ($op == EPOLL_CTL_MOD) {
-                $self->EV_SET($fd, EVFILT_READ, kq_flag(EPOLLIN, $ev));
-                $self->EV_SET($fd, EVFILT_WRITE, kq_flag(EPOLLOUT, $ev));
+                $kq->EV_SET($fd, EVFILT_READ, kq_flag(EPOLLIN, $ev));
+                $kq->EV_SET($fd, EVFILT_WRITE, kq_flag(EPOLLOUT, $ev));
         } elsif ($op == EPOLL_CTL_DEL) {
-                $self->EV_SET($fd, EVFILT_READ, EV_DISABLE);
-                $self->EV_SET($fd, EVFILT_WRITE, EV_DISABLE);
-        } else {
-                $self->EV_SET($fd, EVFILT_READ, EV_ADD|kq_flag(EPOLLIN, $ev));
-                $self->EV_SET($fd, EVFILT_WRITE, EV_ADD|kq_flag(EPOLLOUT, $ev));
+                $kq->EV_SET($fd, EVFILT_READ, EV_DISABLE);
+                $kq->EV_SET($fd, EVFILT_WRITE, EV_DISABLE);
+        } else { # EPOLL_CTL_ADD
+                $kq->EV_SET($fd, EVFILT_READ, EV_ADD|kq_flag(EPOLLIN, $ev));
+
+                # we call this blindly for read-only FDs such as tied
+                # DSKQXS (signalfd emulation) and Listeners
+                eval {
+                        $kq->EV_SET($fd, EVFILT_WRITE, EV_ADD |
+                                                        kq_flag(EPOLLOUT, $ev));
+                };
         }
         0;
 }
 
 sub epoll_wait {
         my ($self, $maxevents, $timeout_msec, $events) = @_;
-        @$events = eval { $self->kevent($timeout_msec) };
+        @$events = eval { $self->{kq}->kevent($timeout_msec) };
         if (my $err = $@) {
                 # workaround https://rt.cpan.org/Ticket/Display.html?id=116615
                 if ($err =~ /Interrupted system call/) {
@@ -76,11 +139,13 @@ sub epoll_wait {
         scalar(@$events);
 }
 
+# kqueue is close-on-fork (not exec), so we must not close it
+# in forked processes:
 sub DESTROY {
         my ($self) = @_;
-        if ($owner_pid == $$) {
-                POSIX::close($$self);
-                $owner_pid = -1;
+        my $kq = delete $self->{kq} or return;
+        if (delete($self->{owner_pid}) == $$) {
+                POSIX::close($$kq);
         }
 }