]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/Daemon.pm
update copyrights for 2021
[public-inbox.git] / lib / PublicInbox / Daemon.pm
index c7a71ba0552f75a3fd9f6a87f7527564f3d0fd8d..4dcb5fb6f927f416b0e4b2574b7b965535be3637 100644 (file)
@@ -1,40 +1,38 @@
-# Copyright (C) 2015-2019 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2021 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-# contains common daemon code for the nntpd and httpd servers.
-# This may be used for read-only IMAP server if we decide to implement it.
+#
+# Contains common daemon code for the httpd, imapd, and nntpd servers
+# and designed for handling thousands of untrusted clients over slow
+# and/or lossy connections.
 package PublicInbox::Daemon;
 use strict;
 use warnings;
 use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
-use IO::Handle;
+use IO::Handle; # ->autoflush
 use IO::Socket;
 use POSIX qw(WNOHANG :signal_h);
 use Socket qw(IPPROTO_TCP SOL_SOCKET);
 sub SO_ACCEPTFILTER () { 0x1000 }
-use Cwd qw/abs_path/;
 STDOUT->autoflush(1);
 STDERR->autoflush(1);
 use PublicInbox::DS qw(now);
 use PublicInbox::Syscall qw(SFD_NONBLOCK);
-require PublicInbox::EvCleanup;
 require PublicInbox::Listener;
-require PublicInbox::ParentPipe;
-require PublicInbox::Sigfd;
+use PublicInbox::EOFpipe;
+use PublicInbox::Sigfd;
+use PublicInbox::GitAsyncCat;
 my @CMD;
-my ($set_user, $oldset, $newset);
+my ($set_user, $oldset);
 my (@cfg_listen, $stdout, $stderr, $group, $user, $pid_file, $daemonize);
 my $worker_processes = 1;
 my @listeners;
 my %pids;
-my %listener_names; # sockname => IO::Handle
 my %tls_opt; # scheme://sockname => args for IO::Socket::SSL->start_SSL
 my $reexec_pid;
-my $cleanup;
 my ($uid, $gid);
 my ($default_cert, $default_key);
