[perl #36533] Telnet.pm bug

[via RT]

# New Ticket Created by  Doug Harper 
# Please include the string:  [perl #36533]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=36533 >


When I telnet into one of our switches and execute above a certain number of 
commands, I get that it thinks I got an EOF.

See example below and I have attached the script and sample output.

while (<CMDLIST>) {
   printf "----------- [%3d/%-3d] ------------\n", ++$count, $total;
   print;
   select(undef, undef, undef, $DELAY);
   @CLIOUT = $t->cmd("$_"); 
   print @CLIOUT, "\n";
}
$t->close;

With $DELAY set to anything less than 4 ms, I would get:
  ==> pattern match read eof at baseline.pl1 line 66
 <<cmd.lst>>  <<sample.txt>> 
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
With Errmode => return 
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

$ sample lab500 mootman
Processing...

------------------- [ 1/13 ] ----------------
moreoff
lab500#
------------------- [ 2/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 3/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 4/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 5/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 6/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 7/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 8/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 9/13 ] ----------------
get node.147.0
nok...Bad file number
------------------- [ 10/13 ] ----------------
get node.147.0
nok...Bad file number
------------------- [ 11/13 ] ----------------
get node.147.0
nok...Bad file number
------------------- [ 12/13 ] ----------------
get node.147.0
nok...Bad file number
------------------- [ 13/13 ] ----------------
moreon
nok...Bad file number

* * * T H E E N D * * *
$

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
With Errmode => die
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
$ sample lab500 mootman
Processing...

------------------- [ 1/13 ] ----------------
moreoff
lab500#
------------------- [ 2/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 3/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 4/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 5/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 6/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 7/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 8/13 ] ----------------
get node.147.0
1.3.6.1.4.1.277.1.3.147.0 = 2 (Integer)
lab500#
------------------- [ 9/13 ] ----------------
get node.147.0
pattern match read eof at sample line 49
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

cmd.lst
Description: Binary data

#!/usr/bin/perl
#-------------------------------------------------------------------
# Script:    sample                                        
#-------------------------------------------------------------------
use strict;

my ($SW, $login, $passwd, $switch, $debugpw, $cmdlst, $DELAY, $total);
#-------------------------------------------------------------------
# Customizable Variables...
#-------------------------------------------------------------------
$login  = "timing";
$passwd = "public";
$cmdlst="cmd.lst";
$DELAY=0.01;
#-------------------------------------------------------------------

($switch, $debugpw) = @ARGV;

use Net::Telnet ();

$SW = new Net::Telnet (Timeout          => 3,
                       Input_log        => 'baseline.out',
                       Dump_log         => 'baseline.dumplog',
                       Errmode          => 'return');

if (!($#ARGV == 1)) {
  print "\nUSAGE:  sample <switch> <debug-password>\n";
  exit 9;
}

open(CMDLIST, $cmdlst) || die "Can't open $cmdlst...\n\n";

print "Processing...\n\n";
$total += `wc -l $cmdlst`;

#-------------------------------------------------------------------
#  Establish telnet connection to switch and login...  
#-------------------------------------------------------------------

$SW->open($switch);
$SW->login($login, $passwd) || die "Unable to login...\n";
$SW->print("ena debug\n");
$SW->waitfor('/password: $/') || die "No password prompt: \n";
$SW->cmd(String => "$debugpw", Timeout => 3) || die "Debug password 
failure...\n";
 
#-------------------------------------------------------------------
#  Send CLI command from cmd.lst to the switch...  
#-------------------------------------------------------------------

while (<CMDLIST>) {
   my (@CLIOUT, $count);
   printf "------------------- [%3d/%-3d] ----------------\n", ++$count, $total;
   print;                                       #echo CLI command
   select(undef, undef, undef, $DELAY);         #Insert time delay
   if (@CLIOUT = $SW->cmd("$_")) {
      print @CLIOUT, "\n";
   } else {
      print "nok...$! \n";
   }
}
$SW->close;
print "\n                *  *  *  T H E   E N D  *  *  *\n";
exit;