]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LEI.pm
lei: add "lei up" to complement "lei q --save"
[public-inbox.git] / lib / PublicInbox / LEI.pm
index 9e3bb9b760e9cd695f33db82739273da46687a2c..4b87c104bec98df6936a4af1dc81d56e57f41ee9 100644 (file)
@@ -120,6 +120,9 @@ sub index_opt {
 }
 
 my @c_opt = qw(c=s@ C=s@ quiet|q);
+my @lxs_opt = (qw(remote! local! external! include|I=s@ exclude=s@ only=s@
+       import-remote! no-torsocks torsocks=s),
+       PublicInbox::LeiQuery::curl_opt());
 
 # we generate shell completion + help using %CMD and %OPTDESC,
 # see lei__complete() and PublicInbox::LeiHelp
@@ -127,16 +130,17 @@ my @c_opt = qw(c=s@ C=s@ quiet|q);
 our %CMD = ( # sorted in order of importance/use:
 'q' => [ '--stdin|SEARCH_TERMS...', 'search for messages matching terms',
        'stdin|', # /|\z/ must be first for lone dash
-       qw(save-as=s output|mfolder|o=s format|f=s dedupe|d=s threads|t+
-       sort|s=s reverse|r offset=i remote! local! external! pretty
-       include|I=s@ exclude=s@ only=s@ jobs|j=s globoff|g augment|a
-       import-remote! import-before! lock=s@ rsyncable
-       alert=s@ mua=s no-torsocks torsocks=s verbose|v+), @c_opt,
-       PublicInbox::LeiQuery::curl_opt(), 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 threads|t remote local!
-       verbose|v+), @c_opt, pass_through('git show') ],
+       @lxs_opt,
+       qw(save output|mfolder|o=s format|f=s dedupe|d=s threads|t+
+       sort|s=s reverse|r offset=i pretty jobs|j=s globoff|g augment|a
+       import-before! lock=s@ rsyncable alert=s@ mua=s verbose|v+), @c_opt,
+       opt_dash('limit|n=i', '[0-9]+') ],
+'up' => [ 'SEARCH_TERMS...', 'update saved search',
+       qw(jobs|j=s lock=s@ alert=s@ mua=s verbose|v+), @c_opt ],
+
+'blob' => [ 'OID', 'show a git blob, reconstructing from mail if necessary',
+       qw(git-dir=s@ cwd! verbose|v+ mail! oid-a|A=s path-a|a=s path-b|b=s),
+       @lxs_opt, @c_opt ],
 
 'add-external' => [ 'LOCATION',
        'add/set priority of a publicinbox|extindex for extra matches',
@@ -145,6 +149,7 @@ our %CMD = ( # sorted in order of importance/use:
        PublicInbox::LeiQuery::curl_opt() ],
 'ls-external' => [ '[FILTER]', 'list publicinbox|extindex locations',
        qw(format|f=s z|0 globoff|g invert-match|v local remote), @c_opt ],
+'ls-label' => [ '', 'list labels', qw(z|0 stats:s), @c_opt ],
 'forget-external' => [ 'LOCATION...|--prune',
        'exclude further results from a publicinbox|extindex',
        qw(prune), @c_opt ],
@@ -157,9 +162,10 @@ our %CMD = ( # sorted in order of importance/use:
 'plonk' => [ '--threads|--from=IDENT',
        'exclude mail matching From: or threads from non-Message-ID searches',
        qw(stdin| threads|t from|f=s mid=s oid=s), @c_opt ],
-'mark' => [ 'MESSAGE_FLAGS...',
-       'set/unset keywords on message(s) from stdin',
-       qw(stdin| oid=s exact by-mid|mid:s), @c_opt ],
+'tag' => [ 'KEYWORDS...',
+       'set/unset keywords and/or labels on message(s)',
+       qw(stdin| in-format|F=s input|i=s@ oid=s@ mid=s@), @c_opt,
+       pass_through('-kw:foo for delete') ],
 'forget' => [ '[--stdin|--oid=OID|--by-mid=MID]',
        "exclude message(s) on stdin from `q' search results",
        qw(stdin| oid=s exact by-mid|mid:s), @c_opt ],
@@ -168,15 +174,6 @@ our %CMD = ( # sorted in order of importance/use:
        'remove imported messages from IMAP, Maildirs, and MH',
        qw(exact! all jobs:i indexed), @c_opt ],
 
-# code repos are used for `show' to solve blobs from patch mails
-'add-coderepo' => [ 'DIRNAME', 'add or set priority of a git code repo',
-       qw(boost=i), @c_opt ],
-'ls-coderepo' => [ '[FILTER_TERMS...]',
-               'list known code repos', qw(format|f=s z), @c_opt ],
-'forget-coderepo' => [ 'DIRNAME',
-       'stop using repo to solve blobs from patches',
-       qw(prune), @c_opt ],
-
 'add-watch' => [ 'LOCATION', 'watch for new messages and flag changes',
        qw(import! kw|keywords|flags! interval=s recursive|r
        exclude=s include=s), @c_opt ],
@@ -245,11 +242,16 @@ my %OPTDESC = (
                "and\xa0'[]'\x{a0}ranges",
 'verbose|v+' => 'be more verbose',
 'external!' => 'do not use externals',
-'solve!' => 'do not attempt to reconstruct blobs from emails',
+'mail!' => 'do not look in mail storage for OID',
+'cwd!' => 'do not look in git repo of current working directory',
+'oid-a|A=s' => 'pre-image OID',
+'path-a|a=s' => 'pre-image pathname associated with OID',
+'path-b|b=s' => 'post-image pathname associated with OID',
+'git-dir=s@' => 'additional git repository to scan',
 'torsocks=s' => ['VAL|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'],
+'save' =>  "save a search for `lei up'",
 'import-remote!' => 'do not memoize remote messages into local store',
 
 'type=s' => [ 'any|mid|git', 'disambiguate type' ],
@@ -348,7 +350,12 @@ my %CONFIG_KEYS = (
        'leistore.dir' => 'top-level storage location',
 );
 
-my @WQ_KEYS = qw(lxs l2m imp mrr cnv p2q); # internal workers
+my @WQ_KEYS = qw(lxs l2m imp mrr cnv p2q tag sol); # internal workers
+
+sub _drop_wq {
+       my ($self) = @_;
+       for my $wq (grep(defined, delete(@$self{@WQ_KEYS}))) { $wq->DESTROY }
+}
 
 # pronounced "exit": x_it(1 << 8) => exit(1); x_it(13) => SIGPIPE
 sub x_it ($$) {
@@ -360,10 +367,7 @@ sub x_it ($$) {
                send($s, "x_it $code", MSG_EOR);
        } elsif ($self->{oneshot}) {
                # don't want to end up using $? from child processes
-               for my $f (@WQ_KEYS) {
-                       my $wq = delete $self->{$f} or next;
-                       $wq->DESTROY;
-               }
+               _drop_wq($self);
                # cleanup anything that has tempfiles or open file handles
                %PATH2CFG = ();
                delete @$self{qw(ovv dedupe sto cfg)};
@@ -392,11 +396,8 @@ sub qerr ($;@) { $_[0]->{opt}->{quiet} or err(shift, @_) }
 
 sub fail_handler ($;$$) {
        my ($lei, $code, $io) = @_;
-       for my $f (@WQ_KEYS) {
-               my $wq = delete $lei->{$f} or next;
-               $wq->wq_wait_old(undef, $lei) if $wq->wq_kill_old; # lei-daemon
-       }
        close($io) if $io; # needed to avoid warnings on SIGPIPE
+       _drop_wq($lei);
        x_it($lei, $code // (1 << 8));
 }
 
@@ -419,23 +420,6 @@ sub fail ($$;$) {
        undef;
 }
 
-sub check_input_format ($;$) {
-       my ($self, $files) = @_;
-       my $opt_key = 'in-format';
-       my $fmt = $self->{opt}->{$opt_key};
-       if (!$fmt) {
-               my $err = $files ? "regular file(s):\n@$files" : '--stdin';
-               return fail($self, "--$opt_key unset for $err");
-       }
-       require PublicInbox::MboxLock if $files;
-       require PublicInbox::MboxReader;
-       return 1 if $fmt eq 'eml';
-       # XXX: should this handle {gz,bz2,xz}? that's currently in LeiToMail
-       PublicInbox::MboxReader->can($fmt) or
-               return fail($self, "--$opt_key=$fmt unrecognized");
-       1;
-}
-
 sub out ($;@) {
        my $self = shift;
        return if print { $self->{1} // return } @_; # likely
@@ -465,19 +449,21 @@ sub note_sigpipe { # triggers sigpipe_handler
        x_it($self, 13);
 }
 
-sub lei_atfork_child {
+sub _lei_atfork_child {
        my ($self, $persist) = @_;
        # we need to explicitly close things which are on stack
        if ($persist) {
+               chdir '/' or die "chdir(/): $!";
                my @io = delete @$self{qw(0 1 2 sock)};
                unless ($self->{oneshot}) {
                        close($_) for @io;
                }
+               if (my $cfg = $self->{cfg}) {
+                       delete $cfg->{-lei_store};
+               }
        } else { # worker, Net::NNTP (Net::Cmd) uses STDERR directly
                open STDERR, '+>&='.fileno($self->{2}) or warn "open $!";
-               delete $self->{0};
        }
-       delete @$self{qw(cnv)};
        for (delete @$self{qw(3 old_1 au_done)}) {
                close($_) if defined($_);
        }
@@ -495,23 +481,41 @@ sub lei_atfork_child {
        $current_lei = $persist ? undef : $self; # for SIG{__WARN__}
 }
 
+sub _delete_pkt_op { # OnDestroy callback to prevent leaks on die
+       my ($self) = @_;
+       if (my $op = delete $self->{pkt_op_c}) { # in case of die
+               $op->close; # PublicInbox::PktOp::close
+       }
+       my $unclosed_after_die = delete($self->{pkt_op_p}) or return;
+       close $unclosed_after_die;
+}
+
+sub pkt_op_pair {
+       my ($self) = @_;
+       require PublicInbox::OnDestroy;
+       require PublicInbox::PktOp;
+       my $end = PublicInbox::OnDestroy->new($$, \&_delete_pkt_op, $self);
+       @$self{qw(pkt_op_c pkt_op_p)} = PublicInbox::PktOp->pair;
+       $end;
+}
+
 sub workers_start {
        my ($lei, $wq, $ident, $jobs, $ops) = @_;
        $ops = {
-               '!' => [ $lei->can('fail_handler'), $lei ],
-               '|' => [ $lei->can('sigpipe_handler'), $lei ],
-               'x_it' => [ $lei->can('x_it'), $lei ],
-               'child_error' => [ $lei->can('child_error'), $lei ],
-               %$ops
+               '!' => [ \&fail_handler, $lei ],
+               '|' => [ \&sigpipe_handler, $lei ],
+               'x_it' => [ \&x_it, $lei ],
+               'child_error' => [ \&child_error, $lei ],
+               ($ops ? %$ops : ()),
        };
-       require PublicInbox::PktOp;
-       ($lei->{pkt_op_c}, $lei->{pkt_op_p}) = PublicInbox::PktOp->pair($ops);
+       $ops->{''} //= [ \&dclose, $lei ];
+       my $end = $lei->pkt_op_pair;
        $wq->wq_workers_start($ident, $jobs, $lei->oldset, { lei => $lei });
        delete $lei->{pkt_op_p};
-       my $op = delete $lei->{pkt_op_c};
+       my $op_c = delete $lei->{pkt_op_c};
+       @$end = ();
        $lei->event_step_init;
-       # oneshot needs $op, daemon-mode uses DS->EventLoop to handle $op
-       $lei->{oneshot} ? $op : undef;
+       ($op_c, $ops);
 }
 
 sub _help {
@@ -619,6 +623,19 @@ EOM
        }
 }
 
+sub lazy_cb ($$$) {
+       my ($self, $cmd, $pfx) = @_;
+       my $ucmd = $cmd;
+       $ucmd =~ tr/-/_/;
+       my $cb;
+       $cb = $self->can($pfx.$ucmd) and return $cb;
+       my $base = $ucmd;
+       $base =~ s/_([a-z])/\u$1/g;
+       my $pkg = "PublicInbox::Lei\u$base";
+       ($INC{"PublicInbox/Lei\u$base.pm"} // eval("require $pkg")) ?
+               $pkg->can($pfx.$ucmd) : undef;
+}
+
 sub dispatch {
        my ($self, $cmd, @argv) = @_;
        local $current_lei = $self; # for __WARN__
@@ -631,14 +648,7 @@ sub dispatch {
                push @{$self->{opt}->{substr($cmd, 1, 1)}}, $v;
                $cmd = shift(@argv) // return _help($self, 'no command given');
        }
-       my $func = "lei_$cmd";
-       $func =~ tr/-/_/;
-       my $cb = __PACKAGE__->can($func) // ($CMD{$cmd} ? do {
-               my $mod = "PublicInbox::Lei\u$cmd";
-               ($INC{"PublicInbox/Lei\u$cmd.pm"} //
-                       eval("require $mod")) ? $mod->can($func) : undef;
-       } : undef);
-       if ($cb) {
+       if (my $cb = lazy_cb(__PACKAGE__, $cmd, 'lei_')) {
                optparse($self, $cmd, \@argv) or return;
                $self->{opt}->{c} and (_tmp_cfg($self) // return);
                if (my $chdir = $self->{opt}->{C}) {
@@ -646,6 +656,11 @@ sub dispatch {
                                next if $d eq ''; # same as git(1)
                                chdir $d or return fail($self, "cd $d: $!");
                        }
+                       if (delete $self->{3}) { # update cwd for rel2abs
+                               opendir my $dh, '.' or
+                                       return fail($self, "opendir . $!");
+                               $self->{3} = $dh;
+                       }
                }
                $cb->($self, @argv);
        } elsif (grep(/\A-/, $cmd, @argv)) { # --help or -h only
@@ -684,10 +699,17 @@ sub _lei_cfg ($;$) {
        bless $cfg, 'PublicInbox::Config';
        $cfg->{-st} = $cur_st;
        $cfg->{'-f'} = $f;
-       if ($sto && File::Spec->canonpath($sto_dir) eq
-                       File::Spec->canonpath($cfg->{'leistore.dir'})) {
+       if ($sto && File::Spec->canonpath($sto_dir // store_path($self))
+                       eq File::Spec->canonpath($cfg->{'leistore.dir'} //
+                                               store_path($self))) {
                $cfg->{-lei_store} = $sto;
        }
+       if (scalar(keys %PATH2CFG) > 5) {
+               # FIXME: use inotify/EVFILT_VNODE to detect unlinked configs
+               for my $k (keys %PATH2CFG) {
+                       delete($PATH2CFG{$k}) unless -f $k
+               }
+       }
        $self->{cfg} = $PATH2CFG{$f} = $cfg;
 }
 
@@ -696,20 +718,12 @@ sub _lei_store ($;$) {
        my $cfg = _lei_cfg($self, $creat);
        $cfg->{-lei_store} //= do {
                require PublicInbox::LeiStore;
-               my $dir = $cfg->{'leistore.dir'};
-               $dir //= $creat ? store_path($self) : return;
+               my $dir = $cfg->{'leistore.dir'} // store_path($self);
+               return unless $creat || -d $dir;
                PublicInbox::LeiStore->new($dir, { creat => $creat });
        };
 }
 
-sub lei_show {
-       my ($self, @argv) = @_;
-}
-
-sub lei_mark {
-       my ($self, @argv) = @_;
-}
-
 sub _config {
        my ($self, @argv) = @_;
        my %env = (%{$self->{env}}, GIT_CONFIG => undef);
@@ -727,38 +741,6 @@ sub lei_config {
        x_it($self, $?) if $?;
 }
 
-sub lei_init {
-       my ($self, $dir) = @_;
-       my $cfg = _lei_cfg($self, 1);
-       my $cur = $cfg->{'leistore.dir'};
-       $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);
-       my $exists = "# leistore.dir=$cur already initialized" if @dir;
-       if (@cur) {
-               if ($cur eq $dir) {
-                       _lei_store($self, 1)->done;
-                       return qerr($self, $exists);
-               }
-
-               # some folks like symlinks and bind mounts :P
-               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)");
-               }
-               return fail($self, <<"");
-E: leistore.dir=$cur already initialized and it is not $dir
-
-       }
-       lei_config($self, 'leistore.dir', $dir);
-       _lei_store($self, 1)->done;
-       $exists //= "# leistore.dir=$dir newly initialized";
-       return qerr($self, $exists);
-}
-
 sub lei_daemon_pid { puts shift, $$ }
 
 sub lei_daemon_kill {
@@ -767,8 +749,6 @@ sub lei_daemon_kill {
        kill($sig, $$) or fail($self, "kill($sig, $$): $!");
 }
 
-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.
@@ -803,7 +783,7 @@ sub lei__complete {
                        if (s/[:=].+\z//) { # req/optional args, e.g output|o=i
                        } elsif (s/\+\z//) { # verbose|v+
                        } elsif (s/!\z//) {
-                               # negation: solve! => no-solve|solve
+                               # negation: mail! => no-mail|mail
                                s/([\w\-]+)/$1|no-$1/g
                        }
                        map {
@@ -827,9 +807,8 @@ sub lei__complete {
                        @v;
                } grep(/\A(?:[\w-]+\|)*$opt\b.*?(?:\t$cmd)?\z/, keys %OPTDESC);
        }
-       $cmd =~ tr/-/_/;
-       if (my $sub = $self->can("_complete_$cmd")) {
-               puts $self, $sub->($self, @argv, $cur ? ($cur) : ());
+       if (my $cb = lazy_cb($self, $cmd, '_complete_')) {
+               puts $self, $cb->($self, @argv, $cur ? ($cur) : ());
        }
        # TODO: URLs, pathnames, OIDs, MIDs, etc...  See optparse() for
        # proto parsing.
@@ -861,11 +840,18 @@ sub start_mua {
        if (my $sock = $self->{sock}) { # lei(1) client process runs it
                send($sock, exec_buf(\@cmd, {}), MSG_EOR);
        } elsif ($self->{oneshot}) {
-               $self->{"pid.$self.$$"}->{spawn(\@cmd)} = \@cmd;
+               my $pid = fork // die "fork: $!";
+               if ($pid > 0) { # original process
+                       exec(@cmd);
+                       warn "exec @cmd: $!\n";
+                       POSIX::_exit(1);
+               }
+               POSIX::setsid() > 0 or die "setsid: $!";
        }
        if ($self->{lxs} && $self->{au_done}) { # kick wait_startq
                syswrite($self->{au_done}, 'q' x ($self->{lxs}->{jobs} // 0));
        }
+       return unless -t $self->{2}; # XXX how to determine non-TUI MUAs?
        $self->{opt}->{quiet} = 1;
        delete $self->{-progress};
        delete $self->{opt}->{verbose};
@@ -909,19 +895,17 @@ sub poke_mua { # forces terminal MUAs to wake up and hopefully notice new mail
 }
 
 my %path_to_fd = ('/dev/stdin' => 0, '/dev/stdout' => 1, '/dev/stderr' => 2);
-$path_to_fd{"/dev/fd/$_"} = $path_to_fd{"/proc/self/fd/$_"} for (0..2);
-sub fopen {
-       my ($self, $mode, $path) = @_;
-       rel2abs($self, $path);
+$path_to_fd{"/dev/fd/$_"} = $_ for (0..2);
+
+# this also normalizes the path
+sub path_to_fd {
+       my ($self, $path) = @_;
+       $path = rel2abs($self, $path);
        $path =~ tr!/!/!s;
-       if (defined(my $fd = $path_to_fd{$path})) {
-               return $self->{$fd};
-       }
-       if ($path =~ m!\A/(?:dev|proc/self)/fd/[0-9]+\z!) {
-               return fail($self, "cannot open $path from daemon");
-       }
-       open my $fh, $mode, $path or return;
-       $fh;
+       $path_to_fd{$path} // (
+               ($path =~ m!\A/(?:dev|proc/self)/fd/[0-9]+\z!) ?
+                       fail($self, "cannot open $path from daemon") : -1
+       );
 }
 
 # caller needs to "-t $self->{1}" to check if tty
@@ -969,17 +953,16 @@ sub accept_dispatch { # Listener {post_accept} callback
                return send($sock, 'timed out waiting to recv FDs', MSG_EOR);
        # (4096 * 33) >MAX_ARG_STRLEN
        my @fds = $recv_cmd->($sock, my $buf, 4096 * 33) or return; # EOF
-       if (scalar(@fds) == 4) {
-               for my $i (0..3) {
-                       my $fd = shift(@fds);
-                       open($self->{$i}, '+<&=', $fd) and next;
-                       send($sock, "open(+<&=$fd) (FD=$i): $!", MSG_EOR);
-               }
-       } elsif (!defined($fds[0])) {
+       if (!defined($fds[0])) {
                warn(my $msg = "recv_cmd failed: $!");
                return send($sock, $msg, MSG_EOR);
        } else {
-               return;
+               my $i = 0;
+               for my $fd (@fds) {
+                       open($self->{$i++}, '+<&=', $fd) and next;
+                       send($sock, "open(+<&=$fd) (FD=$i): $!", MSG_EOR);
+               }
+               return if scalar(@fds) != 4;
        }
        $self->{2}->autoflush(1); # keep stdout buffered until x_it|DESTROY
        # $ENV_STR = join('', map { "\0$_=$ENV{$_}" } keys %ENV);
@@ -1002,18 +985,8 @@ sub accept_dispatch { # Listener {post_accept} callback
 sub dclose {
        my ($self) = @_;
        delete $self->{-progress};
-       for my $f (@WQ_KEYS) {
-               my $wq = delete $self->{$f} or next;
-               if ($wq->wq_kill) {
-                       $wq->wq_close(0, undef, $self);
-               } elsif ($wq->wq_kill_old) {
-                       $wq->wq_wait_old(undef, $self);
-               }
-       }
+       _drop_wq($self);
        close(delete $self->{1}) if $self->{1}; # may reap_compress
-       if (my $sto = delete $self->{sto}) {
-               $sto->ipc_do('done');
-       }
        $self->close if $self->{-event_init_done}; # PublicInbox::DS::close
 }