about summary refs log tree commit homepage
diff options
context:
space:
mode:
authorEric Wong <e@80x24.org>2019-06-10 09:52:13 +0000
committerEric Wong <e@80x24.org>2019-06-10 09:52:13 +0000
commitf5795a6092d6b4842e97bc67c11637d792961cb5 (patch)
tree30eada9950c7fbb745003645f41205fb0169f253
parentc44825f8b2f3d57f6aca29d75516db8712261954 (diff)
downloadpublic-inbox-malloc_info.tar.gz
If run with PERL_INLINE_DIRECTORY for Inline::C support
along with INBOX_DEBUG=malloc_info, we can allow users
to opt-in to compiling extra code to support the glibc
malloc_info(3) function.

We'll also add SIGCONT handler to dump the malloc_info(3)
output to stderr on our daemons.
-rw-r--r--MANIFEST1
-rw-r--r--lib/PublicInbox/Spawn.pm17
-rw-r--r--t/malloc_info.t25
3 files changed, 43 insertions, 0 deletions
diff --git a/MANIFEST b/MANIFEST
index 5085bff8..4a7f7ef9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -210,6 +210,7 @@ t/indexlevels-mirror.t
 t/init.t
 t/linkify.t
 t/main-bin/spamc
+t/malloc_info.t
 t/mda.t
 t/mda_filter_rubylang.t
 t/mid.t
diff --git a/lib/PublicInbox/Spawn.pm b/lib/PublicInbox/Spawn.pm
index 66b916df..9210f111 100644
--- a/lib/PublicInbox/Spawn.pm
+++ b/lib/PublicInbox/Spawn.pm
@@ -149,6 +149,23 @@ int pi_fork_exec(int in, int out, int err,
 }
 VFORK_SPAWN
 
+# TODO: we may support other mallocs through this parameter
+if (($ENV{INBOX_DEBUG} // '') =~ /\bmalloc_info\b/) {
+        $vfork_spawn .= <<MALLOC_DEBUG;
+#include <malloc.h>
+
+int inbox_malloc_info(int options)
+{
+        int rc = malloc_info(options, stderr);
+
+        return rc == 0 ? TRUE : FALSE;
+}
+MALLOC_DEBUG
+
+        # dump malloc info to stderr on SIGCONT
+        $SIG{CONT} = sub { inbox_malloc_info(0) };
+}
+
 my $inline_dir = $ENV{PERL_INLINE_DIRECTORY};
 $vfork_spawn = undef unless defined $inline_dir && -d $inline_dir && -w _;
 if (defined $vfork_spawn) {
diff --git a/t/malloc_info.t b/t/malloc_info.t
new file mode 100644
index 00000000..352ec5cf
--- /dev/null
+++ b/t/malloc_info.t
@@ -0,0 +1,25 @@
+# Copyright (C) 2019 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use strict;
+use warnings;
+use Test::More;
+use PublicInbox::Spawn ();
+
+if (!PublicInbox::Spawn->can('inbox_malloc_info')) {
+        plan skip_all => 'inbox_malloc_info not enabled';
+}
+
+open my $olderr, '>&', \*STDERR or die "dup stderr: $!";
+open my $tmp, '+>', undef or die "tmpfile: $!";
+open STDERR, '>&', $tmp or die "redirect stderr to \$tmp: $!";
+my @x = map { '0' x (1024 * 1024) } (1..128);
+my $cb = $SIG{CONT};
+$cb->();
+@x = ('hello');
+PublicInbox::Spawn::inbox_malloc_info(0);
+open STDERR, '>&', $olderr or die "restore stderr: $!";
+sysseek($tmp, 0, 0) == 0 or die "sysseek: $!";
+my @info = <$tmp>;
+like($info[0], qr/</, 'output looks like XML');
+
+done_testing;