]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/Spawn.pm
update copyrights for 2021
[public-inbox.git] / lib / PublicInbox / Spawn.pm
index b02d536866836cec97ecbfc82002793fc59dbd9c..1ee40503c33f0b014bb6814295d890e3335133e2 100644 (file)
@@ -1,31 +1,34 @@
-# Copyright (C) 2016-2019 all contributors <meta@public-inbox.org>
+# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 #
 # This allows vfork to be used for spawning subprocesses if
-# PERL_INLINE_DIRECTORY is explicitly defined in the environment.
+# ~/.cache/public-inbox/inline-c is writable or if PERL_INLINE_DIRECTORY
+# is explicitly defined in the environment (and writable).
 # Under Linux, vfork can make a big difference in spawning performance
 # as process size increases (fork still needs to mark pages for CoW use).
 # Currently, we only use this for code intended for long running
 # daemons (inside the PSGI code (-httpd) and -nntpd).  The short-lived
 # scripts (-mda, -index, -learn, -init) either use IPC::run or standard
 # Perl routines.
+#
+# There'll probably be more OS-level C stuff here, down the line.
+# We don't want too many DSOs: https://udrepper.livejournal.com/8790.html
 
 package PublicInbox::Spawn;
 use strict;
-use warnings;
-use base qw(Exporter);
+use parent qw(Exporter);
 use Symbol qw(gensym);
 use PublicInbox::ProcessPipe;
-our @EXPORT_OK = qw/which spawn popen_rd/;
-sub RLIMITS () { qw(RLIMIT_CPU RLIMIT_CORE RLIMIT_DATA) }
+our @EXPORT_OK = qw(which spawn popen_rd run_die nodatacow_dir);
+our @RLIMITS = qw(RLIMIT_CPU RLIMIT_CORE RLIMIT_DATA);
 
 my $vfork_spawn = <<'VFORK_SPAWN';
 #include <sys/types.h>
-#include <sys/uio.h>
 #include <sys/time.h>
 #include <sys/resource.h>
 #include <unistd.h>
 #include <stdlib.h>
+#include <errno.h>
 
 /* some platforms need alloca.h, but some don't */
 #if defined(__GNUC__) && !defined(alloca)
