Hi Monks!

I've been writing a TCP listener off and on for a few months now, its been part time, the basic need for this is to run network tests across machines using either IPv4 and IPv6. The goal of this is to wait for connections from the client, and when it receives certain data strings it can display them or perform actions; the biggest one I have now is a kill to shut down the server and client, then exit or run another server within the loop of the server_run_type function. I may add more functionality later on, but first things first. What I have now (snipped to remove declarations and such and apologies for the length) is: 

# Main program
&run();

# Functions

sub cleanup
{
   my ($verbose) = @_;
   print "Cleaning up everything.\n" if $verbose;
   $SIG{CHLD} = \&REAPER;
}

sub getHost
{
   my ($host,$verbose,$ipv6) = @_;
   my $address = &Lib::ReliUtil::getHostIP();
   if ($host eq "ip" && $ipv6)
   {
       $address = &Lib::MothUtil::getHostIPv6();
       return $address;
   }
   elsif ($host eq "ip")
   {
       return $address;
   }
   elsif ($host = "loopback")
   {
       $address = "127.0.0.1";
       return $address;
   }
   # Need to set AIX to 0.0.0.0 on occasion
   # Need to find out when....
}

sub id_client()
{
   my ($client,$ipv6) = @_;
   my $port;
   my $iaddr;
   my $other = getpeername($client) or die "Couldn't identify other en
+d: $!\n";
   # Need to unpack with the right protocol
   if ($ipv6)
   {
       ($port, $iaddr) = unpack_sockaddr_in6($other);
       my $actual_ip6 = inet_ntop(AF_INET6,$iaddr);
       return($actual_ip6);
   }
   else
   {
       ($port, $iaddr) = unpack_sockaddr_in($other);
       my $actual_ip = inet_ntoa($iaddr);
       return($actual_ip);
   }
}

sub make_server 
{
   my ($ipv6,$localHost,$conn,$protocol,$socket_port,$verbose) = @_;
   my $server;

   print "Using protocol = $protocol on $localHost with port = $socket
+_port.\n" if $verbose;

   my $server = IO::Socket->new(
      Domain => ($ipv6 ? AF_INET6 : AF_INET),
      Proto  => $protocol,
      LocalHost => $localHost,
      LocalPort => $socket_port,
      Reuse => 1,
      Listen => $conn) 
     or die "Couldn't make server on $localHost : $socket_port: $@\n";
   print "Running server on $localHost : $socket_port. \n" if $verbose
+;

   return($server);
}

sub REAPER()
{
   1 until (-1 == waitpid(-1, 'WNOHANG') );
}

sub run()
{
   my $localHost = getHost($host,$verbose,$ipv6);
    
   # Verify the protocol or set default
   $protocol = &Lib::MothUtil::getProtocol($protocol,$verbose);
    
   # Verify the socket or set default
   $socket_port = &socket($socket_port,$verbose);
   
   # Run the test
   $result = &server_run_type($ipv6,$localHost,$connToAcc,$protocol,$s
+ocket_port,
                              $keepAlive,$loop,$verbose);
     
   if ($result == 1)
   {
       print "There was a problem with the test,\n";
       print "please run in verbose mode and\n" if (!$verbose);
       print "check your messages to determine the cause.\n";
       exit(1);
   }
   &cleanup($verbose);
   exit(0);

}

sub server_run_multi()
{    
   my ($server,$keepAlive,$verbose,$ipv6) = @_;
   my $client;
   # fork off a process for the clients coming in
   while ($client = $server->accept( ) )
   {
       print "Connected client(s) - " . &id_client($client,$ipv6) . "\
+n";
       next if my $pid = fork;    # parent
       die "Fork: $!" unless defined $pid;     # otherwise a child
       # close($server);    # no use to the child
       while ( defined (my $data_recv = <$client>) )
       {
           if ($data_recv =~ m/client/)
           {
               print "You're a client!\n";
           }
           elsif ($data_recv =~ m/disconn/)
           {
              print "Disconnecting client - " . &id_client($client,$ip
+v6) . "\n" if $verbose;
              close($client)  || warn "Can't disconnect client: $!\n";
           }
           elsif ($data_recv =~ m/kill/)
           {
              print "Disconnecting client - " . &id_client($client,$ip
+v6) . "\n" if $verbose;
              # Cleaning up client and server
              close($client) || warn "Can't kill client: $!\n";
              close($server) || warn "Can't close server: $!\n";
              print "We're done here.\n";
              last;
           }
           elsif ($data_recv =~ m/stop/)
           {
               # Place holder for later on when this will help stop th
+e auto tests
               print "Currently unsupported option.\n";
           }
           else
           {
              print STDOUT $data_recv if $verbose;
              print $client "You said - $data_recv\n" if $verbose;
           }
       }
   }
   print "Child is done.\n" if $verbose;
   return $result;
}

sub server_run_single()
{    
   my ($server,$keepAlive,$loop,$verbose,$ipv6) = @_;
   my $d_count = 0;

   # accept and process connections
   my $client = $server->accept( );
   print "Connected - " . &id_client($client,$ipv6) . "\n";
   while ( defined (my $data_recv = <$client>) )
   {
       if ($data_recv =~ m/discon/)
       {
           # Get out of this loop
           close($client)  || warn "Can't close single client: $!\n";
       }
       print STDOUT $data_recv if $verbose;
       print $client "You said - $data_recv\n" if $verbose;
   }
   return $result;
}

sub server_run_type
{
   my ($ipv6,$localHost,$connToAcc,$protocol,$socket_port,
       $keepAlive,$loop,$verbose) = @_;
   my $i;
   my $server;
   if ($sys =~ m/win/)
   {
       print "Running single model, " if $verbose;
       print "with Keep Alive = $keepAlive.\n" if $verbose;
       # Create the server
       $server = &make_server($ipv6,$localHost,$connToAcc,$protocol,$s
+ocket_port,$verbose);
       $result = &server_run_single($server,$keepAlive,$loop,$verbose,
+$ipv6);
       print "Done with single model.\n" if $verbose;
   }
   elsif ($loop > 0) 
   {
      print "Running loop model.\n" if $verbose;
      for ($i = 1; $i <= $loop; $i++)
      {
         print "Running loop $i of $loop.\n" if $verbose;
         print "Sleeping in between loops.\n" if $verbose && $i > 1;
         sleep(5) if $i > 1;  # Give connections time to close
         # Create the server
         $server = &make_server($ipv6,$localHost,$connToAcc,$protocol,
+$socket_port,$verbose);
         # Run the server test type
         $result = &server_run_multi($server,$keepAlive,$verbose,$ipv6
+);
         print "Done with loop $i.\n" if $verbose;
      }
   }
   else
   {
       # Create the server
       $server = &make_server($ipv6,$localHost,$connToAcc,$protocol,$s
+ocket_port,$verbose);
       print "Running multi model with Keep Alive = $keepAlive.\n" if 
+$verbose;
       # Forked model
       $result = &server_run_multi($server,$keepAlive,$verbose,$ipv6);
       close($server);
       print "Done with catch-all.\n" if $verbose;
   }
   &cleanup($verbose);
   return $result;
}

sub socket
{
   my ($socket_port,$verbose) = @_;
   if ($socket_port == '')
   {
       print "No port given, defaulting to 9998.\n" if $verbose;
       $socket_port = 9998;
   }
   return $socket_port;
}

[download]

My question on this really comes down to, is there any way to make this leaner or more robust? I'm still way new to network programming, this was my first attempt at something like this, and if there are places to improve I'd like to do so.

Thanks!

In reply to Creating a TCP listener by gokuraku

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.