-END { $cleanup->() if $cleanup };
-my %KNOWN_TLS = ( 443 => 'https', 563 => 'nntps' );
-my %KNOWN_STARTTLS = ( 119 => 'nntp' );
+my %KNOWN_TLS = ( 443 => 'https', 563 => 'nntps', 993 => 'imaps' );
+my %KNOWN_STARTTLS = ( 119 => 'nntp', 143 => 'imap' );
 
 sub accept_tls_opt ($) {
        my ($opt_str) = @_;
@@ -76,16 +74,25 @@ sub accept_tls_opt ($) {
        { SSL_server => 1, SSL_startHandshake => 0, SSL_reuse_ctx => $ctx };
 }
 
-sub sig_setmask { sigprocmask(SIG_SETMASK, @_) or die "sigprocmask: $!" }
-
 sub daemon_prepare ($) {
        my ($default_listen) = @_;
-       $oldset = POSIX::SigSet->new();
-       $newset = POSIX::SigSet->new();
-       $newset->fillset or die "fillset: $!";
-       sig_setmask($newset, $oldset);
+       my $listener_names = {}; # sockname => IO::Handle
+       $oldset = PublicInbox::Sigfd::block_signals();
        @CMD = ($0, @ARGV);
-       my %opts = (
+       my ($prog) = ($CMD[0] =~ m!([^/]+)\z!g);
+       my $help = <<EOF;
+usage: $prog [-l ADDRESS] [--cert=FILE] [--key=FILE]
+
+options:
+
+  -l ADDRESS    address to listen on (default: $default_listen)
+  --cert=FILE   default SSL/TLS certificate
+  --key=FILE    default SSL/TLS certificate
+  -W WORKERS    number of worker processes to spawn (default: 1)
+
+See public-inbox-daemon(8) and $prog(1) man pages for more.
+EOF
+       my %opt = (
                'l|listen=s' => \@cfg_listen,
                '1|stdout=s' => \$stdout,
                '2|stderr=s' => \$stderr,
@@ -96,17 +103,19 @@ sub daemon_prepare ($) {
                'D|daemonize' => \$daemonize,
                'cert=s' => \$default_cert,
                'key=s' => \$default_key,
+               'help|h' => \(my $show_help),
        );
-       GetOptions(%opts) or die "bad command-line args\n";
+       GetOptions(%opt) or die $help;
+       if ($show_help) { print $help; exit 0 };
 
        if (defined $pid_file && $pid_file =~ /\.oldbin\z/) {
                die "--pid-file cannot end with '.oldbin'\n";
        }
-       @listeners = inherit();
+       @listeners = inherit($listener_names);
 
        # allow socket-activation users to set certs once and not
        # have to configure each socket:
-       my @inherited_names = keys(%listener_names) if defined($default_cert);
+       my @inherited_names = keys(%$listener_names) if defined($default_cert);
 
        # ignore daemonize when inheriting
        $daemonize = undef if scalar @listeners;
@@ -126,12 +135,12 @@ sub daemon_prepare ($) {
                        $tls_opt{"$scheme://$l"} = accept_tls_opt($1);
                } elsif (defined($default_cert)) {
                        $tls_opt{"$scheme://$l"} = accept_tls_opt('');
-               } elsif ($scheme =~ /\A(?:nntps|https)\z/) {
+               } elsif ($scheme =~ /\A(?:https|imaps|imaps)\z/) {
                        die "$orig specified w/o cert=\n";
                }
                # TODO: use scheme to load either NNTP.pm or HTTP.pm
 
-               next if $listener_names{$l}; # already inherited
+               next if $listener_names->{$l}; # already inherited
                my (%o, $sock_pkg);
                if (index($l, '/') == 0) {
                        $sock_pkg = 'IO::Socket::UNIX';
@@ -162,7 +171,7 @@ sub daemon_prepare ($) {
                warn "error binding $l: $! ($@)\n" unless $s;
                umask $prev;
                if ($s) {
-                       $listener_names{sockname($s)} = $s;
+                       $listener_names->{sockname($s)} = $s;
                        $s->blocking(0);
                        push @listeners, $s;
                }
@@ -194,10 +203,11 @@ sub check_absolute ($$) {
 
 sub daemonize () {
        if ($daemonize) {
+               require Cwd;
                foreach my $i (0..$#ARGV) {
                        my $arg = $ARGV[$i];
                        next unless -e $arg;
-                       $ARGV[$i] = abs_path($arg);
+                       $ARGV[$i] = Cwd::abs_path($arg);
                }
                check_absolute('stdout', $stdout);
                check_absolute('stderr', $stderr);
@@ -205,16 +215,12 @@ sub daemonize () {
 
                chdir '/' or die "chdir failed: $!";
        }
-
-       return unless (defined $pid_file || defined $group || defined $user
-                       || $daemonize);
-
-       eval { require Net::Server::Daemonize };
-       if ($@) {
-               die
-"Net::Server required for --pid-file, --group, --user, and --daemonize\n$@\n";
+       if (defined($pid_file) || defined($group) || defined($user)) {
+               eval { require Net::Server::Daemonize; 1 } // die <<EOF;
+Net::Server required for --pid-file, --group, --user
+$@
+EOF
        }
-
        Net::Server::Daemonize::check_pid_file($pid_file) if defined $pid_file;
        $uid = Net::Server::Daemonize::get_uid($user) if defined $user;
        if (defined $group) {
@@ -233,8 +239,7 @@ sub daemonize () {
        };
 
        if ($daemonize) {
-               my $pid = fork;
-               die "could not fork: $!\n" unless defined $pid;
+               my $pid = fork // die "fork: $!";
                exit if $pid;
 
                open(STDIN, '+<', '/dev/null') or
@@ -242,18 +247,14 @@ sub daemonize () {
                open STDOUT, '>&STDIN' or die "redirect stdout failed: $!\n";
                open STDERR, '>&STDIN' or die "redirect stderr failed: $!\n";
                POSIX::setsid();
-               $pid = fork;
-               die "could not fork: $!\n" unless defined $pid;
+               $pid = fork // die "fork: $!";
                exit if $pid;
        }
-       if (defined $pid_file) {
-               write_pid($pid_file);
-               my $unlink_pid = $$;
-               $cleanup = sub {
-                       $cleanup = undef; # avoid cyclic reference
-                       unlink_pid_file_safe_ish($unlink_pid, $pid_file);
-               };
-       }
+       return unless defined $pid_file;
+
+       write_pid($pid_file);
+       # for ->DESTROY:
+       bless { pid => $$, pid_file => \$pid_file }, __PACKAGE__;
 }
 
 sub worker_quit { # $_[0] = signal name or number (unused)
@@ -359,7 +360,8 @@ sub host_with_port ($) {
        $@ ? ('127.0.0.1', 0) : ($host, $port);
 }
 
-sub inherit () {
+sub inherit ($) {
+       my ($listener_names) = @_;
        return () if ($ENV{LISTEN_PID} || 0) != $$;
        my $fds = $ENV{LISTEN_FDS} or return ();
        my $end = $fds + 2; # LISTEN_FDS_START - 1
@@ -367,15 +369,13 @@ sub inherit () {
        foreach my $fd (3..$end) {
                my $s = IO::Handle->new_from_fd($fd, 'r');
                if (my $k = sockname($s)) {
-                       if ($s->blocking) {
-                               $s->blocking(0);
-                               warn <<"";
+                       my $prev_was_blocking = $s->blocking(0);
+                       warn <<"" if $prev_was_blocking;
 Inherited socket (fd=$fd) is blocking, making it non-blocking.
 Set 'NonBlocking = true' in the systemd.service unit to avoid stalled
 processes when multiple service instances start.
 
-                       }
-                       $listener_names{$k} = $s;
+                       $listener_names->{$k} = $s;
                        push @rv, $s;
                } else {
                        warn "failed to inherit fd=$fd (LISTEN_FDS=$fds)";
@@ -408,6 +408,9 @@ sub upgrade { # $_[0] = signal name or number (unused)
                $ENV{LISTEN_FDS} = scalar @listeners;
                $ENV{LISTEN_PID} = $$;
                foreach my $s (@listeners) {
+                       # @listeners are globs with workers, PI::L w/o workers
+                       $s = $s->{sock} if ref($s) eq 'PublicInbox::Listener';
+
                        my $fl = fcntl($s, F_GETFD, 0);
                        fcntl($s, F_SETFD, $fl &= ~FD_CLOEXEC);
                }
@@ -418,11 +421,8 @@ sub upgrade { # $_[0] = signal name or number (unused)
 }
 
 sub kill_workers ($) {
-       my ($s) = @_;
-
-       while (my ($pid, $id) = each %pids) {
-               kill $s, $pid;
-       }
+       my ($sig) = @_;
+       kill $sig, keys(%pids);
 }
 
 sub upgrade_aborted ($) {
@@ -467,23 +467,25 @@ sub unlink_pid_file_safe_ish ($$) {
        }
 }
 
+sub master_quit ($) {
+       exit unless @listeners;
+       @listeners = ();
+       kill_workers($_[0]);
+}
+
 sub master_loop {
        pipe(my ($p0, $p1)) or die "failed to create parent-pipe: $!";
-       # 1031: F_SETPIPE_SZ, 4096: page size
-       fcntl($p1, 1031, 4096) if $^O eq 'linux';
        my $set_workers = $worker_processes;
        reopen_logs();
-       my $quit = 0;
        my $ignore_winch;
-       my $quit_cb = sub { exit if $quit++; kill_workers($_[0]) };
        my $sig = {
                USR1 => sub { reopen_logs(); kill_workers($_[0]); },
                USR2 => \&upgrade,
-               QUIT => $quit_cb,
-               INT => $quit_cb,
-               TERM => $quit_cb,
+               QUIT => \&master_quit,
+               INT => \&master_quit,
+               TERM => \&master_quit,
                WINCH => sub {
-                       return if $ignore_winch;
+                       return if $ignore_winch || !@listeners;
                        if (-t STDIN || -t STDOUT || -t STDERR) {
                                $ignore_winch = 1;
                                warn <<EOF;
@@ -494,10 +496,12 @@ EOF
                        }
                },
                HUP => sub {
+                       return unless @listeners;
                        $worker_processes = $set_workers;
                        kill_workers($_[0]);
                },
                TTIN => sub {
+                       return unless @listeners;
                        if ($set_workers > $worker_processes) {
                                ++$worker_processes;
                        } else {
@@ -511,10 +515,10 @@ EOF
        };
        my $sigfd = PublicInbox::Sigfd->new($sig, 0);
        local %SIG = (%SIG, %$sig) if !$sigfd;
-       sig_setmask($oldset) if !$sigfd;
+       PublicInbox::Sigfd::sig_setmask($oldset) if !$sigfd;
        while (1) { # main loop
                my $n = scalar keys %pids;
-               if ($quit) {
+               unless (@listeners) {
                        exit if $n == 0;
                        $set_workers = $worker_processes = $n = 0;
                }
@@ -527,7 +531,7 @@ EOF
                }
                my $want = $worker_processes - 1;
                if ($n <= $want) {
-                       sig_setmask($newset) if !$sigfd;
+                       PublicInbox::Sigfd::block_signals() if !$sigfd;
                        for my $i ($n..$want) {
                                my $pid = fork;
                                if (!defined $pid) {
@@ -540,7 +544,7 @@ EOF
                                        $pids{$pid} = $i;
                                }
                        }
-                       sig_setmask($oldset) if !$sigfd;
+                       PublicInbox::Sigfd::sig_setmask($oldset) if !$sigfd;
                }
 
                if ($sigfd) { # Linux and IO::KQueue users:
@@ -565,11 +569,12 @@ sub defer_accept ($$) {
        my ($s, $af_name) = @_;
        return unless defined $af_name;
        if ($^O eq 'linux') {
-               my $x = getsockopt($s, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT());
+               my $TCP_DEFER_ACCEPT = 9; # Socket::TCP_DEFER_ACCEPT is in 5.14+
+               my $x = getsockopt($s, IPPROTO_TCP, $TCP_DEFER_ACCEPT);
                return unless defined $x; # may be Unix socket
                my $sec = unpack('i', $x);
                return if $sec > 0; # systemd users may set a higher value
-               setsockopt($s, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT(), 1);
+               setsockopt($s, IPPROTO_TCP, $TCP_DEFER_ACCEPT, 1);
        } elsif ($^O eq 'freebsd') {
                my $x = getsockopt($s, SOL_SOCKET, SO_ACCEPTFILTER);
                return if defined $x; # don't change if set
@@ -579,14 +584,13 @@ sub defer_accept ($$) {
 }
 
 sub daemon_loop ($$$$) {
-       my ($refresh, $post_accept, $nntpd, $af_default) = @_;
-       PublicInbox::EvCleanup::enable(); # early for $refresh
+       my ($refresh, $post_accept, $tlsd, $af_default) = @_;
        my %post_accept;
        while (my ($k, $v) = each %tls_opt) {
-               if ($k =~ s!\A(?:nntps|https)://!!) {
+               if ($k =~ s!\A(?:https|imaps|nntps)://!!) {
                        $post_accept{$k} = tls_start_cb($v, $post_accept);
-               } elsif ($nntpd) { # STARTTLS, $k eq '' is OK
-                       $nntpd->{accept_tls} = $v;
+               } elsif ($tlsd) { # STARTTLS, $k eq '' is OK
+                       $tlsd->{accept_tls} = $v;
                }
        }
        my $sig = {
@@ -601,11 +605,10 @@ sub daemon_loop ($$$$) {
                WINCH => 'IGNORE',
                CHLD => \&PublicInbox::DS::enqueue_reap,
        };
-       my $parent_pipe;
        if ($worker_processes > 0) {
                $refresh->(); # preload by default
                my $fh = master_loop(); # returns if in child process
-               $parent_pipe = PublicInbox::ParentPipe->new($fh, *worker_quit);
+               PublicInbox::EOFpipe->new($fh, \&worker_quit, undef);
        } else {
                reopen_logs();
                $set_user->() if $set_user;
@@ -617,8 +620,8 @@ sub daemon_loop ($$$$) {
        @listeners = map {;
                my $tls_cb = $post_accept{sockname($_)};
 
-               # NNTPS, HTTPS, HTTP, and POP3S are client-first traffic
-               # NNTP and POP3 are server-first
+               # NNTPS, HTTPS, HTTP, IMAPS and POP3S are client-first traffic
+               # IMAP, NNTP and POP3 are server-first
                defer_accept($_, $tls_cb ? 'dataready' : $af_default);
 
                # this calls epoll_create:
@@ -629,20 +632,25 @@ sub daemon_loop ($$$$) {
        if (!$sigfd) {
                # wake up every second to accept signals if we don't
                # have signalfd or IO::KQueue:
-               sig_setmask($oldset);
+               PublicInbox::Sigfd::sig_setmask($oldset);
                PublicInbox::DS->SetLoopTimeout(1000);
        }
        PublicInbox::DS->EventLoop;
-       $parent_pipe = undef;
 }
 
-
 sub run ($$$;$) {
-       my ($default, $refresh, $post_accept, $nntpd) = @_;
+       my ($default, $refresh, $post_accept, $tlsd) = @_;
+       local $SIG{PIPE} = 'IGNORE';
        daemon_prepare($default);
        my $af_default = $default =~ /:8080\z/ ? 'httpready' : undef;
-       daemonize();
-       daemon_loop($refresh, $post_accept, $nntpd, $af_default);
+       my $for_destroy = daemonize();
+
+       # localize GCF2C for tests:
+       local $PublicInbox::GitAsyncCat::GCF2C;
+
+       daemon_loop($refresh, $post_accept, $tlsd, $af_default);
+       PublicInbox::DS->Reset;
+       # ->DESTROY runs when $for_destroy goes out-of-scope
 }
 
 sub do_chown ($) {
@@ -658,4 +666,8 @@ sub write_pid ($) {
        do_chown($path);
 }
 
+sub DESTROY {
+       unlink_pid_file_safe_ish($_[0]->{pid}, ${$_[0]->{pid_file}});
+}
+
 1;