-# Copyright (C) 2020 all contributors <meta@public-inbox.org>
+# Copyright (C) 2020-2021 all contributors <meta@public-inbox.org>
# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
# Backend for `lei' (local email interface). Unlike the C10K-oriented
package PublicInbox::LEI;
use strict;
use v5.10.1;
-use parent qw(PublicInbox::DS);
+use parent qw(PublicInbox::DS PublicInbox::LeiExternal);
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::Syscall qw($SFD_NONBLOCK EPOLLIN EPOLLONESHOT);
+use PublicInbox::Syscall qw(SFD_NONBLOCK EPOLLIN EPOLLONESHOT);
use PublicInbox::Sigfd;
-use PublicInbox::DS qw(now);
-use PublicInbox::Spawn qw(spawn);
+use PublicInbox::DS qw(now dwaitpid);
+use PublicInbox::Spawn qw(spawn run_die);
+use PublicInbox::OnDestroy;
use Text::Wrap qw(wrap);
use File::Path qw(mkpath);
use File::Spec;
# (may) pass options through to another command:
sub pass_through { $GLP_PASS }
+my $OPT;
+sub opt_dash {
+ my ($spec, $re_str) = @_; # 'limit|n=i', '([0-9]+)'
+ my ($key) = ($spec =~ m/\A([a-z]+)/g);
+ my $cb = sub { # Getopt::Long "<>" catch-all handler
+ my ($arg) = @_;
+ if ($arg =~ /\A-($re_str)\z/) {
+ $OPT->{$key} = $1;
+ } else {
+ die "bad argument for --$key: $arg\n";
+ }
+ };
+ ($spec, '<>' => $cb, $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 ]
our %CMD = ( # sorted in order of importance/use:
-'query' => [ 'SEARCH_TERMS...', 'search for messages matching terms', qw(
- save-as=s output|o=s format|f=s dedupe|d=s thread|t augment|a
- limit|n=i sort|s=s@ reverse|r offset=i remote local! extinbox!
- since|after=s until|before=s) ],
+'q' => [ 'SEARCH_TERMS...', 'search for messages matching terms', qw(
+ save-as=s output|mfolder|o=s format|f=s dedupe|d=s thread|t augment|a
+ sort|s=s@ reverse|r offset=i remote local! external!
+ since|after=s until|before=s), opt_dash('limit|n=i', '[0-9]+') ],
'show' => [ 'MID|OID', 'show a given object (Message-ID or object ID)',
qw(type=s solve! format|f=s dedupe|d=s thread|t remote local!),
pass_through('git show') ],
-'add-extinbox' => [ 'URL_OR_PATHNAME',
+'add-external' => [ 'URL_OR_PATHNAME',
'add/set priority of a publicinbox|extindex for extra matches',
- qw(prio=i) ],
-'ls-extinbox' => [ '[FILTER...]', 'list publicinbox|extindex locations',
- qw(format|f=s z local remote) ],
-'forget-extinbox' => [ '{URL_OR_PATHNAME|--prune}',
+ qw(boost=i quiet|q) ],
+'ls-external' => [ '[FILTER...]', 'list publicinbox|extindex locations',
+ qw(format|f=s z|0 local remote quiet|q) ],
+'forget-external' => [ '{URL_OR_PATHNAME|--prune}',
'exclude further results from a publicinbox|extindex',
- qw(prune) ],
+ qw(prune quiet|q) ],
'ls-query' => [ '[FILTER...]', 'list saved search queries',
qw(name-only format|f=s z) ],
'set/unset flags on message(s) from stdin',
qw(stdin| oid=s exact by-mid|mid:s) ],
'forget' => [ '[--stdin|--oid=OID|--by-mid=MID]',
- 'exclude message(s) on stdin from query results',
+ "exclude message(s) on stdin from `q' search results",
qw(stdin| oid=s exact by-mid|mid:s quiet|q) ],
'purge-mailsource' => [ '{URL_OR_PATHNAME|--all}',
# code repos are used for `show' to solve blobs from patch mails
'add-coderepo' => [ 'PATHNAME', 'add or set priority of a git code repo',
- qw(prio=i) ],
+ qw(boost=i) ],
'ls-coderepo' => [ '[FILTER_TERMS...]',
'list known code repos', qw(format|f=s z) ],
'forget-coderepo' => [ 'PATHNAME',
'import' => [ '{URL_OR_PATHNAME|--stdin}',
'one-shot import/update from URL or filesystem',
- qw(stdin| limit|n=i offset=i recursive|r exclude=s include=s !flags),
+ qw(stdin| offset=i recursive|r exclude=s include=s !flags),
],
-'config' => [ '[...]', 'git-config(1) wrapper for ~/.config/lei/config',
- qw(config-file|system|global|file|f=s), # conflict detection
+'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]',
- 'initialize storage, default: ~/.local/share/lei/store',
- qw(quiet|q) ],
-'daemon-stop' => [ '', 'stop the lei-daemon' ],
+'init' => [ '[PATHNAME]', sub {
+ 'initialize storage, default: '._store_path($_[0]);
+ }, qw(quiet|q) ],
+'daemon-kill' => [ '[-SIGNAL]', 'signal the lei-daemon',
+ opt_dash('signal|s=s', '[0-9]+|(?:[A-Z][A-Z0-9]+)') ],
'daemon-pid' => [ '', 'show the PID of the lei-daemon' ],
'daemon-env' => [ '[NAME=VALUE...]', 'set, unset, or show daemon environment',
qw(clear| unset|u=s@ z|0) ],
'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
'type=s' => [ 'any|mid|git', 'disambiguate type' ],
-'dedupe|d=s' => ['STRAT|content|oid|mid',
+'dedupe|d=s' => ['STRAT|content|oid|mid|none',
'deduplication strategy'],
'show thread|t' => 'display entire thread a message belongs to',
-'query thread|t' =>
+'q thread|t' =>
'return all messages in the same thread as the actual match(es)',
'augment|a' => 'augment --output destination instead of clobbering',
'message/object output format' ],
'mark format|f=s' => $stdin_formats,
'forget format|f=s' => $stdin_formats,
-'query format|f=s' => [ 'OUT|maildir|mboxrd|mboxcl2|mboxcl|html|oid',
+'q format|f=s' => [ 'OUT|maildir|mboxrd|mboxcl2|mboxcl|html|oid|json',
'specify output format, default depends on --output'],
'ls-query format|f=s' => $ls_format,
-'ls-extinbox format|f=s' => $ls_format,
+'ls-external format|f=s' => $ls_format,
-'limit|n=i' => ['NUM',
- 'limit on number of matches (default: 10000)' ],
+'limit|n=i@' => ['NUM', 'limit on number of matches (default: 10000)' ],
'offset=i' => ['OFF', 'search result offset (default: 0)'],
'sort|s=s@' => [ 'VAL|internaldate,date,relevance,docid',
"order of results `--output'-dependent"],
-'prio=i' => 'priority of query source',
+'boost=i' => 'increase/decrease priority of results (default: 0)',
'local' => 'limit operations to the local filesystem',
'local!' => 'exclude results from the local filesystem',
'by-mid|mid:s' => [ 'MID', 'match only by Message-ID, ignoring contents' ],
'jobs:i' => 'set parallelism level',
-# xargs, env, use "-0", git(1) uses "-z". Should we support z|0 everywhere?
-'z' => 'use NUL \\0 instead of newline (CR) to delimit lines',
+# xargs, env, use "-0", git(1) uses "-z". We support z|0 everywhere
'z|0' => 'use NUL \\0 instead of newline (CR) to delimit lines',
# note: no "--ignore-environment" / "-i" support like env(1) since that
'clear|' => 'clear the daemon environment',
'unset|u=s@' => ['NAME',
'unset matching NAME, may be specified multiple times'],
+
+'signal|s=s' => [ 'SIG', 'signal to send lei-daemon (default: TERM)' ],
); # %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 emit {
- my ($client, $channel) = @_; # $buf = $_[2]
- print { $client->{$channel} } $_[2] or die "print FD[$channel]: $!";
-}
+sub puts ($;@) { print { shift->{1} } map { "$_\n" } @_ }
-sub err {
- my ($client, $buf) = @_;
- $buf .= "\n" unless $buf =~ /\n\z/s;
- emit($client, 2, $buf);
+sub out ($;@) { print { shift->{1} } @_ }
+
+sub err ($;@) {
+ print { shift->{2} } @_, (substr($_[-1], -1, 1) eq "\n" ? () : "\n");
}
-sub qerr { $_[0]->{opt}->{quiet} or err(@_) }
+sub qerr ($;@) { $_[0]->{opt}->{quiet} or err(shift, @_) }
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 (grep { !ref($_) } @info) { # ("prio=s", "z", $GLP_PASS)
+ 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 .= $rhs;
$msg .= "\n";
}
- my $channel = $errmsg ? 2 : 1;
- emit($client, $channel, $msg);
- x_it($client, $errmsg ? 1 << 8 : 0); # stderr => failure
+ print { $self->{$errmsg ? 2 : 1} } $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 $glp = ref($spec[-1]) ? pop(@spec) : $GLP; # or $GLP_PASS
+ my ($self, $cmd, $argv) = @_;
+ $self->{cmd} = $cmd;
+ $OPT = $self->{opt} = {};
+ my $info = $CMD{$cmd} // [ '[...]' ];
+ my ($proto, undef, @spec) = @$info;
+ my $glp = ref($spec[-1]) eq ref($GLP) ? pop(@spec) : $GLP;
push @spec, qw(help|h);
my $lone_dash;
if ($spec[0] =~ s/\|\z//s) { # "stdin|" or "clear|" allows "-" alias
$lone_dash = $spec[0];
- $opt->{$spec[0]} = \(my $var);
+ $OPT->{$spec[0]} = \(my $var);
push @spec, '' => \$var;
}
- $glp->getoptionsfromarray($argv, $opt, @spec) or
- return _help($client, "bad arguments or options for $cmd");
- return _help($client) if $opt->{help};
+ $glp->getoptionsfromarray($argv, $OPT, @spec) or
+ 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;
+ $OPT->{$lone_dash} = ${$OPT->{$lone_dash}} if defined $lone_dash;
my $i = 0;
my $POS_ARG = '[A-Z][A-Z0-9_]+';
} elsif ($var =~ /\.\.\.\]\z/) { # optional args start
$inf = 1;
last;
- } elsif ($var =~ /\A\[$POS_ARG\]\z/) { # one optional arg
+ } elsif ($var =~ /\A\[-?$POS_ARG\]\z/) { # one optional arg
$i++;
} elsif ($var =~ /\A.+?\|/) { # required FOO|--stdin
my @or = split(/\|/, $var);
my $ok;
for my $o (@or) {
if ($o =~ /\A--([a-z0-9\-]+)/) {
- $ok = defined($opt->{$1});
+ $ok = defined($OPT->{$1});
last;
} elsif (defined($argv->[$i])) {
$ok = 1;
}
last if $err;
}
- # warn "inf=$inf ".scalar(@$argv). ' '.scalar(@args)."\n";
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 $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") 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();
- defined(my $dir = $cfg->{'leistore.dir'}) or return;
+ my $dir = $cfg->{'leistore.dir'};
+ $dir //= _store_path($self->{env}) if $creat;
+ return unless $dir;
PublicInbox::LeiStore->new($dir, { creat => $creat });
};
}
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);
- require PublicInbox::Import;
- PublicInbox::Import::run_die($cmd, $env, \%rdr);
+ my %rdr = map { $_ => $self->{$_} } (0..2);
+ 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_pid { puts shift, $$ }
-sub lei_daemon_stop { $quit->(0) }
+sub lei_daemon_kill {
+ my ($self) = @_;
+ my $sig = $self->{opt}->{signal} // 'TERM';
+ kill($sig, $$) or fail($self, "kill($sig, $$): $!");
+}
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)
+ out $self, $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), qw(--help -h);
+ 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 { $OPTDESC{"$cmd\t$_"} || $OPTDESC{$_} } @spec);
+ } 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);
+ 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) or die "E: stdout must be a pipe\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,
USR1 => \&noop,
USR2 => \&noop,
};
- my $sigfd = PublicInbox::Sigfd->new($sig, $SFD_NONBLOCK);
+ my $sigfd = PublicInbox::Sigfd->new($sig, SFD_NONBLOCK);
local %SIG = (%SIG, %$sig) if !$sigfd;
if ($sigfd) { # TODO: use inotify/kqueue to detect unlinked sockets
PublicInbox::DS->SetLoopTimeout(5000);
}
$n; # true: continue, false: stop
});
+
+ # STDIN was redirected to /dev/null above, closing STDERR and
+ # STDOUT will cause the calling `lei' client process to finish
+ # reading the <$daemon> pipe.
+ openlog($path, 'pid', 'user');
+ local $SIG{__WARN__} = sub { syslog('warning', "@_") };
+ my $on_destroy = PublicInbox::OnDestroy->new($$, sub {
+ syslog('crit', "$@") if $@;
+ });
+ open STDERR, '>&STDIN' or die "redirect stderr failed: $!";
+ open STDOUT, '>&STDIN' or die "redirect stdout 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;