[PATCH 0/6] various test and syscall-related fixes

[PATCH 0/6] various test and syscall-related fixes

[Eric Wong]

A few fixes I noticed while working on some other lei-related cleanups.

Eric Wong (6):
  test_common: fixes for TEST_RUN_MODE=0
  t/cmd_ipc: assume SOCK_SEQPACKET
  lei_self_socket: drop unused deps and code
  ipc: recv_cmd4 clobbers destination buffer on errors
  syscall: have `vec' operate on bytes directly
  syscall: fix valgrind error in pure Perl send_cmd4

 lib/PublicInbox/CmdIPC4.pm       |  5 +++-
 lib/PublicInbox/LEI.pm           |  1 -
 lib/PublicInbox/LeiSelfSocket.pm |  8 ++-----
 lib/PublicInbox/Spawn.pm         |  8 ++++---
 lib/PublicInbox/Syscall.pm       | 20 ++++++++++------
 lib/PublicInbox/TestCommon.pm    |  1 +
 t/cmd_ipc.t                      | 40 +++++++++++++++-----------------
 7 files changed, 44 insertions(+), 39 deletions(-)

[PATCH 1/6] test_common: fixes for TEST_RUN_MODE=0

[Eric Wong]

This fixes t/httpd-https.t when running `make check TEST_RUN_MODE=0'
to disable all code preloading and reuse.

Fixes: b914e67f82ee (test_common: start_script: set default signals)
---
 lib/PublicInbox/TestCommon.pm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/lib/PublicInbox/TestCommon.pm b/lib/PublicInbox/TestCommon.pm
index 9ad181e2..28edee9f 100644
--- a/lib/PublicInbox/TestCommon.pm
+++ b/lib/PublicInbox/TestCommon.pm
@@ -519,6 +519,7 @@ sub start_script {
 		}
 		$tail = tail_f(@paths, $opt);
 	}
