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; }