daemon: support per-listener env, .psgi, out, err

This allows memory savings by allowing multiple, completely
unrelated-PSGI apps to run within the same process as IMAP,
NNTP, and POP3.

5 files changed, 113 insertions, 84 deletions

diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index 1af03cc4..0392d15f 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -10,6 +10,7 @@ use v5.10.1;
 use Getopt::Long qw(:config gnu_getopt no_ignore_case auto_abbrev);
 use IO::Handle; # ->autoflush
 use IO::Socket;
+use File::Spec;
 use POSIX qw(WNOHANG :signal_h);
 use Socket qw(IPPROTO_TCP SOL_SOCKET);
 STDOUT->autoflush(1);
@@ -27,7 +28,7 @@ my ($set_user, $oldset);
 my (@cfg_listen, $stdout, $stderr, $group, $user, $pid_file, $daemonize);
 my $worker_processes = 1;
 my @listeners;
-my %pids;
+my (%pids, %logs);
 my %tls_opt; # scheme://sockname => args for IO::Socket::SSL->start_SSL
 my $reexec_pid;
 my ($uid, $gid);
@@ -35,24 +36,31 @@ my ($default_cert, $default_key);
 my %KNOWN_TLS = (443 => 'https', 563 => 'nntps', 993 => 'imaps', 995 =>'pop3s');
 my %KNOWN_STARTTLS = (110 => 'pop3', 119 => 'nntp', 143 => 'imap');
 
