X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FLEI.pm;h=7004e9d72ed634dddf3dff99fd1b9b8024870c61;hb=2fe6af26d737773e0a7cafa5902360ab1309c807;hp=667ef7659400dc6d6b9babdcfcff4f549c1a3a69;hpb=553cb0506c798bc27494294107a0d9e45d5011f5;p=public-inbox.git diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index 667ef765..7004e9d7 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -10,9 +10,9 @@ use strict; use v5.10.1; use parent qw(PublicInbox::DS); use Getopt::Long (); +use Socket qw(AF_UNIX SOCK_STREAM pack_sockaddr_un); use Errno qw(EAGAIN ECONNREFUSED ENOENT); -use POSIX qw(setsid); -use IO::Socket::UNIX; +use POSIX (); use IO::Handle (); use Sys::Syslog qw(syslog openlog); use PublicInbox::Config; @@ -20,6 +20,7 @@ use PublicInbox::Syscall qw($SFD_NONBLOCK EPOLLIN EPOLLONESHOT); use PublicInbox::Sigfd; use PublicInbox::DS qw(now); use PublicInbox::Spawn qw(spawn); +use PublicInbox::OnDestroy; use Text::Wrap qw(wrap); use File::Path qw(mkpath); use File::Spec; @@ -131,7 +132,11 @@ our %CMD = ( # sorted in order of importance/use: 'reorder-local-store-and-break-history' => [ '[REFNAME]', 'rewrite git history in an attempt to improve compression', - 'gc!' ] + 'gc!' ], + +# internal commands are prefixed with '_' +'_complete' => [ '[...]', 'internal shell completion helper', + pass_through('everything') ], ); # @CMD # switch descriptions, try to keep consistent across commands @@ -208,13 +213,17 @@ my %OPTDESC = ( 'unset matching NAME, may be specified multiple times'], ); # %OPTDESC +my %CONFIG_KEYS = ( + 'leistore.dir' => 'top-level storage location', +); + sub x_it ($$) { # pronounced "exit" - my ($client, $code) = @_; + my ($self, $code) = @_; if (my $sig = ($code & 127)) { - kill($sig, $client->{pid} // $$); + kill($sig, $self->{pid} // $$); } else { $code >>= 8; - if (my $sock = $client->{sock}) { + if (my $sock = $self->{sock}) { say $sock "exit=$code"; } else { # for oneshot $quit->($code); @@ -222,33 +231,35 @@ sub x_it ($$) { # pronounced "exit" } } +sub puts ($;@) { print { shift->{1} } map { "$_\n" } @_ } + sub emit { - my ($client, $channel) = @_; # $buf = $_[2] - print { $client->{$channel} } $_[2] or die "print FD[$channel]: $!"; + my ($self, $channel) = @_; # $buf = $_[2] + print { $self->{$channel} } $_[2] or die "print FD[$channel]: $!"; } sub err { - my ($client, $buf) = @_; + my ($self, $buf) = @_; $buf .= "\n" unless $buf =~ /\n\z/s; - emit($client, 2, $buf); + emit($self, 2, $buf); } sub qerr { $_[0]->{opt}->{quiet} or err(@_) } sub fail ($$;$) { - my ($client, $buf, $exit_code) = @_; - err($client, $buf); - x_it($client, ($exit_code // 1) << 8); + my ($self, $buf, $exit_code) = @_; + err($self, $buf); + x_it($self, ($exit_code // 1) << 8); undef; } sub _help ($;$) { - my ($client, $errmsg) = @_; - my $cmd = $client->{cmd} // 'COMMAND'; + my ($self, $errmsg) = @_; + my $cmd = $self->{cmd} // 'COMMAND'; my @info = @{$CMD{$cmd} // [ '...', '...' ]}; my @top = ($cmd, shift(@info) // ()); my $cmd_desc = shift(@info); - $cmd_desc = $cmd_desc->($client->{env}) if ref($cmd_desc) eq 'CODE'; + $cmd_desc = $cmd_desc->($self->{env}) if ref($cmd_desc) eq 'CODE'; my @opt_desc; my $lpad = 2; for my $sw (grep { !ref } @info) { # ("prio=s", "z", $GLP_PASS) @@ -314,15 +325,15 @@ EOF $msg .= "\n"; } my $channel = $errmsg ? 2 : 1; - emit($client, $channel, $msg); - x_it($client, $errmsg ? 1 << 8 : 0); # stderr => failure + emit($self, $channel, $msg); + x_it($self, $errmsg ? 1 << 8 : 0); # stderr => failure undef; } sub optparse ($$$) { - my ($client, $cmd, $argv) = @_; - $client->{cmd} = $cmd; - my $opt = $client->{opt} = {}; + my ($self, $cmd, $argv) = @_; + $self->{cmd} = $cmd; + my $opt = $self->{opt} = {}; my $info = $CMD{$cmd} // [ '[...]' ]; my ($proto, undef, @spec) = @$info; my $glp = ref($spec[-1]) ? pop(@spec) : $GLP; # or $GLP_PASS @@ -334,8 +345,8 @@ sub optparse ($$$) { push @spec, '' => \$var; } $glp->getoptionsfromarray($argv, $opt, @spec) or - return _help($client, "bad arguments or options for $cmd"); - return _help($client) if $opt->{help}; + return _help($self, "bad arguments or options for $cmd"); + return _help($self) if $opt->{help}; # "-" aliases "stdin" or "clear" $opt->{$lone_dash} = ${$opt->{$lone_dash}} if defined $lone_dash; @@ -380,40 +391,39 @@ sub optparse ($$$) { if (!$inf && scalar(@$argv) > scalar(@args)) { $err //= 'too many arguments'; } - $err ? fail($client, "usage: lei $cmd $proto\nE: $err") : 1; + $err ? fail($self, "usage: lei $cmd $proto\nE: $err") : 1; } sub dispatch { - my ($client, $cmd, @argv) = @_; - local $SIG{__WARN__} = sub { err($client, "@_") }; - local $SIG{__DIE__} = 'DEFAULT'; - return _help($client, 'no command given') unless defined($cmd); + my ($self, $cmd, @argv) = @_; + local $SIG{__WARN__} = sub { err($self, "@_") }; + return _help($self, 'no command given') unless defined($cmd); my $func = "lei_$cmd"; $func =~ tr/-/_/; if (my $cb = __PACKAGE__->can($func)) { - optparse($client, $cmd, \@argv) or return; - $cb->($client, @argv); + optparse($self, $cmd, \@argv) or return; + $cb->($self, @argv); } elsif (grep(/\A-/, $cmd, @argv)) { # --help or -h only my $opt = {}; $GLP->getoptionsfromarray([$cmd, @argv], $opt, qw(help|h)) or - return _help($client, 'bad arguments or options'); - _help($client); + return _help($self, 'bad arguments or options'); + _help($self); } else { - fail($client, "`$cmd' is not an lei command"); + fail($self, "`$cmd' is not an lei command"); } } sub _lei_cfg ($;$) { - my ($client, $creat) = @_; - my $f = _config_path($client->{env}); + my ($self, $creat) = @_; + my $f = _config_path($self->{env}); my @st = stat($f); my $cur_st = @st ? pack('dd', $st[10], $st[7]) : ''; # 10:ctime, 7:size if (my $cfg = $PATH2CFG{$f}) { # reuse existing object in common case - return ($client->{cfg} = $cfg) if $cur_st eq $cfg->{-st}; + return ($self->{cfg} = $cfg) if $cur_st eq $cfg->{-st}; } if (!@st) { unless ($creat) { - delete $client->{cfg}; + delete $self->{cfg}; return; } my (undef, $cfg_dir, undef) = File::Spec->splitpath($f); @@ -421,17 +431,17 @@ sub _lei_cfg ($;$) { open my $fh, '>>', $f or die "open($f): $!\n"; @st = stat($fh) or die "fstat($f): $!\n"; $cur_st = pack('dd', $st[10], $st[7]); - qerr($client, "I: $f created") if $client->{cmd} ne 'config'; + qerr($self, "I: $f created") if $self->{cmd} ne 'config'; } my $cfg = PublicInbox::Config::git_config_dump($f); $cfg->{-st} = $cur_st; $cfg->{'-f'} = $f; - $client->{cfg} = $PATH2CFG{$f} = $cfg; + $self->{cfg} = $PATH2CFG{$f} = $cfg; } sub _lei_store ($;$) { - my ($client, $creat) = @_; - my $cfg = _lei_cfg($client, $creat); + my ($self, $creat) = @_; + my $cfg = _lei_cfg($self, $creat); $cfg->{-lei_store} //= do { require PublicInbox::LeiStore; PublicInbox::SearchIdx::load_xapian_writable(); @@ -441,35 +451,35 @@ sub _lei_store ($;$) { } sub lei_show { - my ($client, @argv) = @_; + my ($self, @argv) = @_; } sub lei_query { - my ($client, @argv) = @_; + my ($self, @argv) = @_; } sub lei_mark { - my ($client, @argv) = @_; + my ($self, @argv) = @_; } sub lei_config { - my ($client, @argv) = @_; - $client->{opt}->{'config-file'} and return fail $client, + my ($self, @argv) = @_; + $self->{opt}->{'config-file'} and return fail $self, "config file switches not supported by `lei config'"; - my $env = $client->{env}; + my $env = $self->{env}; delete local $env->{GIT_CONFIG}; - my $cfg = _lei_cfg($client, 1); + my $cfg = _lei_cfg($self, 1); my $cmd = [ qw(git config -f), $cfg->{'-f'}, @argv ]; - my %rdr = map { $_ => $client->{$_} } (0..2); + my %rdr = map { $_ => $self->{$_} } (0..2); require PublicInbox::Import; PublicInbox::Import::run_die($cmd, $env, \%rdr); } sub lei_init { - my ($client, $dir) = @_; - my $cfg = _lei_cfg($client, 1); + my ($self, $dir) = @_; + my $cfg = _lei_cfg($self, 1); my $cur = $cfg->{'leistore.dir'}; - my $env = $client->{env}; + my $env = $self->{env}; $dir //= _store_path($env); $dir = File::Spec->rel2abs($dir, $env->{PWD}); # PWD is symlink-aware my @cur = stat($cur) if defined($cur); @@ -478,24 +488,24 @@ sub lei_init { my $exists = "I: leistore.dir=$cur already initialized" if @dir; if (@cur) { if ($cur eq $dir) { - _lei_store($client, 1)->done; - return qerr($client, $exists); + _lei_store($self, 1)->done; + return qerr($self, $exists); } # some folks like symlinks and bind mounts :P if (@dir && "$cur[0] $cur[1]" eq "$dir[0] $dir[1]") { - lei_config($client, 'leistore.dir', $dir); - _lei_store($client, 1)->done; - return qerr($client, "$exists (as $cur)"); + lei_config($self, 'leistore.dir', $dir); + _lei_store($self, 1)->done; + return qerr($self, "$exists (as $cur)"); } - return fail($client, <<""); + return fail($self, <<""); E: leistore.dir=$cur already initialized and it is not $dir } - lei_config($client, 'leistore.dir', $dir); - _lei_store($client, 1)->done; + lei_config($self, 'leistore.dir', $dir); + _lei_store($self, 1)->done; $exists //= "I: leistore.dir=$dir newly initialized"; - return qerr($client, $exists); + return qerr($self, $exists); } sub lei_daemon_pid { emit($_[0], 1, "$$\n") } @@ -503,8 +513,8 @@ sub lei_daemon_pid { emit($_[0], 1, "$$\n") } sub lei_daemon_stop { $quit->(0) } sub lei_daemon_env { - my ($client, @argv) = @_; - my $opt = $client->{opt}; + my ($self, @argv) = @_; + my $opt = $self->{opt}; if (defined $opt->{clear}) { %ENV = (); } elsif (my $u = $opt->{unset}) { @@ -516,29 +526,78 @@ sub lei_daemon_env { my $eor = $opt->{z} ? "\0" : "\n"; my $buf = ''; while (my ($k, $v) = each %ENV) { $buf .= "$k=$v$eor" } - emit($client, 1, $buf) + emit($self, 1, $buf) } } sub lei_help { _help($_[0]) } +# Shell completion helper. Used by lei-completion.bash and hopefully +# other shells. Try to do as much here as possible to avoid redundancy +# and improve maintainability. +sub lei__complete { + my ($self, @argv) = @_; # argv = qw(lei and any other args...) + shift @argv; # ignore "lei", the entire command is sent + @argv or return puts $self, grep(!/^_/, keys %CMD); + my $cmd = shift @argv; + my $info = $CMD{$cmd} // do { # filter matching commands + @argv or puts $self, grep(/\A\Q$cmd\E/, keys %CMD); + return; + }; + my ($proto, undef, @spec) = @$info; + my $cur = pop @argv; + my $re = defined($cur) ? qr/\A\Q$cur\E/ : qr/./; + if (substr($cur // '-', 0, 1) eq '-') { # --switches + # gross special case since the only git-config options + # Consider moving to a table if we need more special cases + # we use Getopt::Long for are the ones we reject, so these + # are the ones we don't reject: + if ($cmd eq 'config') { + puts $self, grep(/$re/, keys %CONFIG_KEYS); + @spec = qw(add z|null get get-all unset unset-all + replace-all get-urlmatch + remove-section rename-section + name-only list|l edit|e + get-color-name get-colorbool); + # fall-through + } + # TODO: arg support + puts $self, grep(/$re/, map { # generate short/long names + my $eq = ''; + if (s/=.+\z//) { # required arg, e.g. output|o=i + $eq = '='; + } elsif (s/:.+\z//) { # optional arg, e.g. mid:s + } else { # negation: solve! => no-solve|solve + s/\A(.+)!\z/no-$1|$1/; + } + map { + length > 1 ? "--$_$eq" : "-$_" + } split(/\|/, $_, -1) # help|h + } grep { !ref } @spec); # filter out $GLP_PASS ref + } elsif ($cmd eq 'config' && !@argv && !$CONFIG_KEYS{$cur}) { + puts $self, grep(/$re/, keys %CONFIG_KEYS); + } + # TODO: URLs, pathnames, OIDs, MIDs, etc... See optparse() for + # proto parsing. +} + sub reap_exec { # dwaitpid callback - my ($client, $pid) = @_; - x_it($client, $?); + my ($self, $pid) = @_; + x_it($self, $?); } sub lei_git { # support passing through random git commands - my ($client, @argv) = @_; - my %rdr = map { $_ => $client->{$_} } (0..2); - my $pid = spawn(['git', @argv], $client->{env}, \%rdr); - PublicInbox::DS::dwaitpid($pid, \&reap_exec, $client); + my ($self, @argv) = @_; + my %rdr = map { $_ => $self->{$_} } (0..2); + my $pid = spawn(['git', @argv], $self->{env}, \%rdr); + PublicInbox::DS::dwaitpid($pid, \&reap_exec, $self); } sub accept_dispatch { # Listener {post_accept} callback my ($sock) = @_; # ignore other $sock->blocking(1); $sock->autoflush(1); - my $client = { sock => $sock }; + my $self = bless { sock => $sock }, __PACKAGE__; vec(my $rin = '', fileno($sock), 1) = 1; # `say $sock' triggers "die" in lei(1) for my $i (0..2) { @@ -547,7 +606,7 @@ sub accept_dispatch { # Listener {post_accept} callback if ($fd >= 0) { my $rdr = ($fd == 0 ? '<&=' : '>&='); if (open(my $fh, $rdr, $fd)) { - $client->{$i} = $fh; + $self->{$i} = $fh; } else { say $sock "open($rdr$fd) (FD=$i): $!"; return; @@ -571,9 +630,9 @@ sub accept_dispatch { # Listener {post_accept} callback }; my %env = map { split(/=/, $_, 2) } split(/\0/, $env); if (chdir($env{PWD})) { - $client->{env} = \%env; - $client->{pid} = $client_pid; - eval { dispatch($client, split(/\]\0\[/, $argv)) }; + $self->{env} = \%env; + $self->{pid} = $client_pid; + eval { dispatch($self, split(/\]\0\[/, $argv)) }; say $sock $@ if $@; } else { say $sock "chdir($env{PWD}): $!"; # implicit close @@ -584,58 +643,44 @@ sub noop {} # lei(1) calls this when it can't connect sub lazy_start { - my ($path, $err) = @_; - if ($err == ECONNREFUSED) { + my ($path, $errno) = @_; + if ($errno == ECONNREFUSED) { unlink($path) or die "unlink($path): $!"; - } elsif ($err != ENOENT) { + } elsif ($errno != ENOENT) { + $! = $errno; # allow interpolation to stringify in die die "connect($path): $!"; } - require IO::FDPass; umask(077) // die("umask(077): $!"); - my $l = IO::Socket::UNIX->new(Local => $path, - Listen => 1024, - Type => SOCK_STREAM) or - $err = $!; - $l or return die "bind($path): $err"; + socket(my $l, AF_UNIX, SOCK_STREAM, 0) or die "socket: $!"; + bind($l, pack_sockaddr_un($path)) or die "bind($path): $!"; + listen($l, 1024) or die "listen: $!"; my @st = stat($path) or die "stat($path): $!"; my $dev_ino_expect = pack('dd', $st[0], $st[1]); # dev+ino pipe(my ($eof_r, $eof_w)) or die "pipe: $!"; my $oldset = PublicInbox::Sigfd::block_signals(); + require IO::FDPass; + require PublicInbox::Listener; + require PublicInbox::EOFpipe; + (-p STDOUT && -p STDERR) or die "E: stdout+stderr must be pipes\n"; + open(STDIN, '+<', '/dev/null') or die "redirect stdin failed: $!"; + POSIX::setsid() > 0 or die "setsid: $!"; my $pid = fork // die "fork: $!"; return if $pid; - openlog($path, 'pid', 'user'); - local $SIG{__DIE__} = sub { - syslog('crit', "@_"); - exit $! if $!; - exit $? >> 8 if $? >> 8; - exit 255; - }; - local $SIG{__WARN__} = sub { syslog('warning', "@_") }; - open(STDIN, '+<', '/dev/null') or die "redirect stdin failed: $!\n"; - open STDOUT, '>&STDIN' or die "redirect stdout failed: $!\n"; - open STDERR, '>&STDIN' or die "redirect stderr failed: $!\n"; - setsid(); - $pid = fork // die "fork: $!"; - return if $pid; $0 = "lei-daemon $path"; local %PATH2CFG; - require PublicInbox::Listener; - require PublicInbox::EOFpipe; - $l->blocking(0); - $eof_w->blocking(0); - $eof_r->blocking(0); - my $listener = PublicInbox::Listener->new($l, \&accept_dispatch, $l); + $_->blocking(0) for ($l, $eof_r, $eof_w); + $l = PublicInbox::Listener->new($l, \&accept_dispatch, $l); my $exit_code; local $quit = sub { $exit_code //= shift; - my $tmp = $listener or exit($exit_code); + my $listener = $l or exit($exit_code); unlink($path) if defined($path); - syswrite($eof_w, '.'); - $l = $listener = $path = undef; - $tmp->close if $tmp; # DS::close + # closing eof_w triggers \&noop wakeup + $eof_w = $l = $path = undef; + $listener->close; # DS::close PublicInbox::DS->SetLoopTimeout(1000); }; - PublicInbox::EOFpipe->new($eof_r, sub {}, undef); + PublicInbox::EOFpipe->new($eof_r, \&noop, undef); my $sig = { CHLD => \&PublicInbox::DS::enqueue_reap, QUIT => $quit, @@ -680,7 +725,21 @@ sub lazy_start { } $n; # true: continue, false: stop }); + + # STDIN was redirected to /dev/null above, closing STDOUT and + # STDERR will cause the calling `lei' client process to finish + # reading <$daemon> pipe. + open STDOUT, '>&STDIN' or die "redirect stdout failed: $!"; + openlog($path, 'pid', 'user'); + local $SIG{__WARN__} = sub { syslog('warning', "@_") }; + my $owner_pid = $$; + my $on_destroy = PublicInbox::OnDestroy->new(sub { + syslog('crit', "$@") if $@ && $$ == $owner_pid; + }); + open STDERR, '>&STDIN' or die "redirect stderr failed: $!"; + # $daemon pipe to `lei' closed, main loop begins: PublicInbox::DS->EventLoop; + @$on_destroy = (); # cancel on_destroy if we get here exit($exit_code // 0); } @@ -691,12 +750,12 @@ sub oneshot { local $quit = $exit if $exit; local %PATH2CFG; umask(077) // die("umask(077): $!"); - dispatch({ + dispatch((bless { 0 => *STDIN{IO}, 1 => *STDOUT{IO}, 2 => *STDERR{IO}, env => \%ENV - }, @ARGV); + }, __PACKAGE__), @ARGV); } 1;