lei: support `daemon-env' for modifying long-lived env

While lei(1) socket connections can set environment variables
for its running context, it may not completely remove some of
them.  The background daemon just inherits whatever env the
client spawning it had.  This command ensures the persistent env
can be modified as needed.

Similar to env(1), this supports "-u", "-" (--clear), and
"-0"/"-z" switches.  It may be useful to unset or change
or even completely clear the environment independently
of what a socket client feeds us.

"-i" is omitted since "--ignore-environment" seems like a bad
name for a persistent daemon as opposed to a one-shot command.
"-" and --clear (like clearenv(3)) will completely clobber
the environment.

"Lonesome dash" support is added to our option/help parsing
for the "-" shortcut to "--clear".
Getopt::Long doesn't seem to support specs like "clear|" or
"stdin|", but only "", so we do a little pre/post-processing
to merge the cases.

diff --git a/lib/PublicInbox/LeiDaemon.pm b/lib/PublicInbox/LeiDaemon.pm
index 1f170f1d06fdffbc68d9aa9b8e149ed3b0276c47..56f4aa7daf9bd646d87503465d13ab9c854672b6 100644 (file)
--- 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

diff --git a/t/lei.t b/t/lei.t
index 507c7164902c7b81bc797aebeb4b74010de80597..53268908216291ff633db0415609945cebb82a33 100644 (file)
--- a/t/lei.t
+++ b/t/lei.t
@@ -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');