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);
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);
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 = '';
{ 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 = map { $_ => $mod->can($_) } qw(refresh post_accept);
- $xn{tlsd} = $mod->new if $mod->can('refresh_groups'); #!HTTPD
- my $tlsd = $xn{tlsd};
- $xn{refresh} //= sub { $tlsd->refresh_groups(@_) };
- $xn{post_accept} //= sub { $modc->new($_[0], $tlsd) };
- $xn{af_default} = 'httpready' if $modc eq 'PublicInbox::HTTP';
+ my %xn;
+ my $tlsd = $xn{tlsd} = $mod->new;
+ 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) };
+ 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;
}
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";
}
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);
$tls_opt{"$scheme://$sockname"} ||= accept_tls_opt('');
} elsif (($scheme = $KNOWN_STARTTLS{$1})) {
$xnetd->{$sockname} = load_mod($scheme);
- next if $tls_opt{"$scheme://$sockname"};
+ $tls_opt{"$scheme://$sockname"} ||= accept_tls_opt('');
$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;
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: $!";
}
}
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 ($) {
# ->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);