+	require PublicInbox::DS;
 	my $oset = PublicInbox::DS::block_signals();
 	require PublicInbox::OnDestroy;
 	my $tmp_mask = PublicInbox::OnDestroy->new(

[PATCH 2/6] t/cmd_ipc: assume SOCK_SEQPACKET

[Eric Wong]

We can also enable the SIGALRM test by default as we're killing
manually in a loop to ensure the signal handler eventually
fires.

Followup-to: 2a6063fbc4580315 ("ipc: assume SOCK_SEQPACKET exists")
---
 t/cmd_ipc.t | 37 +++++++++++++++++--------------------
 1 file changed, 17 insertions(+), 20 deletions(-)

diff --git a/t/cmd_ipc.t b/t/cmd_ipc.t
index 7edfc92f..461d2140 100644
--- a/t/cmd_ipc.t
+++ b/t/cmd_ipc.t
@@ -1,22 +1,20 @@
 #!perl -w
 # Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
-use strict;
-use v5.10.1;
-use Test::More;
+use v5.12;
 use PublicInbox::TestCommon;
-use Socket qw(AF_UNIX SOCK_STREAM);
-pipe(my ($r, $w)) or BAIL_OUT;
+use autodie;
+use Socket qw(AF_UNIX SOCK_STREAM SOCK_SEQPACKET);
+pipe(my $r, my $w);
 my ($send, $recv);
 require_ok 'PublicInbox::Spawn';
-my $SOCK_SEQPACKET = eval { Socket::SOCK_SEQPACKET() } // undef;
+require POSIX;
 
 my $do_test = sub { SKIP: {
 	my ($type, $flag, $desc) = @_;
-	defined $type or skip 'SOCK_SEQPACKET missing', 7;
 	my ($s1, $s2);
 	my $src = 'some payload' x 40;
-	socketpair($s1, $s2, AF_UNIX, $type, 0) or BAIL_OUT $!;
+	socketpair($s1, $s2, AF_UNIX, $type, 0);
 	my $sfds = [ fileno($r), fileno($w), fileno($s1) ];
 	$send->($s1, $sfds, $src, $flag);
 	my (@fds) = $recv->($s2, my $buf, length($src) + 1);
@@ -37,7 +35,7 @@ my $do_test = sub { SKIP: {
 	@exp = stat $s1;
 	@cur = stat $s1a;
 	is("$exp[0]\0$exp[1]", "$cur[0]\0$cur[1]", '$s1 dev/ino matches');
-	if (defined($SOCK_SEQPACKET) && $type == $SOCK_SEQPACKET) {
+	if ($type == SOCK_SEQPACKET) {
 		$r1 = $w1 = $s1a = undef;
 		$src = (',' x 1023) . '-' .('.' x 1024);
 		$send->($s1, $sfds, $src, $flag);
@@ -52,17 +50,16 @@ my $do_test = sub { SKIP: {
 		is_deeply(\@fds, [ undef ], "EAGAIN $desc");
 		$s2->blocking(1);
 
-		if ($ENV{TEST_ALRM}) {
+		if ('test ALRM') {
 			my $alrm = 0;
 			local $SIG{ALRM} = sub { $alrm++ };
 			my $tgt = $$;
-			my $pid = fork // xbail "fork: $!";
+			my $pid = fork;
 			if ($pid == 0) {
 				# need to loop since Perl signals are racy
 				# (the interpreter doesn't self-pipe)
-				while (tick(0.01)) {
-					kill 'ALRM', $tgt;
-				}
+				CORE::kill('ALRM', $tgt) while (tick(0.05));
+				POSIX::_exit(1);
 			}
 			@fds = $recv->($s2, $buf, length($src) + 1);
 			ok($!{EINTR}, "EINTR set by ($desc)");
@@ -77,7 +74,7 @@ my $do_test = sub { SKIP: {
 		is_deeply(\@fds, [], "no FDs on EOF $desc");
 		is($buf, '', "buffer cleared on EOF ($desc)");
 
-		socketpair($s1, $s2, AF_UNIX, $type, 0) or BAIL_OUT $!;
+		socketpair($s1, $s2, AF_UNIX, $type, 0);
 		$s1->blocking(0);
 		my $nsent = 0;
 		my $srclen = length($src);
@@ -90,7 +87,7 @@ my $do_test = sub { SKIP: {
 			or diag "send failed with: $! (nsent=$nsent)";
 		ok($nsent > 0, 'sent some bytes');
 
-		socketpair($s1, $s2, AF_UNIX, $type, 0) or BAIL_OUT $!;
+		socketpair($s1, $s2, AF_UNIX, $type, 0);
 		is($send->($s1, [], $src, $flag), length($src), 'sent w/o FDs');
 		$buf = 'nope';
 		@fds = $recv->($s2, $buf, length($src));
@@ -123,7 +120,7 @@ SKIP: {
 	$send = $send_ic;
 	$recv = $recv_ic;
 	$do_test->(SOCK_STREAM, 0, 'Inline::C stream');
-	$do_test->($SOCK_SEQPACKET, 0, 'Inline::C seqpacket');
+	$do_test->(SOCK_SEQPACKET, 0, 'Inline::C seqpacket');
 }
 
 SKIP: {
@@ -132,13 +129,13 @@ SKIP: {
 	$send = PublicInbox::CmdIPC4->can('send_cmd4');
 	$recv = PublicInbox::CmdIPC4->can('recv_cmd4');
 	$do_test->(SOCK_STREAM, 0, 'MsgHdr stream');
-	$do_test->($SOCK_SEQPACKET, 0, 'MsgHdr seqpacket');
+	$do_test->(SOCK_SEQPACKET, 0, 'MsgHdr seqpacket');
 	SKIP: {
 		($send_ic && $recv_ic) or
 			skip 'Inline::C not installed/enabled', 12;
 		$recv = $recv_ic;
 		$do_test->(SOCK_STREAM, 0, 'Inline::C -> MsgHdr stream');
-		$do_test->($SOCK_SEQPACKET, 0, 'Inline::C -> MsgHdr seqpacket');
+		$do_test->(SOCK_SEQPACKET, 0, 'Inline::C -> MsgHdr seqpacket');
 	}
 }
 
@@ -150,7 +147,7 @@ SKIP: {
 	$recv = PublicInbox::Syscall->can('recv_cmd4') or
 		skip 'recv_cmd4 not defined for arch';
 	$do_test->(SOCK_STREAM, 0, 'PP Linux stream');
-	$do_test->($SOCK_SEQPACKET, 0, 'PP Linux seqpacket');
+	$do_test->(SOCK_SEQPACKET, 0, 'PP Linux seqpacket');
 }
 
 done_testing;

[PATCH 3/6] lei_self_socket: drop unused deps and code

[Eric Wong]

We don't need to repeat the assignment done in DS::new,
nor do we need to disable the `once' warnings after
commit cfd20b04dfe4 (ipc: retry sendmsg + recvmsg calls on EINTR)
removed the need for that pragma.
---
 lib/PublicInbox/LeiSelfSocket.pm | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

diff --git a/lib/PublicInbox/LeiSelfSocket.pm b/lib/PublicInbox/LeiSelfSocket.pm
index 690cda3f..84367266 100644
--- a/lib/PublicInbox/LeiSelfSocket.pm
+++ b/lib/PublicInbox/LeiSelfSocket.pm
@@ -5,20 +5,17 @@
 # This receives what script/lei receives, but isn't connected
 # to an interactive terminal so I'm not sure what to do with it...
 package PublicInbox::LeiSelfSocket;
-use strict;
-use v5.10.1;
+use v5.12;
 use parent qw(PublicInbox::DS);
 use Data::Dumper;
 $Data::Dumper::Useqq = 1; # should've been the Perl default :P
 use PublicInbox::Syscall qw(EPOLLIN);
-use PublicInbox::Spawn;
 use PublicInbox::IPC;
 
 sub new {
 	my ($cls, $r) = @_;
-	my $self = bless { sock => $r }, $cls;
+	my $self = bless {}, $cls;
 	$r->blocking(0);
-	no warnings 'once';
 	$self->SUPER::new($r, EPOLLIN);
 }
 

[PATCH 4/6] ipc: recv_cmd4 clobbers destination buffer on errors

[Eric Wong]

Handling this should be done at the lowest levels possible;
so away from higher-level lei code.
---
 lib/PublicInbox/CmdIPC4.pm       | 5 ++++-
 lib/PublicInbox/LEI.pm           | 1 -
 lib/PublicInbox/LeiSelfSocket.pm | 1 -
 lib/PublicInbox/Spawn.pm         | 8 +++++---
 lib/PublicInbox/Syscall.pm       | 5 ++++-
 t/cmd_ipc.t                      | 1 +
 6 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/lib/PublicInbox/CmdIPC4.pm b/lib/PublicInbox/CmdIPC4.pm
index 99890244..4bc4c729 100644
--- a/lib/PublicInbox/CmdIPC4.pm
+++ b/lib/PublicInbox/CmdIPC4.pm
@@ -31,7 +31,10 @@ no warnings 'once';
 *recv_cmd4 = sub ($$$) {
 	my ($s, undef, $len) = @_; # $_[1] = destination buffer
 	my $mh = Socket::MsgHdr->new(buflen => $len, controllen => 256);
-	my $r = Socket::MsgHdr::recvmsg($s, $mh, 0) // return (undef);
+	my $r = Socket::MsgHdr::recvmsg($s, $mh, 0) // do {
+		$_[1] = '';
+		return (undef);
+	};
 	$_[1] = $mh->buf;
 	return () if $r == 0;
 	my (undef, undef, $data) = $mh->cmsghdr;
diff --git a/lib/PublicInbox/LEI.pm b/lib/PublicInbox/LEI.pm
index 8b62def2..1ead9bf6 100644
--- a/lib/PublicInbox/LEI.pm
+++ b/lib/PublicInbox/LEI.pm
@@ -1167,7 +1167,6 @@ sub event_step {
 		if (scalar(@fds) == 1 && !defined($fds[0])) {
 			return if $! == EAGAIN;
 			die "recvmsg: $!" if $! != ECONNRESET;
-			$buf = '';
 			@fds = (); # for open loop below:
 		}
 		for (@fds) { open my $rfh, '+<&=', $_ }
diff --git a/lib/PublicInbox/LeiSelfSocket.pm b/lib/PublicInbox/LeiSelfSocket.pm
index 84367266..b8745252 100644
--- a/lib/PublicInbox/LeiSelfSocket.pm
+++ b/lib/PublicInbox/LeiSelfSocket.pm
@@ -25,7 +25,6 @@ sub event_step {
 	if (scalar(@fds) == 1 && !defined($fds[0])) {
 		return if $!{EAGAIN};
 		die "recvmsg: $!" unless $!{ECONNRESET};
-		$buf = '';
 	} else { # just in case open so perl can auto-close them:
 		for (@fds) { open my $fh, '+<&=', $_ };
 	}
diff --git a/lib/PublicInbox/Spawn.pm b/lib/PublicInbox/Spawn.pm
index ed698afc..2b84e2d5 100644
--- a/lib/PublicInbox/Spawn.pm
+++ b/lib/PublicInbox/Spawn.pm
@@ -259,10 +259,12 @@ void recv_cmd4(PerlIO *s, SV *buf, STRLEN n)
 	msg.msg_controllen = CMSG_SPACE(SEND_FD_SPACE);
 
 	i = recvmsg(PerlIO_fileno(s), &msg, 0);
-	if (i < 0)
-		Inline_Stack_Push(&PL_sv_undef);
-	else
+	if (i >= 0) {
 		SvCUR_set(buf, i);
+	} else {
+		Inline_Stack_Push(&PL_sv_undef);
+		SvCUR_set(buf, 0);
+	}
 	if (i > 0 && cmsg.hdr.cmsg_level == SOL_SOCKET &&
 			cmsg.hdr.cmsg_type == SCM_RIGHTS) {
 		size_t len = cmsg.hdr.cmsg_len;
diff --git a/lib/PublicInbox/Syscall.pm b/lib/PublicInbox/Syscall.pm
index 0a0912fb..776fbe23 100644
--- a/lib/PublicInbox/Syscall.pm
+++ b/lib/PublicInbox/Syscall.pm
@@ -444,7 +444,10 @@ no warnings 'once';
 			msg_controllen,
 			0); # msg_flags
 	my $r = syscall($SYS_recvmsg, fileno($sock), $mh, 0);
-	return (undef) if $r < 0; # $! set
+	if ($r < 0) { # $! is set
+		$_[1] = '';
+		return (undef);
+	}
 	substr($_[1], $r, length($_[1]), '');
 	my @ret;
 	if ($r > 0) {
diff --git a/t/cmd_ipc.t b/t/cmd_ipc.t
index 461d2140..7313d13b 100644
--- a/t/cmd_ipc.t
+++ b/t/cmd_ipc.t
@@ -47,6 +47,7 @@ my $do_test = sub { SKIP: {
 		$s2->blocking(0);
 		@fds = $recv->($s2, $buf, length($src) + 1);
 		ok($!{EAGAIN}, "EAGAIN set by ($desc)");
+		is($buf, '', "recv buffer emptied on EAGAIN ($desc)");
 		is_deeply(\@fds, [ undef ], "EAGAIN $desc");
 		$s2->blocking(1);
 

[PATCH 5/6] syscall: have `vec' operate on bytes directly

[Eric Wong]

Instead of converting to bytes to bits and asking `vec' to
operate on single bits, we can just have `vec' work on 8 bits
at-a-time.

This also fixes an overallocation in pure Perl Linux recv_cmd4.
Adding an extra byte ourselves for "\0" isn't necessary: Perl
already does it internally everywhere when creating/resizing
scalars.
---
 lib/PublicInbox/Syscall.pm | 6 +++---
 t/cmd_ipc.t                | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/lib/PublicInbox/Syscall.pm b/lib/PublicInbox/Syscall.pm
index 776fbe23..b76a9e8a 100644
--- a/lib/PublicInbox/Syscall.pm
+++ b/lib/PublicInbox/Syscall.pm
@@ -283,7 +283,7 @@ sub epoll_wait_mod4 {
 	# resize our static buffer if maxevents bigger than we've ever done
 	if ($maxevents > $epoll_wait_size) {
 		$epoll_wait_size = $maxevents;
-		vec($epoll_wait_events, $maxevents * 12 * 8 - 1, 1) = 0;
+		vec($epoll_wait_events, $maxevents * 12 - 1, 8) = 0;
 	}
 	@$events = ();
 	my $ct = syscall($SYS_epoll_wait, $epfd, $epoll_wait_events,
@@ -304,7 +304,7 @@ sub epoll_wait_mod8 {
 	# resize our static buffer if maxevents bigger than we've ever done
 	if ($maxevents > $epoll_wait_size) {
 		$epoll_wait_size = $maxevents;
-		vec($epoll_wait_events, $maxevents * 16 * 8 - 1, 1) = 0;
+		vec($epoll_wait_events, $maxevents * 16 - 1, 8) = 0;
 	}
 	@$events = ();
 	my $ct = syscall($SYS_epoll_wait, $epfd, $epoll_wait_events,
@@ -429,7 +429,7 @@ no warnings 'once';
 
 *recv_cmd4 = sub ($$$) {
 	my ($sock, undef, $len) = @_;
-	vec($_[1] //= '', ($len + 1) * 8, 1) = 0;
+	vec($_[1] //= '', $len - 1, 8) = 0;
 	my $cmsghdr = "\0" x msg_controllen; # 10 * sizeof(int)
 	my $iov = pack('P'.TMPL_size_t, $_[1], $len);
 	my $mh = pack('PL' . # msg_name, msg_namelen (socklen_t (U32))
diff --git a/t/cmd_ipc.t b/t/cmd_ipc.t
index 7313d13b..e5d22aab 100644
--- a/t/cmd_ipc.t
+++ b/t/cmd_ipc.t
@@ -97,7 +97,7 @@ my $do_test = sub { SKIP: {
 
 		my $nr = 2 * 1024 * 1024;
 		while (1) {
-			vec(my $vec = '', $nr * 8 - 1, 1) = 1;
+			vec(my $vec = '', $nr - 1, 8) = 1;
 			my $n = $send->($s1, [], $vec, $flag);
 			if (defined($n)) {
 				$n == length($vec) or

[PATCH 6/6] syscall: fix valgrind error in pure Perl send_cmd4

[Eric Wong]

We need to allocate CMSG_SPACE for the `struct cmsghdr', not the
smaller CMSG_LEN.  AFAIK this isn't a real world problem since
the Linux kernel doesn't care about the uninitialized space as
long as memory region belongs to the user, but valgrind complains.
---
 lib/PublicInbox/Syscall.pm | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/lib/PublicInbox/Syscall.pm b/lib/PublicInbox/Syscall.pm
index b76a9e8a..4cf45d0f 100644
--- a/lib/PublicInbox/Syscall.pm
+++ b/lib/PublicInbox/Syscall.pm
@@ -398,10 +398,13 @@ no warnings 'once';
 	my ($sock, $fds, undef, $flags) = @_;
 	my $iov = pack('P'.TMPL_size_t,
 			$_[2] // NUL, length($_[2] // NUL) || 1);
+	my $fd_space = scalar(@$fds) * SIZEOF_int;
+	my $msg_controllen = CMSG_SPACE($fd_space);
 	my $cmsghdr = pack(TMPL_size_t . # cmsg_len
 			'LL' .  # cmsg_level, cmsg_type,
-			('i' x scalar(@$fds)),
-			CMSG_LEN(scalar(@$fds) * SIZEOF_int), # cmsg_len
+			('i' x scalar(@$fds)) . # CMSG_DATA
+			'@'.($msg_controllen - 1).'x1', # pad to space, not len
+			CMSG_LEN($fd_space), # cmsg_len
 			SOL_SOCKET, SCM_RIGHTS, # cmsg_{level,type}
 			@$fds); # CMSG_DATA
 	my $mh = pack('PL' . # msg_name, msg_namelen (socklen_t (U32))
@@ -413,7 +416,7 @@ no warnings 'once';
 			@BYTES_4_hole,
 			$iov, 1, # msg_iov, msg_iovlen
 			$cmsghdr, # msg_control
-			CMSG_SPACE(scalar(@$fds) * SIZEOF_int), # msg_controllen
+			$msg_controllen,
 			0); # msg_flags
 	my $sent;
 	my $try = 0;