test: Add runserver from the dbscripts test suite

It was written by me, in May 2018.

1 files changed, 39 insertions, 0 deletions

diff --git a/test/lib/runserver b/test/lib/runserver
new file mode 100755
index 0000000..7705e40
--- /dev/null
+++ b/test/lib/runserver
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+use Fcntl;
+
+my $socket = IO::Socket::INET->new(
+	LocalAddr => "localhost:0",
+	Listen => 1
+);
+
+sysopen(my $fh, $ARGV[0], O_WRONLY|O_CREAT|O_EXCL, 0666) or die "open: $ARGV[0]: $!";
+my $pid = fork();
+if ($pid > 0) {
+	print $fh $pid;
+	print $socket->sockport()."\n";
+	exit;
+}
+close($fh);
+open(STDIN, '</dev/null');
+open(STDOUT, '</dev/null');
+
+my @cmd = @ARGV;
+shift @cmd;
+
+while (1) {
+	my $conn = $socket->accept();
+	my $worker = fork();
+	if ($worker == 0) {
+		open(STDIN, '<&', $conn);
+		open(STDOUT, '>&', $conn);
+		close($conn);
+		close($socket);
+		exec @cmd;
+		exit
+	}
+	close($conn);
+}