diff options
Diffstat (limited to 'lib/PublicInbox/LEI.pm')
-rw-r--r-- | lib/PublicInbox/LEI.pm | 56 |
1 files changed, 34 insertions, 22 deletions
diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index ceba16e4..b915bb0c 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -12,7 +12,7 @@ use parent qw(PublicInbox::DS PublicInbox::LeiExternal PublicInbox::LeiQuery); use Getopt::Long (); use Socket qw(AF_UNIX SOCK_SEQPACKET MSG_EOR pack_sockaddr_un); -use Errno qw(EAGAIN EINTR ECONNREFUSED ENOENT ECONNRESET); +use Errno qw(EPIPE EAGAIN EINTR ECONNREFUSED ENOENT ECONNRESET); use Cwd qw(getcwd); use POSIX (); use IO::Handle (); @@ -277,7 +277,11 @@ sub x_it ($$) { dump_and_clear_log(); if (my $sock = $self->{sock}) { send($sock, "x_it $code", MSG_EOR); - } elsif (!($code & 127)) { # oneshot, ignore signals + } elsif (my $signum = ($code & 127)) { # oneshot, usually SIGPIPE (13) + $SIG{PIPE} = 'DEFAULT'; # $SIG{$signum} doesn't work + kill $signum, $$; + sleep; # wait for signal + } else { # oneshot # don't want to end up using $? from child processes for my $f (qw(lxs l2m)) { my $wq = delete $self->{$f} or next; @@ -287,14 +291,15 @@ sub x_it ($$) { } } -sub puts ($;@) { print { shift->{1} } map { "$_\n" } @_ } - -sub out ($;@) { print { shift->{1} } @_ } - sub err ($;@) { my $self = shift; - my $err = $self->{2} // ($self->{pgr} // [])->[2] // *STDERR{IO}; - print $err @_, (substr($_[-1], -1, 1) eq "\n" ? () : "\n"); + my $err = $self->{2} // ($self->{pgr} // [])->[2] // *STDERR{GLOB}; + my $eor = (substr($_[-1], -1, 1) eq "\n" ? () : "\n"); + print $err @_, $eor and return; + my $old_err = delete $self->{2}; + close($old_err) if $! == EPIPE && $old_err;; + $err = $self->{2} = ($self->{pgr} // [])->[2] // *STDERR{GLOB}; + print $err @_, $eor or print STDERR @_, $eor; } sub qerr ($;@) { $_[0]->{opt}->{quiet} or err(shift, @_) } @@ -306,6 +311,17 @@ sub fail ($$;$) { undef; } +sub out ($;@) { + my $self = shift; + return if print { $self->{1} // return } @_; # likely + return note_sigpipe($self, 1) if $! == EPIPE; + my $err = "error writing to stdout: $!"; + delete $self->{1}; + fail($self, $err); +} + +sub puts ($;@) { out(shift, map { "$_\n" } @_) } + sub child_error { # passes non-fatal curl exit codes to user my ($self, $child_error) = @_; # child_error is $? if (my $sock = $self->{sock}) { # send to lei(1) client @@ -350,27 +366,23 @@ sub io_restore ($$) { } } -# usage: my %sig = $lei->atfork_child_wq($wq); -# local @SIG{keys %sig} = values %sig; +# triggers sigpipe_handler +sub note_sigpipe { + my ($self, $fd) = @_; + close(delete($self->{$fd})); # explicit close silences Perl warning + syswrite($self->{op_pipe}, '!') if $self->{op_pipe}; + x_it($self, 13); +} + sub atfork_child_wq { my ($self, $wq) = @_; io_restore($self, $wq); + -p $self->{op_pipe} or die 'BUG: {op_pipe} expected'; io_restore($self->{l2m}, $wq); %PATH2CFG = (); undef $errors_log; $quit = \&CORE::exit; - (PIPE => sub { - $self->x_it(13); # SIGPIPE = 13 - # we need to close explicitly to avoid Perl warning on SIGPIPE - for my $i (1, 2) { - next unless $self->{$i} && (-p $self->{$i} || -S _); - close(delete $self->{$i}); - } - # trigger the LeiXSearch $done OpPipe: - syswrite($self->{op_pipe}, '!') if $self->{op_pipe}; - $SIG{PIPE} = 'DEFAULT'; - die bless(\"$_[0]", 'PublicInbox::SIGPIPE'), - }); + $current_lei = $self; # for SIG{__WARN__} } sub io_extract ($;@) { |