diff options
Diffstat (limited to 'script/lei')
-rwxr-xr-x | script/lei | 144 |
1 files changed, 144 insertions, 0 deletions
diff --git a/script/lei b/script/lei new file mode 100755 index 00000000..087afc33 --- /dev/null +++ b/script/lei @@ -0,0 +1,144 @@ +#!perl -w +# Copyright (C) all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use v5.12; +use Socket qw(AF_UNIX SOCK_SEQPACKET pack_sockaddr_un); +use PublicInbox::CmdIPC4; +my $narg = 5; +my $sock; +my $recv_cmd = PublicInbox::CmdIPC4->can('recv_cmd4'); +my $send_cmd = PublicInbox::CmdIPC4->can('send_cmd4') // do { + require PublicInbox::Syscall; + $recv_cmd = PublicInbox::Syscall->can('recv_cmd4'); + PublicInbox::Syscall->can('send_cmd4'); +} // do { + my $inline_dir = $ENV{PERL_INLINE_DIRECTORY} //= ( + $ENV{XDG_CACHE_HOME} // + ( ($ENV{HOME} // '/nonexistent').'/.cache' ) + ).'/public-inbox/inline-c'; + if (!-d $inline_dir) { + require File::Path; + File::Path::make_path($inline_dir); + } + require PublicInbox::Spawn; # takes ~50ms even if built *sigh* + $recv_cmd = PublicInbox::Spawn->can('recv_cmd4'); + PublicInbox::Spawn->can('send_cmd4'); +} // die 'please install Inline::C or Socket::MsgHdr'; + +my %pids; +my $sigchld = sub { + my $flags = scalar(@_) ? POSIX::WNOHANG() : 0; + for my $pid (keys %pids) { + delete($pids{$pid}) if waitpid($pid, $flags) == $pid; + } +}; +my @parent; +my $exec_cmd = sub { + my ($fds, $argc, @argv) = @_; + my $parent = $$; + require POSIX; + my @old = (*STDIN{IO}, *STDOUT{IO}, *STDERR{IO}); + my @rdr; + for my $fd (@$fds) { + open(my $newfh, '+<&=', $fd) or die "open +<&=$fd: $!"; + push @rdr, shift(@old), $newfh; + } + my $do_exec = sub { + my @non_std; # ex. $op_p from lei_edit_search + while (my ($io, $newfh) = splice(@rdr, 0, 2)) { + my $old_io = !!$io; + open $io, '+<&', $newfh or die "open +<&=: $!"; + push @non_std, $io unless $old_io; + } + if (@non_std) { + require Fcntl; + fcntl($_, Fcntl::F_SETFD(), 0) for @non_std; + } + my %env = map { split(/=/, $_, 2) } splice(@argv, $argc); + @ENV{keys %env} = values %env; + umask 077; + exec(@argv); + warn "exec: @argv: $!\n"; + POSIX::_exit(1); + }; + $SIG{CHLD} = $sigchld; + my $pid = fork // die "fork: $!"; + if ($pid == 0) { + $do_exec->() if $fds->[1]; # git-credential, pager + + # parent backgrounds on MUA + POSIX::setsid() > 0 or die "setsid: $!"; + @parent = ($parent); + return; # continue $recv_cmd in background + } + if ($fds->[1]) { + $pids{$pid} = undef; + } else { + $do_exec->(); # MUA reuses stdout + } +}; + +my $runtime_dir = ($ENV{XDG_RUNTIME_DIR} // '') . '/lei'; +if ($runtime_dir eq '/lei') { + require File::Spec; + $runtime_dir = File::Spec->tmpdir."/lei-$<"; +} +unless (-d $runtime_dir) { + require File::Path; + File::Path::make_path($runtime_dir, { mode => 0700 }); +} +my $path = "$runtime_dir/$narg.seq.sock"; +my $addr = pack_sockaddr_un($path); +socket($sock, AF_UNIX, SOCK_SEQPACKET, 0) or die "socket: $!"; +unless (connect($sock, $addr)) { # start the daemon if not started + local $ENV{PERL5LIB} = join(':', @INC); + open(my $daemon, '-|', $^X, $^W ? ('-w') : (), + qw[-MPublicInbox::LEI -e PublicInbox::LEI::lazy_start(@ARGV)], + $path, $! + 0, $narg) or die "popen: $!"; + while (<$daemon>) { warn $_ } # EOF when STDERR is redirected + close($daemon) or warn <<""; +lei-daemon could not start, exited with \$?=$? + + # try connecting again anyways, unlink+bind may be racy + connect($sock, $addr) or die <<""; +connect($path): $! (after attempted daemon start) + +} +# (Socket::MsgHdr|Inline::C), $sock are all available: +open my $dh, '<', '.' or die "open(.) $!"; +my $buf = join("\0", scalar(@ARGV), @ARGV); +while (my ($k, $v) = each %ENV) { $buf .= "\0$k=$v" } +$buf .= "\0\0"; +$send_cmd->($sock, [0, 1, 2, fileno($dh)], $buf, 0) or die "sendmsg: $!"; +$SIG{TSTP} = sub { send($sock, 'STOP', 0); kill 'STOP', $$ }; +$SIG{CONT} = sub { send($sock, 'CONT', 0) }; + +my $x_it_code = 0; +while (1) { + my (@fds) = $recv_cmd->($sock, my $buf, 4096 * 33); + die "recvmsg: $!" if scalar(@fds) == 1 && !defined($fds[0]); + last if $buf eq ''; + if ($buf =~ /\Aexec (.+)\z/) { + $exec_cmd->(\@fds, split(/\0/, $1)); + } elsif ($buf eq '-WINCH') { + kill($buf, @parent); # for MUA + } elsif ($buf eq 'umask') { + send($sock, 'u'.pack('V', umask), 0) or die "send: $!" + } elsif ($buf =~ /\Ax_it ([0-9]+)\z/) { + $x_it_code ||= $1 + 0; + last; + } elsif ($buf =~ /\Achild_error ([0-9]+)\z/) { + $x_it_code ||= $1 + 0; + } elsif ($buf eq 'wait') { + $sigchld->(); + } else { + $sigchld->(); + die $buf; + } +} +$sigchld->(); +if (my $sig = ($x_it_code & 127)) { + kill $sig, $$; + sleep(1) while 1; # no self-pipe/signalfd, here, so we loop +} +exit($x_it_code >> 8); |