diff options
| -rw-r--r-- | lib/PublicInbox/LeiDaemon.pm | 55 | ||||
| -rw-r--r-- | t/lei.t | 31 |
2 files changed, 80 insertions, 6 deletions
diff --git a/lib/PublicInbox/LeiDaemon.pm b/lib/PublicInbox/LeiDaemon.pm index 1f170f1d..56f4aa7d 100644 --- a/lib/PublicInbox/LeiDaemon.pm +++ b/lib/PublicInbox/LeiDaemon.pm @@ -60,7 +60,7 @@ our %CMD = ( # sorted in order of importance/use: 'plonk' => [ '--thread|--from=IDENT', 'exclude mail matching From: or thread from non-Message-ID searches', - qw(thread|t stdin| from|f=s mid=s oid=s) ], + qw(stdin| thread|t from|f=s mid=s oid=s) ], 'mark' => [ 'MESSAGE_FLAGS...', 'set/unset flags on message(s) from stdin', qw(stdin| oid=s exact by-mid|mid:s) ], @@ -103,6 +103,8 @@ our %CMD = ( # sorted in order of importance/use: 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', + qw(clear| unset|u=s@ z|0) ], 'help' => [ '[SUBCOMMAND]', 'show help' ], # XXX do we need this? @@ -175,6 +177,16 @@ my %OPTDESC = ( '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', +'z|0' => 'use NUL \\0 instead of newline (CR) to delimit lines', + +# note: no "--ignore-environment" / "-i" support like env(1) since that +# is one-shot and this is for a persistent daemon: +'clear|' => 'clear the daemon environment', +'unset|u=s@' => ['NAME', + 'unset matching NAME, may be specified multiple times'], ); # %OPTDESC sub x_it ($$) { # pronounced "exit" @@ -257,7 +269,11 @@ sub _help ($;$) { join(', ', @allow) . " or $last"; } my $lhs = join(', ', @s, @l) . join('', @vals); - $lhs =~ s/\A--/ --/; # pad if no short options + if ($x =~ /\|\z/) { # "stdin|" or "clear|" + $lhs =~ s/\A--/- , --/; + } else { + $lhs =~ s/\A--/ --/; # pad if no short options + } $lpad = length($lhs) if length($lhs) > $lpad; push @opt_desc, $lhs, $desc; } @@ -289,9 +305,20 @@ sub optparse ($$$) { my $opt = $client->{opt} = {}; my $info = $CMD{$cmd} // [ '[...]', '(undocumented command)' ]; my ($proto, $desc, @spec) = @$info; - $glp->getoptionsfromarray($argv, $opt, @spec, qw(help|h)) or + 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); + push @spec, '' => \$var; + } + $glp->getoptionsfromarray($argv, $opt, @spec) or return _help($client, "bad arguments or options for $cmd"); return _help($client) if $opt->{help}; + + # "-" aliases "stdin" or "clear" + $opt->{$lone_dash} = ${$opt->{$lone_dash}} if defined $lone_dash; + my $i = 0; my $POS_ARG = '[A-Z][A-Z0-9_]+'; my ($err, $inf); @@ -461,12 +488,28 @@ E: leistore.dir=$cur already initialized and it is not $dir return qerr($client, $exists); } -sub lei_daemon_pid { - emit($_[0], 1, "$$\n"); -} +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}; + if (defined $opt->{clear}) { + %ENV = (); + } elsif (my $u = $opt->{unset}) { + delete @ENV{@$u}; + } + if (@argv) { + %ENV = (%ENV, map { split(/=/, $_, 2) } @argv); + } elsif (!defined($opt->{clear}) && !$opt->{unset}) { + my $eor = $opt->{z} ? "\0" : "\n"; + my $buf = ''; + while (my ($k, $v) = each %ENV) { $buf .= "$k=$v$eor" } + emit($client, 1, $buf) + } +} + sub lei_help { _help($_[0]) } sub reap_exec { # dwaitpid callback @@ -20,6 +20,7 @@ delete local $ENV{XDG_DATA_HOME}; delete local $ENV{XDG_CONFIG_HOME}; local $ENV{XDG_RUNTIME_DIR} = "$home/xdg_run"; local $ENV{HOME} = $home; +local $ENV{FOO} = 'BAR'; mkdir "$home/xdg_run", 0700 or BAIL_OUT "mkdir: $!"; my $test_lei_common = sub { @@ -104,6 +105,36 @@ SKIP: { chomp(my $pid_again = $out); is($pid, $pid_again, 'daemon-pid idempotent'); + $out = ''; + ok(run_script([qw(lei daemon-env -0)], undef, $opt), 'show env'); + is($err, '', 'no errors in env dump'); + my @env = split(/\0/, $out); + is(scalar grep(/\AHOME=\Q$home\E\z/, @env), 1, 'env has HOME'); + is(scalar grep(/\AFOO=BAR\z/, @env), 1, 'env has FOO=BAR'); + is(scalar grep(/\AXDG_RUNTIME_DIR=/, @env), 1, 'has XDG_RUNTIME_DIR'); + + $out = ''; + ok(run_script([qw(lei daemon-env -u FOO)], undef, $opt), 'unset'); + is($out.$err, '', 'no output for unset'); + ok(run_script([qw(lei daemon-env -0)], undef, $opt), 'show again'); + is($err, '', 'no errors in env dump'); + @env = split(/\0/, $out); + is(scalar grep(/\AFOO=BAR\z/, @env), 0, 'env unset FOO'); + + $out = ''; + ok(run_script([qw(lei daemon-env -u FOO -u HOME -u XDG_RUNTIME_DIR)], + undef, $opt), 'unset multiple'); + is($out.$err, '', 'no errors output for unset'); + ok(run_script([qw(lei daemon-env -0)], undef, $opt), 'show again'); + is($err, '', 'no errors in env dump'); + @env = split(/\0/, $out); + is(scalar grep(/\A(?:HOME|XDG_RUNTIME_DIR)=\z/, @env), 0, 'env unset@'); + $out = ''; + ok(run_script([qw(lei daemon-env -)], undef, $opt), 'clear env'); + is($out.$err, '', 'no output'); + ok(run_script([qw(lei daemon-env)], undef, $opt), 'env is empty'); + is($out, '', 'env cleared'); + ok(run_script([qw(lei daemon-stop)], undef, $opt), 'daemon-stop'); is($out, '', 'no output from daemon-stop'); is($err, '', 'no error from daemon-stop'); |