An alternative to your forking server is a single-threaded event-driven server using IO::Select.

I've dug out some old code I used for testing Syslog a while back. I post the code in its entirety here, including output of an example run, in case it is of use to you or another monk (or me of the future :). Note that this code runs fine on both Unix and Windows.

Here is the mock syslog server:

# mocksyslogserver.pl.

use strict;
use warnings;
use IO::Socket::INET;
use IO::Select;
use Sys::Hostname ();
use Time::HiRes   ();
use Getopt::Std   ();

# A mock syslog server.
# XXX: Could not find a way to find the length of the syslog message
# without parsing it.
# I am not aware of a guaranteed syslog "termination character"
# to indicate the syslog message is complete
# ... though terminating all messages with '\0' seems common.

my $SYSLOG_MIN_HDR_LEN = 1;
my $SYSLOG_MAX_MSG_LEN = 1024;

# From https://tools.ietf.org/html/rfc5424 (Syslog protocol).
#
#  The syslog protocol does not provide acknowledgment of message
#  delivery.  Though some transports may provide status information,
#  conceptually, syslog is a pure simplex communications protocol.
#  Note: Simplex = send in one direction only

sub usage
{
   print <<'DARLING_FASCIST_BULLY_BOY';

A mock syslog server.

usage: mocksyslogserver [-a accept-sleep-secs] [-r recv-sleep-secs] -p
+ port

Examples:
  mocksyslogserver -p 9949           Normal syslog server.
                                     Start up mock syslog server on po
+rt 9949.

  mocksyslogserver -p 9949 -a 3      Listen on port 9949, then sleep f
+or 3
                                     secs after client accepts.

  mocksyslogserver -p 9949 -r 3      Listen on port 9949, then sleep f
+or 3
                                     secs after each recv from client.

DARLING_FASCIST_BULLY_BOY
   exit 1;
}

sub get_datetime_stamp
{
   my ( $s, $m, $h, $d, $mon, $y ) = localtime;
   sprintf( "%02d:%02d:%02d", $h, $m, $s );
}

# -----------------------------------------------------------------
# Perl network programming notes
# ------------------------------
# Reading can be done with:
#  1) <$sock> - blocks till new line
#  2) read($sock, $buf, $len) - blocks till $len bytes received
#                               (like W Richard Stevens readn function
+ in C)
#  3) sysread($sock, $buf, $len) - may return less than asked for
#                                  (like read()/recv() in C)
# -----------------------------------------------------------------

# Return undef if client closed the $client socket.
sub recv_tcp_client
{
   my $client = shift;

   my $peerhost = $client->peerhost();
   my $peerport = $client->peerport();

   # my $peeraddr     = $client->peeraddr();
   # my $peerhostfull = gethostbyaddr( $peeraddr, AF_INET ) || "Cannot
+ resolve";

   # my $fromstr = "from $peerhost:$peerport (host=$peerhostfull) ";
   my $fromstr = "from $peerhost:$peerport ";

   my $data;

   # This one blocks until newline received.
   # $data = <$client>;

   #  This one blocks till $len bytes received (like Stevens readn fun
+ction in C)
   # my $hdr;
   # my $hdrlen = read( $client, $hdr, $SYSLOG_HDR_LEN );

   # This one may return less than asked for (like read()/recv() in C)
   # XXX: When we receive a '\0' we know the message is complete?
   my $msglen = sysread( $client, $data, $SYSLOG_MAX_MSG_LEN );

   # XXX: For now, just remove any NULLs in received data
   my $numnull = $data =~ tr/\0//d;

   if ( !defined($msglen) )
   {
      print '[Recv] ' . get_datetime_stamp() . ": $fromstr" . "<undef>
+ read error: $!\n";
      sleep(1);
      return;
   }
   if ( $msglen == 0 )
   {
      print '[Recv] ' . get_datetime_stamp() . ": $fromstr" . "read hd
+r eof\n";
      sleep(1);
      return;
   }
   if ( $msglen < $SYSLOG_MIN_HDR_LEN )
   {
      warn "error: read less than min bytes ($msglen < $SYSLOG_MIN_HDR
+_LEN)\n";
   }

   print '[Recv] '
      . get_datetime_stamp()
      . ": $fromstr"
      . "read data ok (len=$msglen, null=$numnull)\n";
   print '[Recv] ' . get_datetime_stamp() . ': ' . "$data:\n";

   # Check for any "weird" characters (10=LF, 13=CR).
   # Note that syslog messages terminated with '\0'?
   my @ord_chars = map {ord} split //, $data;
   my @weird = grep { $_ != 10 && $_ != 13 && ( $_ < 32 || $_ > 126 ) 
+} @ord_chars;
   my $nweird = @weird;
   if (@weird)
   {
      my $s = join "", map { '(' . ( $_ >= 32 && $_ <= 126 ? chr() : "
+" ) . ",ord=$_)" } @ord_chars;

      print "[Recv] $nweird weird ord chars were detected in the previ
+ous line:\n";

      # print "[Recv] $s\n";
      # my $last_ord = $ord_chars[-1];
      # print "[Recv] weird : '@weird' (last_ord='$last_ord')\n";
   }

   return $data;
}

