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;
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;
our $quit = \&CORE::exit;
-my $glp = Getopt::Long::Parser->new;
-$glp->configure(qw(gnu_getopt no_ignore_case auto_abbrev));
+my $GLP = Getopt::Long::Parser->new;
+$GLP->configure(qw(gnu_getopt no_ignore_case auto_abbrev));
+my $GLP_PASS = Getopt::Long::Parser->new;
+$GLP_PASS->configure(qw(gnu_getopt no_ignore_case auto_abbrev pass_through));
+
our %PATH2CFG; # persistent for socket daemon
# TBD: this is a documentation mechanism to show a subcommand
# (may) pass options through to another command:
-sub pass_through { () }
+sub pass_through { $GLP_PASS }
+
+sub _store_path ($) {
+ my ($env) = @_;
+ File::Spec->rel2abs(($env->{XDG_DATA_HOME} //
+ ($env->{HOME} // '/nonexistent').'/.local/share')
+ .'/lei/store', $env->{PWD});
+}
+
+sub _config_path ($) {
+ my ($env) = @_;
+ File::Spec->rel2abs(($env->{XDG_CONFIG_HOME} //
+ ($env->{HOME} // '/nonexistent').'/.config')
+ .'/lei/config', $env->{PWD});
+}
# TODO: generate shell completion + help using %CMD and %OPTDESC
# command => [ positional_args, 1-line description, Getopt::Long option spec ]
qw(stdin| limit|n=i offset=i recursive|r exclude=s include=s !flags),
],
-'config' => [ '[...]', 'git-config(1) wrapper for ~/.config/lei/config',
- pass_through('git config') ],
-'init' => [ '[PATHNAME]',
- 'initialize storage, default: ~/.local/share/lei/store',
- qw(quiet|q) ],
+'config' => [ '[...]', sub {
+ 'git-config(1) wrapper for '._config_path($_[0]);
+ }, qw(config-file|system|global|file|f=s), # for conflict detection
+ pass_through('git config') ],
+'init' => [ '[PATHNAME]', sub {
+ 'initialize storage, default: '._store_path($_[0]);
+ }, qw(quiet|q) ],
'daemon-stop' => [ '', 'stop the lei-daemon' ],
'daemon-pid' => [ '', 'show the PID of the lei-daemon' ],
'daemon-env' => [ '[NAME=VALUE...]', 'set, unset, or show daemon environment',
'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
'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);
}
}
+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->($self->{env}) if ref($cmd_desc) eq 'CODE';
my @opt_desc;
my $lpad = 2;
- for my $sw (@info) { # qw(prio=s
+ for my $sw (grep { !ref } @info) { # ("prio=s", "z", $GLP_PASS)
my $desc = $OPTDESC{"$cmd\t$sw"} // $OPTDESC{$sw} // next;
my $arg_vals = '';
($arg_vals, $desc) = @$desc if ref($desc) eq 'ARRAY';
$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 $info = $CMD{$cmd} // [ '[...]', '(undocumented command)' ];
- my ($proto, $desc, @spec) = @$info;
+ 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
push @spec, qw(help|h);
my $lone_dash;
if ($spec[0] =~ s/\|\z//s) { # "stdin|" or "clear|" allows "-" alias
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;
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);
+ $GLP->getoptionsfromarray([$cmd, @argv], $opt, qw(help|h)) or
+ 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 $env = $client->{env};
- my $cfg_dir = File::Spec->canonpath(( $env->{XDG_CONFIG_HOME} //
- ($env->{HOME} // '/nonexistent').'/.config').'/lei');
- my $f = "$cfg_dir/config";
+ 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);
-d $cfg_dir or mkpath($cfg_dir) or die "mkpath($cfg_dir): $!\n";
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");
+ 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();
}
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) = @_;
- my $env = $client->{env};
- if (defined $env->{GIT_CONFIG}) {
- my %copy = %$env;
- delete $copy{GIT_CONFIG};
- $env = \%copy;
- }
- if (my @conflict = (grep(/\A-f=?\z/, @argv),
- grep(/\A--(?:global|system|
- file|config-file)=?\z/x, @argv))) {
- return fail($client, "@conflict not supported by lei config");
- }
- my $cfg = _lei_cfg($client, 1);
+ my ($self, @argv) = @_;
+ $self->{opt}->{'config-file'} and return fail $self,
+ "config file switches not supported by `lei config'";
+ my $env = $self->{env};
+ delete local $env->{GIT_CONFIG};
+ 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};
- $dir //= ( $env->{XDG_DATA_HOME} //
- ($env->{HOME} // '/nonexistent').'/.local/share'
- ) . '/lei/store';
+ 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);
$cur = File::Spec->canonpath($cur) if $cur;
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") }
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}) {
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) {
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;
};
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
# 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,
}
$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);
}
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;