@@ -77,7 +80,7 @@ int pi_fork_exec(SV *redirref, SV *file, SV *cmdref, SV *envref, SV *rlimref,
        const char *filename = SvPV_nolen(file);
        pid_t pid;
        char **argv, **envp;
-       sigset_t set, old;
+       sigset_t set, old, cset;
        int ret, perrnum, cerrnum = 0;
 
        AV2C_COPY(argv, cmd);
@@ -87,6 +90,10 @@ int pi_fork_exec(SV *redirref, SV *file, SV *cmdref, SV *envref, SV *rlimref,
        assert(ret == 0 && "BUG calling sigfillset");
        ret = sigprocmask(SIG_SETMASK, &set, &old);
        assert(ret == 0 && "BUG calling sigprocmask to block");
+       ret = sigemptyset(&cset);
+       assert(ret == 0 && "BUG calling sigemptyset");
+       ret = sigaddset(&cset, SIGCHLD);
+       assert(ret == 0 && "BUG calling sigaddset for SIGCHLD");
        pid = vfork();
        if (pid == 0) {
                int sig;
@@ -119,9 +126,10 @@ int pi_fork_exec(SV *redirref, SV *file, SV *cmdref, SV *envref, SV *rlimref,
                }
 
                /*
-                * don't bother unblocking, we don't want signals
-                * to the group taking out a subprocess
+                * don't bother unblocking other signals for now, just SIGCHLD.
+                * we don't want signals to the group taking out a subprocess
                 */
+               (void)sigprocmask(SIG_UNBLOCK, &cset, NULL);
                execve(filename, argv, envp);
                exit_err(&cerrnum);
        }
@@ -140,8 +148,65 @@ int pi_fork_exec(SV *redirref, SV *file, SV *cmdref, SV *envref, SV *rlimref,
 }
 VFORK_SPAWN
 
-my $inline_dir = $ENV{PERL_INLINE_DIRECTORY};
-$vfork_spawn = undef unless defined $inline_dir && -d $inline_dir && -w _;
+# btrfs on Linux is copy-on-write (COW) by default.  As of Linux 5.7,
+# this still leads to fragmentation for SQLite and Xapian files where
+# random I/O happens, so we disable COW just for SQLite files and Xapian
+# directories.  Disabling COW disables checksumming, so we only do this
+# for regeneratable files, and not canonical git storage (git doesn't
+# checksum refs, only data under $GIT_DIR/objects).
+my $set_nodatacow = $^O eq 'linux' ? <<'SET_NODATACOW' : '';
+#include <sys/ioctl.h>
+#include <sys/vfs.h>
+#include <linux/magic.h>
+#include <linux/fs.h>
+#include <dirent.h>
+#include <errno.h>
+#include <stdio.h>
+#include <string.h>
+
+void nodatacow_fd(int fd)
+{
+       struct statfs buf;
+       int val = 0;
+
+       if (fstatfs(fd, &buf) < 0) {
+               fprintf(stderr, "fstatfs: %s\\n", strerror(errno));
+               return;
+       }
+
+       /* only btrfs is known to have this problem, so skip for non-btrfs */
+       if (buf.f_type != BTRFS_SUPER_MAGIC)
+               return;
+
+       if (ioctl(fd, FS_IOC_GETFLAGS, &val) < 0) {
+               fprintf(stderr, "FS_IOC_GET_FLAGS: %s\\n", strerror(errno));
+               return;
+       }
+       val |= FS_NOCOW_FL;
+       if (ioctl(fd, FS_IOC_SETFLAGS, &val) < 0)
+               fprintf(stderr, "FS_IOC_SET_FLAGS: %s\\n", strerror(errno));
+}
+
+void nodatacow_dir(const char *dir)
+{
+       DIR *dh = opendir(dir);
+       int fd;
+
+       if (!dh) croak("opendir(%s): %s", dir, strerror(errno));
+       fd = dirfd(dh);
+       if (fd >= 0)
+               nodatacow_fd(fd);
+       /* ENOTSUP probably won't happen under Linux... */
+       closedir(dh);
+}
+SET_NODATACOW
+
+my $inline_dir = $ENV{PERL_INLINE_DIRECTORY} //= (
+               $ENV{XDG_CACHE_HOME} //
+               ( ($ENV{HOME} // '/nonexistent').'/.cache' )
+       ).'/public-inbox/inline-c';
+
+$set_nodatacow = $vfork_spawn = undef unless -d $inline_dir && -w _;
 if (defined $vfork_spawn) {
        # Inline 0.64 or later has locking in multi-process env,
        # but we support 0.5 on Debian wheezy
@@ -150,14 +215,21 @@ if (defined $vfork_spawn) {
                my $f = "$inline_dir/.public-inbox.lock";
                open my $fh, '>', $f or die "failed to open $f: $!\n";
                flock($fh, LOCK_EX) or die "LOCK_EX failed on $f: $!\n";
-               eval 'use Inline C => $vfork_spawn'; #, BUILD_NOISY => 1';
+               eval 'use Inline C => $vfork_spawn . $set_nodatacow';
                my $err = $@;
+               my $ndc_err;
+               if ($err && $set_nodatacow) { # missing Linux kernel headers
+                       $ndc_err = $err;
+                       undef $set_nodatacow;
+                       eval 'use Inline C => $vfork_spawn';
+               }
                flock($fh, LOCK_UN) or die "LOCK_UN failed on $f: $!\n";
                die $err if $err;
+               warn $ndc_err if $ndc_err;
        };
        if ($@) {
                warn "Inline::C failed for vfork: $@\n";
-               $vfork_spawn = undef;
+               $set_nodatacow = $vfork_spawn = undef;
        }
 }
 
@@ -165,6 +237,14 @@ unless (defined $vfork_spawn) {
        require PublicInbox::SpawnPP;
        *pi_fork_exec = \&PublicInbox::SpawnPP::pi_fork_exec
 }
+unless ($set_nodatacow) {
+       require PublicInbox::NDC_PP;
+       no warnings 'once';
+       *nodatacow_fd = \&PublicInbox::NDC_PP::nodatacow_fd;
+       *nodatacow_dir = \&PublicInbox::NDC_PP::nodatacow_dir;
+}
+undef $set_nodatacow;
+undef $vfork_spawn;
 
 sub which ($) {
        my ($file) = @_;
@@ -199,7 +279,7 @@ sub spawn ($;$$) {
        }
        my $rlim = [];
 
-       foreach my $l (RLIMITS()) {
+       foreach my $l (@RLIMITS) {
                defined(my $v = $opts->{$l}) or next;
                my $r = eval "require BSD::Resource; BSD::Resource::$l();";
                unless (defined $r) {
@@ -210,7 +290,8 @@ sub spawn ($;$$) {
        }
        my $cd = $opts->{'-C'} // ''; # undef => NULL mapping doesn't work?
        my $pid = pi_fork_exec($redir, $f, $cmd, \@env, $rlim, $cd);
-       $pid < 0 ? undef : $pid;
+       die "fork_exec @$cmd failed: $!\n" unless $pid > 0;
+       $pid;
 }
 
 sub popen_rd {
@@ -225,4 +306,11 @@ sub popen_rd {
        $ret;
 }
 
+sub run_die ($;$$) {
+       my ($cmd, $env, $rdr) = @_;
+       my $pid = spawn($cmd, $env, $rdr);
+       waitpid($pid, 0) == $pid or die "@$cmd did not finish";
+       $? == 0 or die "@$cmd failed: \$?=$?\n";
+}
+
 1;