# Note: send_client is not used for (simplex) syslog protocol
sub send_client
{
   my $client = shift;
   my $str    = shift;
   print '[Send] ' . get_datetime_stamp() . ': ' . $str . ":\n";
   print {$client} $str or die "error: print: $!";
}

sub my_log
{
   my $str = shift;
   print '[Info] ' . get_datetime_stamp() . ': ' . $str;
}

sub do_syslog_server
{
   my $host               = shift;
   my $port               = shift;
   my $sleep_after_accept = shift;
   my $sleep_after_recv   = shift;

   my_log( "Start on host '$host' at " . get_datetime_stamp() . "\n" )
+;
   my_log("  pid=$$\n");
   my_log("  port=$port\n");
   my_log("  sleep_after_accept=$sleep_after_accept\n");
   my_log("  sleep_after_recv=$sleep_after_recv\n");

   # This socket is used to listen for connections.
   my $listener = IO::Socket::INET->new(
      LocalPort => $port,
      Proto     => 'tcp',
      Listen    => 5,
      ReuseAddr => 1,
   ) or die "error: IO::Socket::INET new: $@";

   my $selector = IO::Select->new($listener);

SERVER:
   while ( my @ready = $selector->can_read() )
   {
   CLIENT:
      for my $client (@ready)
      {
         if ( $client == $listener )
         {
            my $new_conn = $listener->accept();
            $selector->add($new_conn);
            my $fh_hex = sprintf '0x%x', $new_conn;

            my $peerhost = $new_conn->peerhost();
            my $peerport = $new_conn->peerport();

            my $peeraddr = $new_conn->peeraddr();
            my $peerhostfull = gethostbyaddr( $peeraddr, AF_INET ) || 
+"Cannot resolve";

            my $fromstr = "from $peerhost:$peerport (host=$peerhostful
+l)";

            my_log("Accepted new connection $fromstr\n");
            if ($sleep_after_accept)
            {
               my_log("Sleeping for $sleep_after_accept seconds...\n")
+;
               sleep($sleep_after_accept);
            }
         }
         else
         {
            my $cli_cmd_str = recv_tcp_client($client);
            if ( !defined($cli_cmd_str) )
            {
               my $peerhost = $client->peerhost();
               my $peerport = $client->peerport();
               my_log("Client $peerhost:$peerport closed socket\n");
               $selector->remove($client);
               $client->close();
               next CLIENT;
            }
            if ( $cli_cmd_str =~ /^SERVER_PLEASE_QUIT\s*$/ )
            {
               my_log("Server quitting on your command\n");
               last SERVER;
            }
            if ($sleep_after_recv)
            {
               my_log("Sleeping for $sleep_after_recv seconds...\n");
               sleep($sleep_after_recv);
            }
         }
      }
   }

   my_log("Closing server\n");
   close($listener) or die "error: close server: $!";
   my_log("End do_syslog_server\n");
}

local $| = 1;
my $myhostname = lc( Sys::Hostname::hostname() );

my $port               = 0;    # -p switch
my $sleep_after_accept = 0;    # -a switch
my $sleep_after_recv   = 0;    # -r switch

