]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/LEI.pm
lei import: speed up repeated Maildir imports
[public-inbox.git] / lib / PublicInbox / LEI.pm
index 628908b5bc22ae8e098c4be376fb9aa651e038e4..77fc5b8fa278983dea3a332fc3277894ac5ff7d7 100644 (file)
@@ -163,7 +163,7 @@ our %CMD = ( # sorted in order of importance/use:
        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+
-       color! mail-sync!), @c_opt, opt_dash('limit|n=i', '[0-9]+') ],
+       shared color! mail-sync!), @c_opt, opt_dash('limit|n=i', '[0-9]+') ],
 
 'up' => [ 'OUTPUT|--all', 'update saved search',
        qw(jobs|j=s lock=s@ alert=s@ mua=s verbose|v+ all:s), @c_opt ],
@@ -206,7 +206,10 @@ our %CMD = ( # sorted in order of importance/use:
                qw(verbose|v+), @c_opt ],
 'edit-search' => [ 'OUTPUT', "edit saved search via `git config --edit'",
                        @c_opt ],
-
+'rm' => [ '--stdin|LOCATION...',
+       'remove a message from the index and prevent reindexing',
+       'stdin|', # /|\z/ must be first for lone dash
+       @c_opt ],
 '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 ],
@@ -215,9 +218,6 @@ our %CMD = ( # sorted in order of importance/use:
        qw(stdin| in-format|F=s input|i=s@ oid=s@ mid=s@),
        qw(no-torsocks torsocks=s), PublicInbox::LeiQuery::curl_opt(), @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 ],
 
 'purge-mailsource' => [ 'LOCATION|--all',
        'remove imported messages from IMAP, Maildirs, and MH',
@@ -240,10 +240,11 @@ our %CMD = ( # sorted in order of importance/use:
         @c_opt ],
 'import' => [ 'LOCATION...|--stdin',
        'one-time import/update from URL or filesystem',
-       qw(stdin| offset=i recursive|r exclude=s include|I=s
+       qw(stdin| offset=i recursive|r exclude=s include|I=s jobs=s
        lock=s@ in-format|F=s kw! verbose|v+ incremental! mail-sync!),
        qw(no-torsocks torsocks=s), PublicInbox::LeiQuery::curl_opt(), @c_opt ],
-
+'forget-mail-sync' => [ 'LOCATION...',
+       'forget sync information for a mail folder', @c_opt ],
 'export-kw' => [ 'LOCATION...|--all',
        'one-time export of keywords of sync sources',
        qw(all:s mode=s), @c_opt ],
@@ -270,13 +271,12 @@ our %CMD = ( # sorted in order of importance/use:
 'daemon-pid' => [ '', 'show the PID of the lei-daemon' ],
 'help' => [ '[SUBCOMMAND]', 'show help' ],
 
-# XXX do we need this?
-# 'git' => [ '[ANYTHING...]', 'git(1) wrapper', pass_through('git') ],
-
-'reorder-local-store-and-break-history' => [ '[REFNAME]',
-       'rewrite git history in an attempt to improve compression',
-       qw(gc!), @c_opt ],
-
+# TODO
+#'reorder-local-store-and-break-history' => [ '[REFNAME]',
+#      'rewrite git history in an attempt to improve compression',
+#      qw(gc!), @c_opt ],
+#'fuse-mount' => [ 'PATHNAME', 'expose lei/store as Maildir(s)', @c_opt ],
+#
 # internal commands are prefixed with '_'
 '_complete' => [ '[...]', 'internal shell completion helper',
                pass_through('everything') ],
@@ -421,7 +421,7 @@ my %CONFIG_KEYS = (
        'leistore.dir' => 'top-level storage location',
 );
 
-my @WQ_KEYS = qw(lxs l2m wq1); # internal workers
+my @WQ_KEYS = qw(lxs l2m ikw pmd wq1); # internal workers
 
 sub _drop_wq {
        my ($self) = @_;
@@ -441,21 +441,10 @@ sub x_it ($$) {
        # make sure client sees stdout before exit
        $self->{1}->autoflush(1) if $self->{1};
        dump_and_clear_log();
-       if (my $s = $self->{pkt_op_p} // $self->{sock}) {
-               send($s, "x_it $code", MSG_EOR);
-       } elsif ($self->{oneshot}) {
-               # don't want to end up using $? from child processes
-               _drop_wq($self);
-               # cleanup anything that has tempfiles or open file handles
-               %PATH2CFG = ();
-               delete @$self{qw(ovv dedupe sto cfg)};
-               if (my $signum = ($code & 127)) { # usually SIGPIPE (13)
-                       $SIG{PIPE} = 'DEFAULT'; # $SIG{$signum} doesn't work
-                       kill $signum, $$;
-                       sleep(1) while 1; # wait for signal
-               } else {
-                       $quit->($code >> 8);
-               }
+       if ($self->{pkt_op_p}) { # to top lei-daemon
+               $self->{pkt_op_p}->pkt_do('x_it', $code);
+       } elsif ($self->{sock}) { # to lei(1) client
+               send($self->{sock}, "x_it $code", MSG_EOR);
        } # else ignore if client disconnected
 }
 
@@ -491,9 +480,10 @@ sub sigint_reap {
 
 sub fail ($$;$) {
        my ($self, $buf, $exit_code) = @_;
+       $self->{failed}++;
        err($self, $buf) if defined $buf;
        # calls fail_handler:
-       send($self->{pkt_op_p}, '!', MSG_EOR) if $self->{pkt_op_p};
+       $self->{pkt_op_p}->pkt_do('!') if $self->{pkt_op_p};
        x_it($self, ($exit_code // 1) << 8);
        undef;
 }
@@ -512,18 +502,17 @@ sub puts ($;@) { out(shift, map { "$_\n" } @_) }
 sub child_error { # passes non-fatal curl exit codes to user
        my ($self, $child_error, $msg) = @_; # child_error is $?
        $self->err($msg) if $msg;
-       if (my $s = $self->{pkt_op_p} // $self->{sock}) {
-               # send to the parent lei-daemon or to lei(1) client
-               send($s, "child_error $child_error", MSG_EOR);
-       } elsif (!$PublicInbox::DS::in_loop) {
-               $self->{child_error} = $child_error;
+       if ($self->{pkt_op_p}) { # to top lei-daemon
+               $self->{pkt_op_p}->pkt_do('child_error', $child_error);
+       } elsif ($self->{sock}) { # to lei(1) client
+               send($self->{sock}, "child_error $child_error", MSG_EOR);
        } # else noop if client disconnected
 }
 
 sub note_sigpipe { # triggers sigpipe_handler
        my ($self, $fd) = @_;
        close(delete($self->{$fd})); # explicit close silences Perl warning
-       send($self->{pkt_op_p}, '|', MSG_EOR) if $self->{pkt_op_p};
+       $self->{pkt_op_p}->pkt_do('|') if $self->{pkt_op_p};
        x_it($self, 13);
 }
 
@@ -563,8 +552,8 @@ sub _delete_pkt_op { # OnDestroy callback to prevent leaks on die
        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;
+       my $pkt_op_p = delete($self->{pkt_op_p}) or return;
+       close $pkt_op_p->{op_p};
 }
 
 sub pkt_op_pair {
@@ -577,7 +566,7 @@ sub pkt_op_pair {
 }
 
 sub workers_start {
-       my ($lei, $wq, $jobs, $ops) = @_;
+       my ($lei, $wq, $jobs, $ops, $flds) = @_;
        $ops = {
                '!' => [ \&fail_handler, $lei ],
                '|' => [ \&sigpipe_handler, $lei ],
@@ -588,14 +577,26 @@ sub workers_start {
        $ops->{''} //= [ $wq->can('_lei_wq_eof') || \&wq_eof, $lei ];
        my $end = $lei->pkt_op_pair;
        my $ident = $wq->{-wq_ident} // "lei-$lei->{cmd} worker";
-       $wq->wq_workers_start($ident, $jobs, $lei->oldset, { lei => $lei });
+       $flds->{lei} = $lei;
+       $wq->wq_workers_start($ident, $jobs, $lei->oldset, $flds);
        delete $lei->{pkt_op_p};
        my $op_c = delete $lei->{pkt_op_c};
+       # {-lei_sock} persists script/lei process until ops->{''} EOF callback
+       $op_c->{-lei_sock} = $lei->{sock};
        @$end = ();
        $lei->event_step_init;
        ($op_c, $ops);
 }
 
+# call this when we're ready to wait on events and yield to other clients
+sub wait_wq_events {
+       my ($lei, $op_c, $ops) = @_;
+       for my $wq (grep(defined, @$lei{qw(ikw pmd)})) { # auxiliary WQs
+               $wq->wq_close(1);
+       }
+       $op_c->{ops} = $ops;
+}
+
 sub _help {
        require PublicInbox::LeiHelp;
        PublicInbox::LeiHelp::call($_[0], $_[1], \%CMD, \%OPTDESC);
@@ -648,7 +649,15 @@ sub optparse ($$$) {
                        my $ok;
                        for my $o (@or) {
                                if ($o =~ /\A--([a-z0-9\-]+)/) {
-                                       $ok = defined($OPT->{$1});
+                                       my $sw = $1;
+                                       # assume pipe/regular file on stdin
+                                       # w/o args means stdin
+                                       if ($sw eq 'stdin' && !@$argv &&
+                                                       (-p $self->{0} ||
+                                                        -f _) && -r _) {
+                                               $OPT->{stdin} //= 1;
+                                       }
+                                       $ok = defined($OPT->{$sw});
                                        last if $ok;
                                } elsif (defined($argv->[$i])) {
                                        $ok = 1;
@@ -916,21 +925,10 @@ sub start_mua {
        }
        push @cmd, $mfolder unless defined($replaced);
        if ($self->{sock}) { # lei(1) client process runs it
-               # restore terminal: echo $query | lei q -stdin --mua=...
+               # restore terminal: echo $query | lei q --stdin --mua=...
                my $io = [];
                $io->[0] = $self->{1} if $self->{opt}->{stdin} && -t $self->{1};
                send_exec_cmd($self, $io, \@cmd, {});
-       } elsif ($self->{oneshot}) {
-               my $pid = fork // die "fork: $!";
-               if ($pid > 0) { # original process
-                       if ($self->{opt}->{stdin} && -t STDOUT) {
-                               open STDIN, '+<&', \*STDOUT or die "dup2: $!";
-                       }
-                       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));
@@ -951,14 +949,11 @@ sub send_exec_cmd { # tell script/lei to execute a command
 sub poke_mua { # forces terminal MUAs to wake up and hopefully notice new mail
        my ($self) = @_;
        my $alerts = $self->{opt}->{alert} // return;
+       my $sock = $self->{sock};
        while (my $op = shift(@$alerts)) {
                if ($op eq ':WINCH') {
                        # hit the process group that started the MUA
-                       if ($self->{sock}) {
-                               send($self->{sock}, '-WINCH', MSG_EOR);
-                       } elsif ($self->{oneshot}) {
-                               kill('-WINCH', $$);
-                       }
+                       send($sock, '-WINCH', MSG_EOR) if $sock;
                } elsif ($op eq ':bell') {
                        out($self, "\a");
                } elsif ($op =~ /(?<!\\),/) { # bare ',' (not ',,')
@@ -967,11 +962,7 @@ sub poke_mua { # forces terminal MUAs to wake up and hopefully notice new mail
                        my $cmd = $1; # run an arbitrary command
                        require Text::ParseWords;
                        $cmd = [ Text::ParseWords::shellwords($cmd) ];
-                       if (my $s = $self->{sock}) {
-                               send($s, exec_buf($cmd, {}), MSG_EOR);
-                       } elsif ($self->{oneshot}) {
-                               $self->{"pid.$self.$$"}->{spawn($cmd)} = $cmd;
-                       }
+                       send($sock, exec_buf($cmd, {}), MSG_EOR) if $sock;
                } else {
                        err($self, "W: unsupported --alert=$op"); # non-fatal
                }
@@ -1008,9 +999,6 @@ sub start_pager {
        if ($self->{sock}) { # lei(1) process runs it
                delete @$new_env{keys %$env}; # only set iff unset
                send_exec_cmd($self, [ @$rdr{0..2} ], [$pager], $new_env);
-       } elsif ($self->{oneshot}) {
-               my $cmd = [$pager];
-               $self->{"pid.$self.$$"}->{spawn($cmd, $new_env, $rdr)} = $cmd;
        } else {
                die 'BUG: start_pager w/o socket';
        }
@@ -1068,7 +1056,7 @@ sub accept_dispatch { # Listener {post_accept} callback
 sub dclose {
        my ($self) = @_;
        delete $self->{-progress};
-       _drop_wq($self);
+       _drop_wq($self) if $self->{failed};
        close(delete $self->{1}) if $self->{1}; # may reap_compress
        $self->close if $self->{-event_init_done}; # PublicInbox::DS::close
 }
@@ -1252,29 +1240,13 @@ sub lazy_start {
 
 sub busy { 1 } # prevent daemon-shutdown if client is connected
 
-# for users w/o Socket::Msghdr installed or Inline::C enabled
-sub oneshot {
-       my ($main_pkg) = @_;
-       my $exit = $main_pkg->can('exit'); # caller may override exit()
-       local $quit = $exit if $exit;
-       local %PATH2CFG;
-       umask(077) // die("umask(077): $!");
-       my $self = bless { oneshot => 1, env => \%ENV }, __PACKAGE__;
-       for (0..2) { open($self->{$_}, '+<&=', $_) or die "open fd=$_: $!" }
-       dispatch($self, @ARGV);
-       x_it($self, $self->{child_error}) if $self->{child_error};
-}
-
 # ensures stdout hits the FS before sock disconnects so a client
 # can immediately reread it
 sub DESTROY {
        my ($self) = @_;
        $self->{1}->autoflush(1) if $self->{1};
        stop_pager($self);
-       my $err = $?;
-       my $oneshot_pids = delete $self->{"pid.$self.$$"} or return;
-       waitpid($_, 0) for keys %$oneshot_pids;
-       $? = $err if $err; # preserve ->fail or ->x_it code
+       # preserve $? for ->fail or ->x_it code
 }
 
 sub wq_done_wait { # dwaitpid callback
@@ -1286,6 +1258,12 @@ sub wq_done_wait { # dwaitpid callback
        $lei->dclose;
 }
 
+sub fchdir {
+       my ($lei) = @_;
+       my $dh = $lei->{3} // die 'BUG: lei->{3} (CWD) gone';
+       chdir($dh) || $lei->fail("fchdir: $!");
+}
+
 sub wq_eof { # EOF callback for main daemon
        my ($lei) = @_;
        my $wq1 = delete $lei->{wq1} // return $lei->fail; # already failed