-sub accept_tls_opt ($) {
-        my ($opt_str) = @_;
-        # opt_str: opt1=val1,opt2=val2 (opt may repeat for multi-value)
-        require PublicInbox::TLS;
+sub listener_opt ($) {
+        my ($str) = @_; # opt1=val1,opt2=val2 (opt may repeat for multi-value)
         my $o = {};
         # allow ',' as delimiter since '&' is shell-unfriendly
-        foreach (split(/[,&]/, $opt_str)) {
+        for (split(/[,&]/, $str)) {
                 my ($k, $v) = split(/=/, $_, 2);
-                push @{$o->{$k} ||= []}, $v;
+                push @{$o->{$k}}, $v;
         }
 
         # key may be a part of cert.  At least
         # p5-io-socket-ssl/example/ssl_server.pl has this fallback:
-        $o->{cert} //= [ $default_cert ];
+        $o->{cert} //= [ $default_cert ] if defined($default_cert);
         $o->{key} //= defined($default_key) ? [ $default_key ] : $o->{cert};
+        $o;
+}
+
+sub accept_tls_opt ($) {
+        my ($opt) = @_;
+        my $o = ref($opt) eq 'HASH' ? $opt : listener_opt($opt);
+        return if !defined($o->{cert});
+        require PublicInbox::TLS;
         my %ctx_opt = (SSL_server => 1);
         # parse out hostname:/path/to/ mappings:
-        foreach my $k (qw(cert key)) {
+        for my $k (qw(cert key)) {
+                $o->{$k} // next;
                 my $x = $ctx_opt{'SSL_'.$k.'_file'} = {};
                 foreach my $path (@{$o->{$k}}) {
                         my $host = '';
@@ -75,18 +83,61 @@ sub accept_tls_opt ($) {
         { SSL_server => 1, SSL_startHandshake => 0, SSL_reuse_ctx => $ctx };
 }
 
-sub load_mod ($) {
-        my ($scheme) = @_;
+sub check_absolute ($$) {
+        my ($var, $val) = @_;
+        die <<EOM if index($val // '/', '/') != 0;
+$var must be an absolute path when using --daemonize: $val
+EOM
+}
+
+sub do_chown ($) {
+        $uid // return;
+        my ($path) = @_;
+        chown($uid, $gid, $path) or warn "chown $path: $!\n";
+}
+
+sub open_log_path ($$) { # my ($fh, $path) = @_; # $_[0] is modified
+        open $_[0], '>>', $_[1] or die "open(>> $_[1]): $!";
+        $_[0]->autoflush(1);
+        do_chown($_[1]);
+}
+
+sub load_mod ($;$) {
+        my ($scheme, $opt) = @_;
         my $modc = "PublicInbox::\U$scheme";
         my $mod = $modc.'D';
         eval "require $mod"; # IMAPD|HTTPD|NNTPD|POP3D
         die $@ if $@;
         my %xn;
         my $tlsd = $xn{tlsd} = $mod->new;
-        $xn{refresh} = sub { $tlsd->refresh_groups(@_) };
+        my %env = map {
+                substr($_, length('env.')) => $opt->{$_}->[-1];
+        } grep(/\Aenv\./, keys %$opt);
+        $xn{refresh} = sub {
+                my ($sig) = @_;
+                local @ENV{keys %env} = values %env;
+                $tlsd->refresh_groups($sig);
+        };
         $xn{post_accept} = $tlsd->can('post_accept_cb') ?
                         $tlsd->post_accept_cb : sub { $modc->new($_[0], $tlsd) };
-        $xn{af_default} = 'httpready' if $modc eq 'PublicInbox::HTTP';
+        my @paths = qw(out err);
+        if ($modc eq 'PublicInbox::HTTP') {
+                @paths = qw(err);
+                $xn{af_default} = 'httpready';
+                if (my $p = $opt->{psgi}) {
+                        die "multiple psgi= options specified\n" if @$p > 1;
+                        check_absolute('psgi=', $p->[0]) if $daemonize;
+                        $tlsd->{psgi} = $p->[0];
+                }
+        }
+        for my $f (@paths) {
+                my $p = $opt->{$f} or next;
+                die "multiple $f= options specified\n" if @$p > 1;
+                check_absolute("$f=", $p->[0]) if $daemonize;
+                $p = File::Spec->canonpath($p->[0]);
+                open_log_path(my $fh, $p);
+                $tlsd->{$f} = $logs{$p} = $fh;
+        }
         \%xn;
 }
 
@@ -125,6 +176,7 @@ EOF
         GetOptions(%opt) or die $help;
         if ($show_help) { print $help; exit 0 };
 
+        $_ = File::Spec->canonpath($_ // next) for ($stdout, $stderr);
         if (defined $pid_file && $pid_file =~ /\.oldbin\z/) {
                 die "--pid-file cannot end with '.oldbin'\n";
         }
@@ -151,15 +203,17 @@ EOF
                         my $s = $KNOWN_TLS{$1} // $KNOWN_STARTTLS{$1};
                         $scheme = $s if defined $s;
                 }
+                my $opt; # non-TLS options
                 if ($l =~ s!/?\?(.+)\z!!) {
-                        $tls_opt{"$scheme://$l"} = accept_tls_opt($1);
+                        $opt = listener_opt($1);
+                        $tls_opt{"$scheme://$l"} = accept_tls_opt($opt);
                 } elsif (defined($default_cert)) {
                         $tls_opt{"$scheme://$l"} = accept_tls_opt('');
                 } elsif ($scheme =~ /\A(?:https|imaps|nntps|pop3s)\z/) {
                         die "$orig specified w/o cert=\n";
                 }
                 $scheme =~ /\A(http|imap|nntp|pop3)/ and
-                        $xnetd->{$l} = load_mod($1);
+                        $xnetd->{$l} = load_mod($1, $opt);
 
                 next if $listener_names->{$l}; # already inherited
                 my (%o, $sock_pkg);
@@ -212,18 +266,12 @@ EOF
                         $tls_opt{''} ||= accept_tls_opt('');
                 }
         }
-
+        my @d;
+        while (my ($k, $v) = each %tls_opt) { push(@d, $k) if !defined($v) }
+        delete @tls_opt{@d};
         die "No listeners bound\n" unless @listeners;
 }
 
-sub check_absolute ($$) {
-        my ($var, $val) = @_;
-        if (defined $val && index($val, '/') != 0) {
-                die
-"--$var must be an absolute path when using --daemonize: $val\n";
-        }
-}
-
 sub daemonize () {
         if ($daemonize) {
                 require Cwd;
@@ -232,9 +280,9 @@ sub daemonize () {
                         next unless -e $arg;
                         $ARGV[$i] = Cwd::abs_path($arg);
                 }
-                check_absolute('stdout', $stdout);
-                check_absolute('stderr', $stderr);
-                check_absolute('pid-file', $pid_file);
+                check_absolute('--stdout', $stdout);
+                check_absolute('--stderr', $stderr);
+                check_absolute('--pid-file', $pid_file);
 
                 chdir '/' or die "chdir failed: $!";
         }
@@ -317,18 +365,9 @@ sub worker_quit { # $_[0] = signal name or number (unused)
 }
 
 sub reopen_logs {
-        if ($stdout) {
-                open STDOUT, '>>', $stdout or
-                        warn "failed to redirect stdout to $stdout: $!\n";
-                STDOUT->autoflush(1);
-                do_chown($stdout);
-        }
-        if ($stderr) {
-                open STDERR, '>>', $stderr or
-                        warn "failed to redirect stderr to $stderr: $!\n";
-                STDERR->autoflush(1);
-                do_chown($stderr);
-        }
+        $logs{$stdout} //= \*STDOUT if defined $stdout;
+        $logs{$stderr} //= \*STDERR if defined $stderr;
+        while (my ($p, $fh) = each %logs) { open_log_path($fh, $p) }
 }
 
 sub sockname ($) {
@@ -688,13 +727,6 @@ sub run {
         # ->DESTROY runs when $for_destroy goes out-of-scope
 }
 
-sub do_chown ($) {
-        my ($path) = @_;
-        if (defined $uid and !chown($uid, $gid, $path)) {
-                warn "could not chown $path: $!\n";
-        }
-}
-
 sub write_pid ($) {
         my ($path) = @_;
         Net::Server::Daemonize::create_pid_file($path);
diff --git a/lib/PublicInbox/HTTPD.pm b/lib/PublicInbox/HTTPD.pm
index bcdbb9f9..e531ee70 100644
--- a/lib/PublicInbox/HTTPD.pm
+++ b/lib/PublicInbox/HTTPD.pm
@@ -16,7 +16,7 @@ sub pi_httpd_async { PublicInbox::HTTPD::Async->new(@_) }
 # we have a different env for ever listener socket for
 # SERVER_NAME, SERVER_PORT and psgi.url_scheme
 # envs: listener FD => PSGI env
-sub new { bless { envs => {} }, __PACKAGE__ }
+sub new { bless { envs => {}, err => \*STDERR }, __PACKAGE__ }
 
 # this becomes {srv_env} in PublicInbox::HTTP
 sub env_for ($$$) {
@@ -28,7 +28,7 @@ sub env_for ($$$) {
                 SERVER_PORT => $port,
                 SCRIPT_NAME => '',
                 'psgi.version' => [ 1, 1 ],
-                'psgi.errors' => \*STDERR,
+                'psgi.errors' => $self->{err},
                 'psgi.url_scheme' => $client->can('accept_SSL') ?
                                         'https' : 'http',
                 'psgi.nonblocking' => Plack::Util::TRUE,
@@ -53,8 +53,9 @@ sub env_for ($$$) {
 sub refresh_groups {
         my ($self) = @_;
         my $app;
-        if (@main::ARGV) {
-                eval { $app = Plack::Util::load_psgi(@ARGV) };
+        $self->{psgi} //= $main::ARGV[0] if @main::ARGV;
+        if ($self->{psgi}) {
+                eval { $app = Plack::Util::load_psgi($self->{psgi}) };
                 die $@, <<EOM if $@;
 $0 runs in /, command-line paths must be absolute
 EOM
diff --git a/lib/PublicInbox/IMAPD.pm b/lib/PublicInbox/IMAPD.pm
index b24097a2..9a5bdcfe 100644
--- a/lib/PublicInbox/IMAPD.pm
+++ b/lib/PublicInbox/IMAPD.pm
@@ -1,8 +1,7 @@
 # Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 
-# represents an IMAPD (currently a singleton),
-# see script/public-inbox-imapd for how it is used
+# represents an IMAPD, see script/public-inbox-imapd for how it is used
 package PublicInbox::IMAPD;
 use strict;
 use v5.10.1;
diff --git a/lib/PublicInbox/NNTPD.pm b/lib/PublicInbox/NNTPD.pm
index f31d4381..9e232ef6 100644
--- a/lib/PublicInbox/NNTPD.pm
+++ b/lib/PublicInbox/NNTPD.pm
@@ -13,21 +13,10 @@ use PublicInbox::NNTP;
 
 sub new {
         my ($class) = @_;
-        my $pi_cfg = PublicInbox::Config->new;
-        my $name = $pi_cfg->{'publicinbox.nntpserver'};
-        if (!defined($name) or $name eq '') {
-                $name = hostname;
-        } elsif (ref($name) eq 'ARRAY') {
-                $name = $name->[0];
-        }
-
         bless {
-                groups => {},
                 err => \*STDERR,
                 out => \*STDOUT,
-                pi_cfg => $pi_cfg,
-                servername => $name,
-                greet => \"201 $name ready - post via email\r\n",
+                # pi_cfg => $pi_cfg,
                 # accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
                 # idler => PublicInbox::InboxIdle
         }, $class;
@@ -35,7 +24,17 @@ sub new {
 
 sub refresh_groups {
         my ($self, $sig) = @_;
-        my $pi_cfg = $sig ? PublicInbox::Config->new : $self->{pi_cfg};
+        my $pi_cfg = PublicInbox::Config->new;
+        my $name = $pi_cfg->{'publicinbox.nntpserver'};
+        if (!defined($name) or $name eq '') {
+                $name = hostname;
+        } elsif (ref($name) eq 'ARRAY') {
+                $name = $name->[0];
+        }
+        if ($name ne ($self->{servername} // '')) {
+                $self->{servername} = $name;
+                $self->{greet} = \"201 $name ready - post via email\r\n";
+        }
         my $groups = $pi_cfg->{-by_newsgroup}; # filled during each_inbox
         my $cache = eval { $pi_cfg->ALL->misc->nntpd_cache_load } // {};
         $pi_cfg->each_inbox(sub {
diff --git a/lib/PublicInbox/POP3D.pm b/lib/PublicInbox/POP3D.pm
index 0609627e..5cfe9613 100644
--- a/lib/PublicInbox/POP3D.pm
+++ b/lib/PublicInbox/POP3D.pm
@@ -1,7 +1,7 @@
 # Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 
-# represents an POP3D (currently a singleton)
+# represents an POP3D
 package PublicInbox::POP3D;
 use v5.12;
 use parent qw(PublicInbox::Lock);
@@ -37,20 +37,12 @@ if ($^O eq 'linux' || $^O eq 'freebsd') {
         die "File::FcntlLock required for POP3 on $^O: $@\n";
 
 sub new {
-        my ($cls, $pi_cfg) = @_;
-        $pi_cfg //= PublicInbox::Config->new;
-        my $d = $pi_cfg->{'publicinbox.pop3state'} //
-                die "publicinbox.pop3state undefined\n";
-        -d $d or do {
-                require File::Path;
-                File::Path::make_path($d, { mode => 0700 });
-                PublicInbox::Syscall::nodatacow_dir($d);
-        };
+        my ($cls) = @_;
         bless {
                 err => \*STDERR,
                 out => \*STDOUT,
-                pi_cfg => $pi_cfg,
-                lock_path => "$d/db.lock", # PublicInbox::Lock to protect SQLite
+                # pi_cfg => PublicInbox::Config
+                # lock_path => ...
                 # interprocess lock is the $pop3state/txn.locks file
                 # txn_locks => {}, # intraworker locks
                 # accept_tls => { SSL_server => 1, ..., SSL_reuse_ctx => ... }
@@ -61,16 +53,22 @@ sub refresh_groups { # PublicInbox::Daemon callback
         my ($self, $sig) = @_;
         # TODO share pi_cfg with nntpd/imapd inside -netd
         my $new = PublicInbox::Config->new;
-        my $old = $self->{pi_cfg};
-        my $s = 'publicinbox.pop3state';
-        $new->{$s} //= $old->{$s};
-        if ($new->{$s} ne $old->{$s}) {
-                warn <<EOM;
+        my $d = $new->{'publicinbox.pop3state'} //
+                die "publicinbox.pop3state undefined ($new->{-f})\n";
+        -d $d or do {
+                require File::Path;
+                File::Path::make_path($d, { mode => 0700 });
+                PublicInbox::Syscall::nodatacow_dir($d);
+        };
+        $self->{lock_path} //= "$d/db.lock";
+        if (my $old = $self->{pi_cfg}) {
+                my $s = 'publicinbox.pop3state';
+                $new->{$s} //= $old->{$s};
+                return warn <<EOM if $new->{$s} ne $old->{$s};
 $s changed: `$old->{$s}' => `$new->{$s}', config reload ignored
 EOM
-        } else {
-                $self->{pi_cfg} = $new;
         }
+        $self->{pi_cfg} = $new;
 }
 
 # persistent tables