my %option = ();
Getopt::Std::getopts( "p:a:r:", \%option ) or usage();
usage() if $option{h};
if ( $option{p} )
{
   $port = $option{p};
   $port =~ /^\d+$/ or die "error: invalid -p: '$port'\n";
}
if ( $option{a} )
{
   $sleep_after_accept = $option{a};
   $sleep_after_accept =~ /^\d+$/
      or die "error: invalid -a: '$sleep_after_accept'\n";
}
if ( $option{r} )
{
   $sleep_after_recv = $option{r};
   $sleep_after_recv =~ /^\d+$/
      or die "error: invalid -r: '$sleep_after_recv'\n";
}
usage() if $port <= 0;
usage() if $sleep_after_accept < 0;
usage() if $sleep_after_recv < 0;
@ARGV and usage();

do_syslog_server( $myhostname, $port, $sleep_after_accept, $sleep_afte
+r_recv );
[download]

And here is the mock client:

# mocksyslogclient.pl.
# Simple test of mocksyslogserver.pl
# Example: perl mocksyslogclient.pl localhost 9949

use strict;
use warnings;
use Socket;
use IO::Socket::INET;

use Getopt::Std ();

# Plain socket version
sub send_tcp_messages
{
   my $host      = shift;
   my $port      = shift;
   my $delaysecs = shift;
   my @messages  = @_;

   $host = inet_aton($host) or die "error: unknown host: $!";
   socket( my $server, PF_INET, SOCK_STREAM, getprotobyname('tcp') )
      or die "error: socket: $!";
   my $dest_addr = sockaddr_in( $port, $host );
   connect( $server, $dest_addr ) or die "error: connect: $!";
   binmode($server);
   $server->autoflush();

   my $nmessages = @messages;
   print "Send $nmessages messages\n";
   my $idx = 0;
   for my $mess (@messages)
   {
      ++$idx;
      print "$idx: send message\n";
      my $nmess = length($mess);
      my $nsent = send( $server, $mess, 0, $dest_addr ) or die "error:
+ send '$mess': $!";
      $nsent == $nmess or die "error: nsent ($nsent != $nmess)";
      print "$idx: sent message ok\n";
      if ( $idx < $nmessages && $delaysecs )
      {
         print "$idx: delay $delaysecs secs\n";
         sleep $delaysecs;
      }
   }

   close($server) or die "error: close: $!";
}

# IO::Socket::INET version
sub send_tcp_messages_inet
{
   my $host      = shift;
   my $port      = shift;
   my $delaysecs = shift;
   my @messages  = @_;

   # Creating object IO::Socket::INET internally creates socket,
   # binds, and connects to TCP server running on port.
   my $server = IO::Socket::INET->new(
      PeerHost => $host,
      PeerPort => $port,
      Proto    => 'tcp',
   ) or die "error: socket new: $@\n";

   my $nmessages = @messages;
   print "Send $nmessages messages\n";
   my $idx = 0;
   for my $mess (@messages)
   {
      ++$idx;
      print "$idx: send message\n";
      my $nmess = length($mess);
      my $nsent = $server->send($mess) or die "error: send '$mess': $!
+";
      $nsent == $nmess or die "error: nsent ($nsent != $nmess)";
      print "$idx: sent message ok\n";
      if ( $idx < $nmessages && $delaysecs )
      {
         print "$idx: delay $delaysecs secs\n";
         sleep $delaysecs;
      }
   }

   $server->close() or die "error: close: $!";
}

sub usage
{
   print <<'DARLING_FASCIST_BULLY_BOY';

A mock syslog client.

usage: mocksyslogclient -h host -p port [-d delaysecs] message...

Examples:
  mocksyslogclient -h localhost -p 9949 "hello"
     Send "hello" message

  mocksyslogclient -h localhost -p 9949 "hello" "there"
     Send two messages

  mocksyslogclient  -h localhost -p 9949 SERVER_PLEASE_QUIT
     Ask server to quit

DARLING_FASCIST_BULLY_BOY
   exit 1;
}

*STDOUT->autoflush();

@ARGV or usage();
my %option = ();
Getopt::Std::getopts( "h:p:d:", \%option ) or usage();

