use 5.016;
use strict;
use warnings;
use Socket;
use IO::Socket;
use IO::Socket::INET;
use Data::Dumper;
use IO::Select;
use Errno qw(EPIPE);
my $port = '11111';
my $pid = fork;
if ($pid) {
# server
sleep 10;
my $sock1;
my $attempts = 100;
while ($attempts--) {
$sock1 = IO::Socket::INET->new (
PeerHost => 'localhost',
PeerPort => '9001',
Proto => 'tcp');
if (!$sock1) {
say "Cannot connect to child socket - $!";
sleep 2;
} else {
last;
}
}
if (!$sock1) {
say "Failed to connect after 100 attempts";
say "Killing child";
kill 'TERM', $pid;
say "waiting on child";
waitpid($pid, 0);
}
binmode($sock1, ':encoding(UTF-8)');
$sock1->send("Hello\r\n");
sleep 10;
my $sock2 = IO::Socket::INET->new (
PeerHost => 'localhost',
PeerPort => '9001',
Proto => 'tcp');
$sock2->send("Hello2\r\n");
sleep 10;
say "shutdown 1";
shutdown($sock1, 1); # stopped writing
shutdown($sock2, 1); # stopped writing
sleep 5;
say "shutdown 2";
shutdown($sock1, 2); # stopped using this socket
shutdown($sock2, 2); # stopped using this socket
sleep 5;
say "closing socket";
close($sock1);
close($sock2);
say "Killing child";
kill 'TERM', $pid;
say "waiting on child";
waitpid($pid, 0);
say "parent exiting";
exit;
} elsif (!defined $pid) {
die "fork failed with $!";
} else {
# child
say "child started";
sleep 15;
my $sock = IO::Socket::INET->new(Listen => 50,
LocalAddr => 'localhost',
LocalPort => 9001,
Proto => 'tcp',
ReuseAddr => 1);
my $select = IO::Select->new();
$select->add($sock);
my $buf = '';
while (1) {
#exit 0; uncomment to test SIGPIPE
my @ready = $select->can_read(5);
foreach my $ready (@ready) {
if ($ready == $sock) {
my $s = $sock->accept();
my $client_address = $s->peerhost();
my $client_port = $s->peerport();
say "connection from $client_address:$client_port\n";
$select->add($s);
binmode($s, ':encoding(UTF-8)');
} else {
say "Child reading socket";
my $read = sysread($ready, $buf, 1024, length($buf));
if (!defined($read)) {
say "Child sysread error - $!";
last;
} elsif ($read == 0) {
say "Child EOF";
$select->remove($ready);
close $ready;
sleep 1;
last;
} else {
while ($buf =~ s/^(.*)\r\n//) {
say "Child got /$1/";
# child does something with this
};
}
}
}
}
exit;
}