# 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 end: $!\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,$socket_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,$ipv6) . "\n" if $verbose; close($client) || warn "Can't disconnect client: $!\n"; } elsif ($data_recv =~ m/kill/) { print "Disconnecting client - " . &id_client($client,$ipv6) . "\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 the 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,$socket_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,$socket_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; }