my $host;
if ( $option{h} )
{
   $host = $option{h};
}
$host or die "error: No -h host specified\n";

my $port;
if ( $option{p} )
{
   $port = $option{p};
   $port =~ /^\d+$/ or die "error: invalid -p: '$port'\n";
}

my $delaysecs = 0;
if ( $option{d} )
{
   $delaysecs = $option{d};
   $delaysecs =~ /^\d+$/ or die "error: invalid -d: '$delaysecs'\n";
}
@ARGV or usage();

my @messages = @ARGV;
@messages or die "error: No messages specified\n";

print "host='$host' port='$port' delaysecs='$delaysecs'\n";

# send_tcp_messages_inet( $host, $port, $delaysecs, @messages );
send_tcp_messages( $host, $port, $delaysecs, @messages );
[download]

Finally, here is a full example run with one server and two clients.

Example mock server output:

> perl mocksyslogserver.pl -p 9949 -a 3
[Info] 10:24:35: Start on host 'myhost' at 10:24:35
[Info] 10:24:35:   pid=83768
[Info] 10:24:35:   port=9949
[Info] 10:24:35:   sleep_after_accept=3
[Info] 10:24:35:   sleep_after_recv=0
[Info] 10:24:50: Accepted new connection from 127.0.0.1:58683 (host=my
+host)
[Info] 10:24:50: Sleeping for 3 seconds...
[Info] 10:24:53: Accepted new connection from 127.0.0.1:58684 (host=my
+host)
[Info] 10:24:53: Sleeping for 3 seconds...
[Recv] 10:24:56: from 127.0.0.1:58683 read data ok (len=6, null=0)
[Recv] 10:24:56: hello1:
[Recv] 10:24:56: from 127.0.0.1:58683 read hdr eof
[Info] 10:24:57: Client 127.0.0.1:58683 closed socket
[Recv] 10:24:57: from 127.0.0.1:58684 read data ok (len=6, null=0)
[Recv] 10:24:57: hello2:
[Recv] 10:24:57: from 127.0.0.1:58684 read hdr eof
[Info] 10:24:58: Client 127.0.0.1:58684 closed socket
[Info] 10:25:39: Accepted new connection from 127.0.0.1:58695 (host=my
+host)
[Info] 10:25:39: Sleeping for 3 seconds...
[Recv] 10:25:42: from 127.0.0.1:58695 read data ok (len=18, null=0)
[Recv] 10:25:42: SERVER_PLEASE_QUIT:
[Info] 10:25:42: Server quitting on your command
[Info] 10:25:42: Closing server
[Info] 10:25:42: End do_syslog_server
>
[download]

Example client 1 output:

> perl mocksyslogclient.pl -h localhost -p 9949 "hello1"
host='localhost' port='9949' delaysecs='0'
Send 1 messages
1: send message
1: sent message ok
> perl mocksyslogclient.pl -h localhost -p 9949 "SERVER_PLEASE_QUIT"
host='localhost' port='9949' delaysecs='0'
Send 1 messages
1: send message
1: sent message ok
>
[download]

Example client 2 output:

> perl mocksyslogclient.pl -h localhost -p 9949 "hello2"
host='localhost' port='9949' delaysecs='0'
Send 1 messages
1: send message
1: sent message ok
[download]

See also

• Effective Automated Testing - the mock syslog server above was used during automated smoke testing of our C functions that wrote Syslog messages; that is why it is easy to start (e.g. perl mocksyslogserver.pl -p 9949 -a 3) and stop (e.g. send it a SERVER_PLEASE_QUIT message) from an autotest script.

• Re: Does IO::Select work? Solution by zentara
• Re^2: Hex value of Perl file handle to uniquely identify
• Re: Perl Best Practices - Loop Labels
• TCP server with IO::Socket by AlexP

• Re: IO::Socket tutorial by haukex (2020) - complete example server using Mojo::IOLoop
• Re: IO::Socket simple server by haukex (2023) - event loops are the way to go - Mojo::IOLoop recommended

• What is the difference between read and sysread? (SO)

• Re: Threads or no Threads (Threading, Forking, Signals, Event Loop and Concurrency References)

Updated: Added See also section.