6/9 for bash completion brings us closer to very DRY help + completion internals. A couple of small other things while working on something bigger... Eric Wong (9): eml: favor index() over regexp match lei: drop "git" command forwarding lei: fix comment regarding client payload lei: ensure PWD is set correctly for path expansion gcf2: rely on Perl 5.10 to avoid needless ++ lei: complete option switch args lei_overview: clear redundant ovv_buf definition v2writable: nproc: use sysconf() on Linux and FreeBSD lei: dclose: fix typo lib/PublicInbox/Eml.pm | 2 +- lib/PublicInbox/Gcf2.pm | 9 +-- lib/PublicInbox/LEI.pm | 108 ++++++++++++++++++++------------- lib/PublicInbox/LeiOverview.pm | 1 - lib/PublicInbox/V2Writable.pm | 6 ++ t/lei.t | 46 ++++++++++++++ 6 files changed, 123 insertions(+), 49 deletions(-)
Where applicable, index() is faster than entering the regexp engine and we favor it in several other places, as well. --- lib/PublicInbox/Eml.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/PublicInbox/Eml.pm b/lib/PublicInbox/Eml.pm index 462d51fc..bd27f19b 100644 --- a/lib/PublicInbox/Eml.pm +++ b/lib/PublicInbox/Eml.pm @@ -217,7 +217,7 @@ sub mp_descend ($$) { # There's also a case where quoted text showed up in the # preamble # <20060515162817.65F0F1BBAE@citi.umich.edu> - unshift(@parts, new_sub(undef, \$pre)) if $pre =~ /:/s; + unshift(@parts, new_sub(undef, \$pre)) if index($pre, ':') >= 0; return \@parts; } # "multipart", but no boundary found, treat as single part
It was intended as a proof-of-concept and no longer needed. --- lib/PublicInbox/LEI.pm | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index effc6c52..abd7fc48 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -679,18 +679,6 @@ sub lei__complete { # proto parsing. } -sub reap_exec { # dwaitpid callback - my ($self, $pid) = @_; - x_it($self, $?); -} - -sub lei_git { # support passing through random git commands - my ($self, @argv) = @_; - my %rdr = map { $_ => $self->{$_} } (0..2); - my $pid = spawn(['git', @argv], $self->{env}, \%rdr); - dwaitpid($pid, \&reap_exec, $self); -} - sub exec_buf ($$) { my ($argv, $env) = @_; my $argc = scalar @$argv;
The client PID is no longer sent to the daemon. --- lib/PublicInbox/LEI.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index abd7fc48..c017fd4e 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -765,7 +765,7 @@ sub accept_dispatch { # Listener {post_accept} callback } $self->{2}->autoflush(1); # keep stdout buffered until x_it|DESTROY # $ENV_STR = join('', map { "\0$_=$ENV{$_}" } keys %ENV); - # $buf = "$$\0$argc\0".join("\0", @ARGV).$ENV_STR."\0\0"; + # $buf = "$argc\0".join("\0", @ARGV).$ENV_STR."\0\0"; substr($buf, -2, 2, '') eq "\0\0" or # s/\0\0\z// return send($sock, 'request command truncated', MSG_EOR); my ($argc, @argv) = split(/\0/, $buf, -1);
While commit d1b9582872d1824f166a038dcf32b6ae8c6dc735 ("lei: pass FD to CWD via cmsg, use fchdir on server") ensured things work properly to get the daemon in the right directory, it forgot to deal with places where we expand relative paths based on the current working directory. --- lib/PublicInbox/LEI.pm | 56 ++++++++++++++++++++++++++++-------------- 1 file changed, 37 insertions(+), 19 deletions(-) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index c017fd4e..0ce6a00b 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -13,6 +13,7 @@ use parent qw(PublicInbox::DS PublicInbox::LeiExternal use Getopt::Long (); use Socket qw(AF_UNIX SOCK_SEQPACKET MSG_EOR pack_sockaddr_un); use Errno qw(EAGAIN EINTR ECONNREFUSED ENOENT ECONNRESET); +use Cwd qw(getcwd); use POSIX (); use IO::Handle (); use Fcntl qw(SEEK_SET); @@ -65,18 +66,37 @@ sub opt_dash ($$) { ($spec, '<>' => $cb, $GLP_PASS) # for Getopt::Long } +sub rel2abs ($$) { + my ($self, $p) = @_; + return $p if index($p, '/') == 0; # already absolute + my $pwd = $self->{env}->{PWD}; + if (defined $pwd) { + my $cwd = $self->{3} // getcwd() // die "getcwd(PWD=$pwd): $!"; + if (my @st_pwd = stat($pwd)) { + my @st_cwd = stat($cwd) or die "stat($cwd): $!"; + "@st_pwd[1,0]" eq "@st_cwd[1,0]" or + $self->{env}->{PWD} = $pwd = $cwd; + } else { # PWD was invalid + delete $self->{env}->{PWD}; + undef $pwd; + } + } + $pwd //= $self->{env}->{PWD} = getcwd() // die "getcwd(PWD=$pwd): $!"; + File::Spec->rel2abs($p, $pwd); +} + sub _store_path ($) { - my ($env) = @_; - File::Spec->rel2abs(($env->{XDG_DATA_HOME} // - ($env->{HOME} // '/nonexistent').'/.local/share') - .'/lei/store', $env->{PWD}); + my ($self) = @_; + rel2abs($self, ($self->{env}->{XDG_DATA_HOME} // + ($self->{env}->{HOME} // '/nonexistent').'/.local/share') + .'/lei/store'); } sub _config_path ($) { - my ($env) = @_; - File::Spec->rel2abs(($env->{XDG_CONFIG_HOME} // - ($env->{HOME} // '/nonexistent').'/.config') - .'/lei/config', $env->{PWD}); + my ($self) = @_; + rel2abs($self, ($self->{env}->{XDG_CONFIG_HOME} // + ($self->{env}->{HOME} // '/nonexistent').'/.config') + .'/lei/config'); } # TODO: generate shell completion + help using %CMD and %OPTDESC @@ -295,7 +315,7 @@ sub atfork_prepare_wq { my ($self, $wq) = @_; my $tcafc = $wq->{-ipc_atfork_child_close} //= [ $listener // () ]; if (my $sock = $self->{sock}) { - push @$tcafc, @$self{qw(0 1 2)}, $sock; + push @$tcafc, @$self{qw(0 1 2 3)}, $sock; } if (my $pgr = $self->{pgr}) { push @$tcafc, @$pgr[1,2]; @@ -345,7 +365,7 @@ sub atfork_parent_wq { $ret->{dedupe} = $wq->deep_clone($dedupe); } $self->{env} = $env; - delete @$ret{qw(-lei_store cfg old_1 pgr lxs)}; # keep l2m + delete @$ret{qw(3 -lei_store cfg old_1 pgr lxs)}; # keep l2m my @io = delete @$ret{0..2}; $io[3] = delete($ret->{sock}) // $io[2]; my $l2m = $ret->{l2m}; @@ -362,7 +382,7 @@ sub _help ($;$) { 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'; + $cmd_desc = $cmd_desc->($self) if ref($cmd_desc) eq 'CODE'; my @opt_desc; my $lpad = 2; for my $sw (grep { !ref } @info) { # ("prio=s", "z", $GLP_PASS) @@ -520,7 +540,7 @@ sub dispatch { sub _lei_cfg ($;$) { my ($self, $creat) = @_; - my $f = _config_path($self->{env}); + my $f = _config_path($self); 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 @@ -550,8 +570,7 @@ sub _lei_store ($;$) { $cfg->{-lei_store} //= do { require PublicInbox::LeiStore; my $dir = $cfg->{'leistore.dir'}; - $dir //= _store_path($self->{env}) if $creat; - return unless $dir; + $dir //= $creat ? _store_path($self) : return; PublicInbox::LeiStore->new($dir, { creat => $creat }); }; } @@ -587,9 +606,8 @@ sub lei_init { my ($self, $dir) = @_; my $cfg = _lei_cfg($self, 1); my $cur = $cfg->{'leistore.dir'}; - my $env = $self->{env}; - $dir //= _store_path($env); - $dir = File::Spec->rel2abs($dir, $env->{PWD}); # PWD is symlink-aware + $dir //= _store_path($self); + $dir = rel2abs($self, $dir); my @cur = stat($cur) if defined($cur); $cur = File::Spec->canonpath($cur // $dir); my @dir = stat($dir); @@ -601,7 +619,7 @@ sub lei_init { } # some folks like symlinks and bind mounts :P - if (@dir && "$cur[0] $cur[1]" eq "$dir[0] $dir[1]") { + if (@dir && "@cur[1,0]" eq "@dir[1,0]") { lei_config($self, 'leistore.dir', $dir); _lei_store($self, 1)->done; return qerr($self, "$exists (as $cur)"); @@ -771,7 +789,7 @@ sub accept_dispatch { # Listener {post_accept} callback my ($argc, @argv) = split(/\0/, $buf, -1); undef $buf; my %env = map { split(/=/, $_, 2) } splice(@argv, $argc); - if (chdir(delete($self->{3}))) { + if (chdir($self->{3})) { local %ENV = %env; $self->{env} = \%env; eval { dispatch($self, @argv) };
And note the PublicInbox::Spawn side effect of setting PERL_INLINE_DIRECTORY. --- lib/PublicInbox/Gcf2.pm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lib/PublicInbox/Gcf2.pm b/lib/PublicInbox/Gcf2.pm index 01b83c96..99f4ae04 100644 --- a/lib/PublicInbox/Gcf2.pm +++ b/lib/PublicInbox/Gcf2.pm @@ -5,7 +5,8 @@ # other libgit2 stuff may go here, too. package PublicInbox::Gcf2; use strict; -use PublicInbox::Spawn qw(which popen_rd); +use v5.10.1; +use PublicInbox::Spawn qw(which popen_rd); # may set PERL_INLINE_DIRECTORY use Fcntl qw(LOCK_EX); use IO::Handle; # autoflush my (%CFG, $c_src, $lockfh); @@ -73,6 +74,7 @@ sub add_alt ($$) { $gcf2->add_alternate($_) for @abs_alt; } $gcf2->add_alternate($objdir); + 1; } # Usage: $^X -MPublicInbox::Gcf2 -e PublicInbox::Gcf2::loop @@ -86,7 +88,7 @@ sub loop () { while (<STDIN>) { chomp; my ($oid, $git_dir) = split(/ /, $_, 2); - $seen{$git_dir}++ or add_alt($gcf2, "$git_dir/objects"); + $seen{$git_dir} //= add_alt($gcf2, "$git_dir/objects"); if (!$gcf2->cat_oid(1, $oid)) { # retry once if missing. We only get unabbreviated OIDs # from SQLite or Xapian DBs, here, so malicious clients @@ -94,8 +96,7 @@ sub loop () { warn "I: $$ $oid missing, retrying in $git_dir\n"; $gcf2 = new(); - %seen = ($git_dir => 1); - add_alt($gcf2, "$git_dir/objects"); + %seen = ($git_dir => add_alt($gcf2,"$git_dir/objects")); if ($gcf2->cat_oid(1, $oid)) { warn "I: $$ $oid found after retry\n";
And add tests for existing completion cases --- lib/PublicInbox/LEI.pm | 36 ++++++++++++++++++++++++--------- t/lei.t | 46 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 10 deletions(-) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index 0ce6a00b..d5d9cf1f 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -104,8 +104,9 @@ sub _config_path ($) { our %CMD = ( # sorted in order of importance/use: '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! pretty mua-cmd=s - torsocks=s no-torsocks verbose|v since|after=s until|before=s), + sort|s=s reverse|r offset=i remote! local! external! pretty + mua-cmd|mua=s no-torsocks torsocks=s verbose|v + received-after=s received-before=s sent-after=s sent-since=s), PublicInbox::LeiQuery::curl_opt(), opt_dash('limit|n=i', '[0-9]+') ], 'show' => [ 'MID|OID', 'show a given object (Message-ID or object ID)', @@ -200,7 +201,11 @@ my $ls_format = [ 'OUT|plain|json|null', 'listing output format' ]; my %OPTDESC = ( 'help|h' => 'show this built-in help', 'quiet|q' => 'be quiet', +'verbose|v' => 'be more verbose', 'solve!' => 'do not attempt to reconstruct blobs from emails', +'torsocks=s' => ['auto|no|yes', + 'whether or not to wrap git and curl commands with torsocks'], +'no-torsocks' => 'alias for --torsocks=no', 'save-as=s' => ['NAME', 'save a search terms by given name'], 'type=s' => [ 'any|mid|git', 'disambiguate type' ], @@ -212,7 +217,7 @@ my %OPTDESC = ( 'return all messages in the same thread as the actual match(es)', 'augment|a' => 'augment --output destination instead of clobbering', -'output|o=s' => [ 'DEST', +'output|mfolder|o=s' => [ 'DEST', "destination (e.g. `/path/to/Maildir', or `-' for stdout)" ], 'mua-cmd|mua=s' => [ 'COMMAND', "MUA to run on --output Maildir or mbox (e.g. `mutt -f %f'" ], @@ -222,7 +227,7 @@ my %OPTDESC = ( 'mark format|f=s' => $stdin_formats, 'forget format|f=s' => $stdin_formats, 'q format|f=s' => [ - 'OUT|maildir|mboxrd|mboxcl2|mboxcl|html|json|jsonl|concatjson', + 'OUT|maildir|mboxrd|mboxcl2|mboxcl|mboxo|html|json|jsonl|concatjson', 'specify output format, default depends on --output'], 'ls-query format|f=s' => $ls_format, 'ls-external format|f=s' => $ls_format, @@ -673,22 +678,33 @@ sub lei__complete { 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 + if (s/[:=].+\z//) { # req/optional args, e.g output|o=i } else { # negation: solve! => no-solve|solve s/\A(.+)!\z/no-$1|$1/; } map { - length > 1 ? "--$_$eq" : "-$_" + my $x = length > 1 ? "--$_" : "-$_"; + $x eq $cur ? () : $x; } 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); } + + # switch args (e.g. lei q -f mbox<TAB>) + if (($argv[-1] // $cur // '') =~ /\A--?([\w\-]+)\z/) { + my $opt = quotemeta $1; + puts $self, map { + my $v = $OPTDESC{$_}; + $v = $v->[0] if ref($v); + my @v = split(/\|/, $v); + # get rid of ALL CAPS placeholder (e.g "OUT") + # (TODO: completion for external paths) + shift(@v) if uc($v[0]) eq $v[0]; + @v; + } grep(/\A(?:$cmd\t|)(?:[\w-]+\|)*$opt\b/, keys %OPTDESC); + } $cmd =~ tr/-/_/; if (my $sub = $self->can("_complete_$cmd")) { puts $self, $sub->($self, @argv, $cur); diff --git a/t/lei.t b/t/lei.t index 69338257..3f6702e6 100644 --- a/t/lei.t +++ b/t/lei.t @@ -216,6 +216,24 @@ my $test_external = sub { like($out, qr/boost=0\n/s, 'ls-external has output'); ok($lei->(qw(add-external -q https://EXAMPLE.com/ibx)), 'add remote'); is($err, '', 'no warnings after add-external'); + + ok($lei->(qw(_complete lei forget-external)), 'complete for externals'); + my %comp = map { $_ => 1 } split(/\s+/, $out); + ok($comp{'https://example.com/ibx/'}, 'forget external completion'); + $cfg->each_inbox(sub { + my ($ibx) = @_; + ok($comp{$ibx->{inboxdir}}, "local $ibx->{name} completion"); + }); + for my $u (qw(h http https https: https:/ https:// https://e + https://example https://example. https://example.co + https://example.com https://example.com/ + https://example.com/i https://example.com/ibx)) { + ok($lei->(qw(_complete lei forget-external), $u), + "partial completion for URL $u"); + is($out, "https://example.com/ibx/\n", + "completed partial URL $u"); + } + $lei->('ls-external'); like($out, qr!https://example\.com/ibx/!s, 'added canonical URL'); is($err, '', 'no warnings on ls-external'); @@ -304,11 +322,39 @@ my $test_external = sub { } }; +my $test_completion = sub { + ok($lei->(qw(_complete lei)), 'no errors on complete'); + my %out = map { $_ => 1 } split(/\s+/s, $out); + ok($out{'q'}, "`lei q' offered as completion"); + ok($out{'add-external'}, "`lei add-external' offered as completion"); + + ok($lei->(qw(_complete lei q)), 'complete q (no args)'); + %out = map { $_ => 1 } split(/\s+/s, $out); + for my $sw (qw(-f --format -o --output --mfolder --augment -a + --mua --mua-cmd --no-local --local --verbose -v + --save-as --no-remote --remote --torsocks + --reverse -r )) { + ok($out{$sw}, "$sw offered as completion"); + } + + ok($lei->(qw(_complete lei q --form)), 'complete q --format'); + is($out, "--format\n", 'complete lei q --format'); + for my $sw (qw(-f --format)) { + ok($lei->(qw(_complete lei q), $sw), "complete q $sw ARG"); + %out = map { $_ => 1 } split(/\s+/s, $out); + for my $f (qw(mboxrd mboxcl2 mboxcl mboxo json jsonl + concatjson maildir)) { + ok($out{$f}, "got $sw $f as output format"); + } + } +}; + my $test_lei_common = sub { $test_help->(); $test_config->(); $test_init->(); $test_external->(); + $test_completion->(); }; if ($ENV{TEST_LEI_ONESHOT}) {
Declaring "my $buf" inside that `if' branch was useless, so we've been declaring it per-callback when {l2m} isn't in use. --- lib/PublicInbox/LeiOverview.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/PublicInbox/LeiOverview.pm b/lib/PublicInbox/LeiOverview.pm index ea35871c..f9a28138 100644 --- a/lib/PublicInbox/LeiOverview.pm +++ b/lib/PublicInbox/LeiOverview.pm @@ -208,7 +208,6 @@ sub ovv_each_smsg_cb { # runs in wq worker usually $json = $pkg->new; $json->utf8->canonical; $json->ascii(1) if $lei->{opt}->{ascii}; - $lei->{ovv_buf} = \(my $buf = ''); } my $l2m = $lei->{l2m} or $dedupe->prepare_dedupe; if ($l2m && !$ibxish) { # remote https?:// mboxrd
No need to fork a process on platforms I use daily, at least. --- lib/PublicInbox/V2Writable.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/PublicInbox/V2Writable.pm b/lib/PublicInbox/V2Writable.pm index 7f9342b0..35b7fe30 100644 --- a/lib/PublicInbox/V2Writable.pm +++ b/lib/PublicInbox/V2Writable.pm @@ -21,6 +21,7 @@ use PublicInbox::Search; use PublicInbox::SearchIdx qw(log2stack is_ancestor check_size is_bad_blob); use IO::Handle; # ->autoflush use File::Temp (); +use POSIX (); my $OID = qr/[a-f0-9]{40,}/; # an estimate of the post-packed size to the raw uncompressed size @@ -35,6 +36,11 @@ our $PACKING_FACTOR = 0.4; our $NPROC_MAX_DEFAULT = 4; sub detect_nproc () { + # _SC_NPROCESSORS_ONLN = 84 on both Linux glibc and musl + return POSIX::sysconf(84) if $^O eq 'linux'; + return POSIX::sysconf(58) if $^O eq 'freebsd'; + # TODO: more OSes + # getconf(1) is POSIX, but *NPROCESSORS* vars are not for (qw(_NPROCESSORS_ONLN NPROCESSORS_ONLN)) { `getconf $_ 2>/dev/null` =~ /^(\d+)$/ and return $1;
Oops :x --- lib/PublicInbox/LEI.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm index d5d9cf1f..f5413aab 100644 --- a/lib/PublicInbox/LEI.pm +++ b/lib/PublicInbox/LEI.pm @@ -820,7 +820,7 @@ sub dclose { for my $f (qw(lxs l2m)) { my $wq = delete $self->{$f} or next; if ($wq->wq_kill) { - $self->wq_close + $wq->wq_close } elsif ($wq->wq_kill_old) { $wq->wq_wait_old; }