From 0805bec5595c4976e5215ca4e681b777d8bffac5 Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Fri, 16 Dec 2022 22:57:54 +0000 Subject: rproxy: more thorough connectivity check Sometimes, stale sockets can stick around and the PID gets recycled by a different process, so ensure we can actually connect to it before listing it. --- lib/Devel/Mwrap/Rproxy.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/Devel/Mwrap/Rproxy.pm b/lib/Devel/Mwrap/Rproxy.pm index 76b7d7f..6db72e6 100644 --- a/lib/Devel/Mwrap/Rproxy.pm +++ b/lib/Devel/Mwrap/Rproxy.pm @@ -41,11 +41,15 @@ sub list { open(my $fh, '+>', \(my $str)) or die "open: $!"; print $fh '', $t, '
', $t,
 		"\n\n";
-	opendir(my $dh, $self->{socket_dir}) or return r(500, "socket_dir: $!");
-	my @pids = grep(/\A[0-9]+\.sock\z/, readdir($dh));
-	for (@pids) {
+	my $dir = $self->{socket_dir};
+	opendir(my $dh, $dir) or return r(500, "socket_dir: $!");
+	my @socks = grep(/\A[0-9]+\.sock\z/, readdir($dh));
+	my %o = (Type => SOCK_STREAM, Peer => undef);
+	for (@socks) {
+		$o{Peer} = "$dir/$_";
 		substr($_, -5, 5, ''); # chop off .sock
 		my $cmd = $valid_pid->($_) // next;
+		my $c = IO::Socket::UNIX->new(%o) // next;
 		print $fh qq($_/);
 		$_ .= '/each/2000';
 		say $fh qq(each/2000\t), $cmd;
-- 
cgit v1.2.3-24-ge0c7