From IO::Socket:

accept([PKG]) [...] In a scalar context the new socket is returned, or undef upon failure.

Alexander

rojmab:

A few miscellaneous notes:

• Line 42 ($client="";) is unnecessary, as the very next line reassigns $client with the result of $sock->accept().
• You're not checking whether $sock->accept() fails, which is the symptom you're reporting, I believe.
• You should remove the inner while loop (starting at line 48), as you go to great lengths in never executing it again (the myriad last statements). Just delete lines 48, 49, 66, 71, 77, 80 and 81, and then fix the indentation.

...roboticus

As afoken said, check if your io commands succeed. Alternatively you might check $sock->error (see IO::Handle, IO::Socket objects inherit the methods from IO::Handle).

I'm a little confused by your description of the problem: Did you say that your script works correctly and prints no error message if you send a message that doesn't result in an ssh attempt, for example if the port number is not in your hash ?

Woot woot. It's working as expected now. Everything is working as I want it to. Thanks for everyone's help. It creates a child process to SSH to the device, then kills the process when it's finished while the "Parent" keeps running. Here's what the final code looks like:

use IO::Socket;
use Net::Appliance::Session;
use strict;
use warnings;
use Sys::Hostname;
use POSIX qw(:sys_wait_h);

sub REAP {
    1 until (-1 == waitpid(-1, WNOHANG));
    $SIG{CHLD} = \&REAP;
}
$SIG{CHLD} = \&REAP;

my ($sock,$LOCALPORT,$MAXLEN,$USER,$PASSWORD,$FILENAME,%PORTHASH,$clie
+nt,$message,$con_handle);

$LOCALPORT=2500;
$MAXLEN=5151;
$USER="REMOVED";
$PASSWORD="REMOVED";

#open STDOUT, '>>data.txt' or die $!;

#Open Listener on TCP port identified by $LOCALPORT
$sock= IO::Socket::INET->new(LocalPort => $LOCALPORT,Proto => 'tcp', R
+euse => 1, Listen => SOMAXCONN) or die "Socket: $@";
$sock->autoflush(1);
print "Starting... running on port: $LOCALPORT\n";

while($client = $sock->accept())
{
    next if my $con_handle = fork;
    die "fork fail: $!" unless defined($con_handle);
        $client->recv($message,1024);
        print "In here:\n";        
        print $message."\n";
        $|=1;
        
        #If the packet has the right format of <Switch IP> : <Patch pa
+nel mapping>, SSH to it and implement the macro stored on the switch 
+       
        if ($message=~ /(.*)\:(\d*)/)
        {

            #Make sure the port mapping exists, If it does, connect SS
+H session
            my $host=$1;            
            my $portnumber=$2;
            #Pull in port mappings. Format is <Patch Panel> , <Switch 
+Port name> I.E. 13,FastEthernet1/0/20
            $FILENAME="ports.".$host.".txt";
            print "Opening Ports and Reading File:".$FILENAME."\n";
            open PORTS, $FILENAME or die $!;
            my @ports=<PORTS>;
            close PORTS;
            foreach(@ports)
            {
                chomp($_);
                my @t=split(/,/,$_);
                $PORTHASH{$t[0]}=$t[1];
            }
            print "Port reading complete\n";

            if (exists $PORTHASH{$portnumber})
            {
                print "Exists!\n";
                
                doSSH($host,$PORTHASH{$portnumber});
                print "Here AGAIN!5\n";
                exit(fork);
            }else
            {
                print"Port: ".$portnumber." is not defined. Host: ".$h
+ost.".\n";
                $client->send('Not Defined!!');
                last;
            }
            
        } else 
        {
            print "In ELSE \n";
        }
        
    
}
continue
{
    close $client;
    kill CHLD => -$$;
}


sub doSSH
{
    my $host=$_[0];
    my $interface=$_[1];
    my $s = Net::Appliance::Session->new($host);    
    eval
    {        
        $s->do_paging(0);
        $s->do_privileged_mode(0);        
        #Send all SSH output to STDOUT so i can watch it
        $s->input_log(*STDOUT);
        print "Connecting to $host\n";
        $s->connect(Name => $USER, Password =>$PASSWORD);    
        $s->begin_configure();
        $s->cmd("interface ".$interface." ");
        $s->cmd("macro apply 8021x");
        $s->end_configure();
        $s->close;
    };
    if ( UNIVERSAL::isa($@,'Net::Appliance::Session::Exception') )
    {
        print $@->message, "\n";  # fault description from Net::Applia
+nce::Session
        print $@->errmsg, "\n";   # message from Net::Telnet
        print $@->lastline, "\n"; # last line of output from your appl
+iance
        # perform any other cleanup as necessary
        $client->send('FAILED--');
    }else
    {
        print "SUCCESS! \n";
        $client->send('Successful');
    }

    
}
[download]

Two random comments:

Instead of killing the childs you could wait for them to finish with wait(). Are you sure that the child has always finished the task when you kill it?

You have an exit(fork); right after the doSSH. It might be some clever construct I just don't get, but it looks like a senseless fork, where both parent and child exit immediately after the fork. Shouldn't it be just exit();?

Thanks for all the feedback. I added or die "$!"; to the $client=$socket->accept(); line.

I'm seeing an error now: No child processes at udplisten802.pl line 44.

What does this mean? Out of random googling, I decided to tweak it a bit. I added this:

my $con_handle = fork();
            if ($con_handle) {
                print "Child Spawned [$con_handle]\n";
}else{
<put in the while(1) block here>
}
[download]

@ Jethro, If i get a packet for a port that's not defined by a mapping, I have it report an error "Port: 1 is not defined for this host" and the script keeps running. I only get the error after I do an SSH session.

Thanks all for your help!

Ok, Good news. I removed the extra loop that Roboticus mentioned. After doing that and with the code to fork it in there, it runs now without throwing any errors. The only thing left to fix is now that I'm using child processes, they are not closing themselves. Any thoughts on how to make them close nicely? Thanks again Gurus!

The only thing left to fix is now that I'm using child processes, they are not closing themselves. Any thoughts on how to make them close nicely?

Use a method of forking that returns the pid, store them in an array, and do a kill 9 (or 15) on them when you want them gone? You may need to do a killfam on the pid just in case you get an extraneous shell pid as a parent to your spawned child pid.

---

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku