#!/opt/SUNWstade/bin/perl -I/opt/SUNWstade/lib

use Getopt::Std;
use strict;
use Net::Telnet;
use Agent::BROCADE;
use PDM::ConfigFile;
use System;

   $|=1;
   $SIG{INT} = \&killTest;
   $SIG{TERM} = \&killTest;

   my %Parameters=undef; 
   my %Options;
   my $ip = undef;
   my $password = undef;
   my $port = undef;
   my $iterations = 1000;
   my $fcaddr = undef;
   my $ok;
   my $user_pattern = 0x7e7e7e7e;
   my $pattern_type = "critical";
   my $gl_gbic_name = "GBIC";
   my $gl_switch_type  = 2; # 3 12000 model 2 means 2 gig byte, 1 means 2 gig byte
   my $gl_init_sync_loss = 0;
   my $gl_init_crc_err = 0;
   my $gl_init_enc_in = 0;
   my $gl_init_loss_sig = 0;
   my @pattern_array;

   my $verbose = 0;
   my $short_print = undef;

   process_args();

   init_pattern_array();


   #looks Like we are ready to start issuing commands

   if($verbose){
      print "Starting test on port $port with version 1.1 of brocadetest\n";
   }
   if($verbose){
      print "Connect to $ip\n";
   }
   my($t) = new Net::Telnet (
             errmode => "return",
             Timeout   => 30,
             Prompt    => '/.*\:admin+\>/',
             );

   if (!defined($t->open($ip))) 
   {
     # failed to open ip
      print "Cannot open IP $ip\n";
      if(!$short_print)
      {
      print "Probable_Cause(s)\n";
      print "<Invalid IP>\n";
      print "<Ethernet disconnected from switch>\n";
      print "<No power to switch>\n";
      print "<Bad switch>\n";
      print "Recommended_Action(s)\n";
      print "<Check IP address>\n";
      print "<Check ethernet connection>\n";
      print "<Check power to switch>\n";
      print "<Replace switch>\n";
      }
      exit(106);
   }

   if($verbose){
      print "Opened $ip\n";
   }

   $t->waitfor('/login:/i');
   $t->print('admin');
   $t->waitfor('/Password: /i');
   $t->print($password);
   my ($prematch, $match) = $t->waitfor('/Use Control|admin\>/i');
   if($match =~ /Use Control/){
      if($verbose){
         print "User should change password to: $ip\n";
      }

      # To make Ctrl c, in vi do CONTROL V CONTROL C
      $t->print("");
      ($prematch, $match) = $t->waitfor('/admin\>/i');
   }
   if($match !~ /admin\>/i){
      print "failed to log in: $ip\n";
      if(!$short_print)
      {
         print "Probable_Cause(s)\n";
         print "<Another user may be logged into the switch>\n";
         print "<Incorrect password given>\n";
         print "Recommended_Action(s)\n";
         print "<Check to see if someone is logged into switch>\n";
         print "<Check to see if a user has a telnet session active to this switch>\n";
         print "<Check for correct password>\n";
      }

      exit(105);
   }

   if($verbose){
      print "Logged into $ip\n";
   }

   check_sensors();


   #get switch type
   get_switch_type();
   # clear any port errors
   # This will clear some of the port counters so you 
   # want to clear the errors before you get the original port counters
   clear_port_errors();

   get_port_counters();


   run_loopback();


   compare_port_counters();

   if($verbose){
      print "Close $ip\n";
   }

   $t->close;

   #sleep in order for logout to clean up
   #prevents failures from occurring if looping test
   sleep(5);
 
   exit(0);
##################### END OF MAIN #############################################



sub printUsage {
  print "Usage: brocade [-vu] [-o \"dev=<port:ip>|ip=<address>|port=<Port number>|iterations=<number>|passwd=<Switch password>\"\n";
  print "Standard arguments:\n";
  print "-u      list usage\n";
  print "-v      verbose mode\n";
  print "-o      Test specific options\n";
  print "\n";

  print "ip         =<Switch IP address>   IP address of switch to test.\n";
  print "port       =<Port number to test> Switch port to test.\n";
  print "passwd     =<switch Password>     Password for admin switch login.\n";
  print "iterations =<number of loops>     number of times to run loopback tests.\n";
  print "dev        =<port:ipddress>       Switch port and IP address to test.\n";
  print "                                  (Combines IP and port options together.)\n";
  
  print "IE:\n";
  print "brocadetest -v -o \"dev=5:10.0.0.1|passwd=switchpassword|iterations=10000000\"\n";
  print "brocadetest -v -o \"port=5|ip=10.0.0.1|passwd=switchpassword|iterations=10000\"\n";

}

##################################################################


sub killTest{
  print "Test has received kill signal\n";
  print "Exiting\n";
  exit(1);

}
##################################################################
# run loopback on port
sub run_loopback {
   
   my(@l);

   my($starttime) = time;

   my($found_port);

   $found_port = 0;

   # must find out what type of port we are on
   
   @l = $t->cmd("switchshow");

   foreach my $line (@l) 
   {
      if(($line=~/port\s*$port:/)  || $line=~ /^\s*$port\s*/)
      {
	 if($line=~ /L-Port/)
	 {
	    $found_port = 1;
	    if($verbose){
	       print "L port detected\n";
	    }

	    if($pattern_type =~ /user/)
	    {
	       if($verbose)
	       {
		  print "Using user pattern $user_pattern\n";

	       }
	       $user_pattern = hex($user_pattern);
	       run_loopport_test();
	    }
	    elsif($pattern_type =~ /all/)
	    {

	       if($verbose)
	       {
	          print "Running all patterns\n";
	       }
	       foreach $user_pattern(@pattern_array)
	       {
		  printf ("Using pattern 0x%08x\n", $user_pattern);
		  run_loopport_test();
	       }
	    }
	    else
	    {
	       # default to to critical (12)
	       my $index;
	       if($verbose)
	       {
	          print "Running critical patterns\n";
	       }
	       for($index=0; $index<12; $index++)
	       {
	          $user_pattern = $pattern_array[$index];
		  printf ("Using pattern 0x%08x\n", $user_pattern);

		  run_loopport_test();
	       }

	    }

	 }
	 elsif($line =~ /E-Port/)
	 {
	    $found_port = 1;
	    if($verbose){
	      print "E port detected\n";
	    }

	    run_spinFab_port();
	 }
	 elsif($line =~ /F-Port/)
	 {
	    $found_port = 1;

	    if($verbose){
	       print "F port detected\n";
	    }
	    if($gl_switch_type eq 1)
	    {
	       # This is a 1 gig switch, doesn't support f port test
	       print "No Test available for F ports on 1 Gig switches\n";
	       if(!$short_print)
	       {
	          print "Probable_Cause(s)\n";
	          print "<port type unsupported>\n";
	          print "<Bad $gl_gbic_name>\n";
	          print "Recommended_Action(s)\n";
	          print "<Insert a loopback plug into port and retest>\n";
	          print "<Replace $gl_gbic_name>>\n";
	       }
	       exit(4);

	    }







	    if($pattern_type =~ /user/)
	    {
	       if($verbose)
	       {
		  printf "Using user pattern $user_pattern\n";

	       }
	       $user_pattern = hex($user_pattern);

	       run_fporttest();
	    }
	    elsif($pattern_type =~ /all/)
	    {

	       if($verbose)
	       {
	          print "Running all patterns\n";
	       }
	       foreach $user_pattern(@pattern_array)
	       {
		  printf ("Using pattern 0x%08x\n", $user_pattern);
		  run_fporttest();
	       }
	    }
	    else
	    {
	       # default to to critical (12)
	       my $index;
	       if($verbose)
	       {
	          print "Running critical patterns\n";
	       }
	       for($index=0; $index<12; $index++)
	       {
	          $user_pattern = $pattern_array[$index];
		  printf ("Using pattern 0x%08x\n", $user_pattern);

		  run_fporttest();
	       }

	    }

	 }
	 elsif($line =~ /Loopback/)
	 {
	    $found_port = 1;
	    if($verbose){
	       print "port is in loopback mode\n";
	    }
	    run_crossport_test();


	 }
	 elsif($line =~ /Disabled/)
	 {
	    $found_port = 1;
            print "This port is disabled\n";
            print "$line\n";
	    if(!$short_print)
	    {
            print "Probable_Cause(s)\n";
            print "<Port was manually disabled>\n";
            print "<Bad switch>\n";
            print "Recommended_Action(s)\n";
            print "<Enable this port by logging into switch and issuing the command:\n";
            print "portEnable $port>\n";
            print "<Replace switch>\n";
	    }


            exit(101);

	 }
	 else
	 { 
	    $found_port = 1;
	    print "Can not test this port\n";
	    print "$line\n";
	    if(!$short_print)
	    {
	    print "Probable_Cause(s)\n";
	    print "<Port not connected>\n";
	    print "<Unknown port type>\n";
	    print "<Bad $gl_gbic_name>\n";
	    print "<Bad switch>\n";
	    print "Recommended_Action(s)\n";
	    print "<Insert a loopback plug into port and retest>\n";
	    print "<Run linktest>\n";
	    print "<Replace $gl_gbic_name>\n";
	    }


	    exit(3);
	 }
	 last; # break out of for each  
      }
   }	 
   if(!$found_port)
   {
     print "Couldn't determine port type\n";
     print "@l\n";
     if(!$short_print)
     {
     print "Probable_Cause(s)\n";
     print "<downlevel firmware>\n";
     print "<Unknown port type>\n";
     print "<Bad $gl_gbic_name>\n";
     print "<Bad switch>\n";
     print "Recommended_Action(s)\n";
     print "<Run revision check>\n";
     print "<Insert a loopback plug into port and retest>\n";
     print "<Run linktest>\n";
     print "<Replace $gl_gbic_name>\n";
     }
     exit(5);


   }

   my($testtime) = time - $starttime ;
   
   if($verbose){
      print("Loopback took $testtime seconds to run.\n");
   }






}
##################################################################
sub run_loopport_test{

   my(@l);
   my($line);
   my($ok);
   my($prematch, $match);

   if($verbose){
      print "Running loopport test\n";
   }

   my($timeout);

   # adjust telnet timeout for loopback 
   # add seconds to run_time as a buffer
   $timeout = ($iterations * .18) + 300;
   $t->timeout($timeout);

   
   # must clear some of the error counters since loopport test clears 
   # some of the counters. It doesn't clear them all...
   $gl_init_enc_in = 0;
   $gl_init_crc_err = 0;



   if($verbose){
      printf ("Sending command loopPortTest %d, %d, 0x%08x, 4\n", $iterations, $port, $user_pattern);

   }
   $ok = $t->print("loopPortTest $iterations,$port,$user_pattern, 4");

   $match = "INIT";
   $prematch= "INIT";

   ($prematch, $match) = $t->waitfor('/.*admin\>|Diags.*/');

   if($match =~ /Diags.*/)
   {
      # Test must have failed
      # send quit for diag results
      print "Detected loop failure\n";
      print "$prematch\n";

      #send a return to get to stop test menu
      $ok = $t->print("\n");
      #send a q to quit test
      @l = $t->cmd("q");

      loop_failed_exit();
   }
   if($verbose){
      print "$prematch $match\n";
   }
   # if here, test pased
   if($match =~ /.*admin/)
   {
      if($prematch =~ /passed/i)
      {
	 if($verbose){
            print "Test Passed\n";
	 }
      }
      else
      {
        #Test didn't pas??
	print "$prematch\n";
	loop_failed_exit();
      }
   }
   else
   {
     # we didn't get either response?
     loop_failed_exit();
   }


}
##################################################################
sub run_spinFab_port{

   my(@l);
   my($line);
   my($prematch, $match);


   if($verbose){
      print "Running spinFab test\n";
   }



   # must update iterations since command runs x million iterations
   $iterations = $iterations/  100;
   $iterations = int($iterations);
   if(!$iterations)
   {
      $iterations = 1;
   }

   my($timeout);

   # adjust telnet timeout for loopback 
   # add seconds to run_time as a buffer
   # Takes about 6 seconds per iteration
   $timeout = ($iterations * 7) + 300;
   $t->timeout($timeout);


   if($verbose){
      print "Number of megabit transfers = $iterations\n";
      print "Running command: spinFab $iterations,$port,$port\n";
   }

   $ok = $t->print("spinFab $iterations,$port,$port");

   $match = "INIT";
   $prematch= "INIT";
   ($prematch, $match) = $t->waitfor('/.*admin\>|Pt.*/');
    
   if($match =~ /Pt$port.*/)
   {
      # Test must have failed
      
      print "Detected loop failure\n";
      print "$match\n";
      #send a return to get to stop test menu
      $ok = $t->print("\n");
      #send a q to quit test
      @l = $t->cmd("q");

      #let test to stop
      #sleep(10);


      loop_failed_exit();
   }

   # if here, test pased
   if($match =~ /.*admin/)
   {
     
      if($prematch =~ /passed/i)
      {
	 if($verbose){
            print "Test Passed\n";
	 }
      }
      else
      {
        #Test didn't pas??
	print "$prematch\n";
	loop_failed_exit();
      }
   }
   else
   {
     # we didn't get either response?
     print "Didn't get response\n";
     loop_failed_exit();
   }



}
##################################################################

sub loop_failed_exit{

   my(@l);
   my($line);


   print "Test failed for port $port on IP: $ip\n";

   #get diag results
   # reset timeout
   $t->timeout(30);


   print "Get diagshow\n";

   $ok = $t->print("diagShow");
    
   my($prematch, $match) = $t->waitfor('/Total Diag Frames Rx.*/');
   print "$prematch";
   print "$match\n";
   if(!$short_print)
   {
      print "Probable_Cause(s)\n";
      print "<Bad device on loop>\n";
      print "<Bad $gl_gbic_name>\n";
      print "Recommended_Action(s)\n";
      print "<Insert a loopback plug into port and retest>\n";
      print "<Replace $gl_gbic_name>\n";
      print "<Run linktest>\n";
   }


   exit(2);
}


##################################################################
sub process_args{



   my $ok = getopts('qseykruvdlfno:', \%Options);
   my $numargs=keys(%Options);
   
   $verbose = $Options{"v"};
   $short_print = $Options{"q"};

   my $optstring = $Options{"o"};

   #remove password from output
   $optstring =~ s/passwd=[^\s\=\|]+/passwd=xxxxxxx/; #remove passwd from output

   if($verbose){
      print "Called with options: $optstring\n";
   }
   
   #check to see if usage needs to be displayed
   if( !$ok || $numargs < 1 || $Options{"u"} eq 1 )
   {
      printUsage();
      exit();
   }


   #parse all -o options 
   #disable all Options and specify valid parameters

   @Parameters{"ip",
	       "port",
	       "passwd",
	       "iterations",
	       "userpattern",
	       "selectpattern",
	       "dev"}=
	       (undef,undef,undef,1000,0x7e7e7e7e,"critical",undef); 


   # split up indivdual specific parameters
   my $i;
   my $key;
   my $value;
   my $match;
   my $validOption;

   my @tmpParams = split(/\|/,$Options{"o"});


   #loop through params
   foreach $i (@tmpParams)
   { 
      ($key, $value) = split(/=/,$i);

      # Remove any spaces from key and values.

      $key =~ s/\s*//g;
      $value=~ s/\s*//g;


      $match=undef;
      foreach $validOption (keys(%Parameters)) 
      {
         if ($key eq $validOption)
	 {
            $match = $validOption;
         }
      }
      #if the key does not match a valid option then the match does not get difined
      if(! (defined($match)))
      {
         print "$key is an invalid option.\n".
               "brocadetest did not execute.\n". 
               "brocadetest exiting.\n";
	       printUsage();
         exit(1);
      } 
      else  
      { 
         #finally stick the value in the @#$'n hash
         $Parameters{$key}=$value; 
      }
   }

   $ip = $Parameters{ip};
   $password = $Parameters{passwd};
   $port = $Parameters{port};


   if($Parameters{iterations} ne undef)
   {
      $iterations = $Parameters{iterations};
   }

   if($Parameters{dev} ne undef)
   {
      ($port,$ip,$fcaddr) = split(/:/,$Parameters{dev});
   }

   $user_pattern = $Parameters{userpattern};
   $pattern_type = $Parameters{selectpattern};


   #check to make sure values are OK
   my $param=undef;
   while(($param,$value) = each(%Parameters)) 
   {
      if($param=~/health_check|fast_test|fast_find|find/)
      {
         if(!($value =~/(en)|(dis)able/i))
	 {
            print "$param=$value is an invalid option.\n".
                 "brocadetest did not execute.\n". 
                 "brocadetest exiting.\n";
	    printUsage();
            exit(1);
         }
      } 
   }

   #if debug print out parameters
   if($Options{"d"})
   { 
     print "INPUT PARAMETERS:\n";
     while (($key,$value) = each(%Parameters))
     {
	if($key ne "passwd")
	{
           print "$key = $value \n";
	}
	else
	{
	   print "$key: xxxxxx\n";
	}
     }
   }
   #Done Parsing -o options



}
##################################################################

sub clear_port_errors{
   my(@l);

   # Clear any errors that may be present on this port
   if($verbose){
      print "Clear port errors: send diagClearError $port\n";
   }
   #First make sure port is semi good state.
   @l = $t->cmd("loopporttest 1,$port");
   sleep(2);


   @l= $t->cmd("diagClearError $port");

   # give time for clearerror to work
   # otherwise when we do a portshow it doesn't return correct port type
   # if there was a failure before
   
   sleep(4);
   if($verbose){
      print "Port errors cleared\n";
   }

}
##################################################################

sub run_crossport_test{


   my(@l);
   my($line);
   my($prematch, $match);

   if($verbose){
      print "Running command: CrossPortTest $iterations,1\n";
      print "Note: You should only have a loopback on port $port.\n";
      print "If you have more than one loopback installed,\n";
      print "this test may report false errors.\n";
   }
   my($timeout);

   # adjust telnet timeout for loopback 
   # add seconds to run_time as a buffer
   $timeout = ($iterations * .3) + 300;
   $t->timeout($timeout);


   # must clear some of the error counters since crossport test clears 
   # some of the counters. It doesn't clear them all...
   $gl_init_enc_in = 0;
   $gl_init_crc_err = 0;

   $ok = $t->print("CrossPortTest $iterations,1 ");

   ($prematch, $match) = $t->waitfor('/.*admin\>|Pt.*/');
    
   if($match =~ /Pt$port.*/)
   {
      # Test must have failed
      
      print "Detected loop failure\n";
      print "$match\n";
      #send a return to get to stop test menu
      $ok = $t->print("\n");
      #send a q to quit test
      @l = $t->cmd("q");

      #let test to stop
      #sleep(10);


      loop_failed_exit();
   }

   # if here, test pased
   if($match =~ /.*admin/)
   {
     
      if($prematch =~ /passed/i)
      {
         if($verbose){
            print "Test Passed\n";
	 }
      }
      else
      {
        #Test didn't pas??
	print "$prematch\n";
	loop_failed_exit();
      }
   }
   else
   {
     # we didn't get either response?
     print "Didn't get response\n";
     loop_failed_exit();
   }


}
##################################################################

sub get_port_counters(){

   my(@l);
   @l = $t->cmd("portErrShow");
   foreach my $line (@l) 
   {
      if($line =~ /^\s*$port: /)
      {
	 # This is the port we are looking for

	 my ($myport, $counters) = split(/^\s*$port:/,$line);

	 my ($first, $ftx, $frx, $encin, $crcerr, $tooshrt, $toolong, $badeof, $encout, $discc3, $linkfail, $losssync, $losssig, $frjt, $fbsy) = split(/ +/,$counters);

	 $gl_init_sync_loss  = $losssync;
	 $gl_init_crc_err = $crcerr;
	 $gl_init_enc_in = $encin;
	 $gl_init_loss_sig = $losssig;

      }
	
   }
}
##################################################################

sub compare_port_counters(){

   my ($first, $ftx, $frx, $encin, $crcerr, $tooshrt, $toolong, $badeof, $encout, $discc3, $linkfail, $losssync, $losssig, $frjt, $fbsy) ;
   my(@l);
   @l = $t->cmd("portErrShow");
   foreach my $line (@l) 
   {
      if($line =~ /^\s*$port: /)
      {
	 # This is the port we are looking for
	 my ($myport, $counters) = split(/^\s*$port:/,$line);
	 ($first, $ftx, $frx, $encin, $crcerr, $tooshrt, $toolong, $badeof, $encout, $discc3, $linkfail, $losssync, $losssig, $frjt, $fbsy) = split(/ +/,$counters);

      }

      	
   }



   if($encin != $gl_init_enc_in)
   {
      print "Detected encoding errors inside of frames during test.\n";
      print "Original = $gl_init_enc_in, Current = $encin.\n";
      if(!$short_print)
      {
      print "Probable_Cause(s)\n";
      print "<Bad port>\n";
      print "<Bad $gl_gbic_name>\n";
      print "<Bad fiber cable\n";
      print "Recommended_Action(s)\n";
      print "<Run link test on this port>\n";
      print "<Replace $gl_gbic_name>\n";
      print "<Replace fiber>\n";
      }

      exit(1);
   }



   if($losssig != $gl_init_loss_sig)
   {
      print "Detected a loss of signal error during test.\n";
      print "Original = $gl_init_loss_sig, Current = $losssig.\n";
      if(!$short_print)
      {
      print "Probable_Cause(s)\n";
      print "<Bad port>\n";
      print "<Bad $gl_gbic_name>\n";
      print "<Bad fiber fiber cable\n";
      print "Recommended_Action(s)\n";
      print "<Run link test on this port>\n";
      print "<Replace $gl_gbic_name>\n";
      print "<Replace fiber>\n";
      }


      exit(1);
   }

   if($crcerr != $gl_init_crc_err)
   {
      print "Detected a crc error during test.\n";
      print "Original = $gl_init_crc_err, Current = $crcerr.\n";
      if(!$short_print)
      {
      print "Probable_Cause(s)\n";
      print "<Bad port>\n";
      print "<Bad $gl_gbic_name>\n";
      print "<Bad fiber fiber cable\n";
      print "Recommended_Action(s)\n";
      print "<Run link test on this port>\n";
      print "<Replace $gl_gbic_name>\n";
      print "<Replace fiber>\n";
      }

      exit(1);
   }

   if($losssync != $gl_init_sync_loss)
   {
      print "Detected a sync loss error during test.\n";
      print "Original = $gl_init_sync_loss, Current = $losssync.\n";
      if(!$short_print)
      {
      print "Probable_Cause(s)\n";
      print "<Bad port>\n";
      print "<Bad $gl_gbic_name>\n";
      print "<Bad fiber fiber cable\n";
      print "Recommended_Action(s)\n";
      print "<Run link test on this port>\n";
      print "<Replace $gl_gbic_name>\n";
      print "<Replace fiber>\n";
      }

      exit(1);
   }
}
##################################################################

sub check_sensors(){
   
   my (@l);
   my $line;
   
   # check Fans
   @l = $t->cmd("fanshow");
   
   foreach $line (@l) 
   {
      next if (length($line) < 2); # skip blank lines or lines without Fan
      next if ($line !~ /fan/i);   # skip lines without fans
      if($line =~/is OK/)
      {
	 if($verbose)
	 {
	    print "$line";
	 }
      }
      else
      {
	 print "\n*************************\n";
         print "Detected possible bad Fan\n";
	 print "$line\n";
	 print "**************************\n\n";

      }
   }

   # check power supplies
   @l = $t->cmd("psshow");

   foreach $line (@l)
   {  
      if($line)
      { 
      if($line=~/Power Supply/i)
      {
         if($line=~/is OK/)
         {
	    if($verbose)
	    {
	       print "$line";
	    }
         }
         else
         {
	    print "\n**********************************\n";
            print "Detected possible bad Power supply\n";
	    print "$line";
	    print "**********************************\n\n";

         }
      }
      }
   }
	
}
##################################################################
sub   get_switch_type()
{

   System->set_home("/opt/SUNWstade");

   my ($renv, $devices, $hosts, $notifs, $Config) = PDM::ConfigFile->read();
   System->set_renv($renv);

   my $mymodel = Agent::BROCADE->getModel($ip); 
   if($verbose){
      print "Model = $mymodel\n";
   }

   # Assume SFP and 2 gig switch or better
   $gl_gbic_name = "SFP";
   $gl_switch_type = 2;

   if($mymodel =~ /1000|2800|2x00|20x0|22x0|2800/){
       # This is a 1 gig switch
       $gl_gbic_name = "GBIC";
       $gl_switch_type = 1;
   }
   if($verbose){
      my(@l);
      @l = $t->cmd("version");
      foreach my $line (@l) 
      {
         if($line =~ /Fabric OS:/)
         {
            # This is the version string
	    chomp($line);
	    print "$line\n";
         }
      }
   }
}


##################################################################
sub run_fporttest(){

   my(@l);
   my($line);
   my($ok);
   my($prematch, $match);

   if($verbose){
      print "Running F port test\n";
   }

   my($timeout);

   # adjust telnet timeout for loopback 
   # add seconds to run_time as a buffer
   $timeout = ($iterations * .05) + 300;
   $t->timeout($timeout);

   
   # must clear some of the error counters since loopport test clears 
   # some of the counters. It doesn't clear them all...
   $gl_init_enc_in = 0;
   $gl_init_crc_err = 0;



   if($verbose){
      printf ("Sending command fPortTest %d, %d, 0x%08x, 4, 55\n", $iterations, $port, $user_pattern);

   }
   $ok = $t->print("fPortTest $iterations, $port, $user_pattern, 4, 55 ");

   $match = "INIT";
   $prematch= "INIT";

   ($prematch, $match) = $t->waitfor('/.*admin\>|Diags.*/');

   if($match =~ /Diags.*/)
   {
      # Test must have failed
      # send quit for diag results
      print "Detected loop failure\n";
      print "$prematch\n";

      #send a return to get to stop test menu
      $ok = $t->print("\n");
      #send a q to quit test
      @l = $t->cmd("q");

      loop_failed_exit();
   }
   if($verbose){
      print "$prematch $match\n";
   }
   # if here, test pased
   if($match =~ /.*admin/)
   {
      if($prematch =~ /passed/i)
      {
	 if($verbose){
            print "Test Passed\n";
	 }
      }
      else
      {
        #Test didn't pas??
	print "$prematch\n";
	loop_failed_exit();
      }
   }
   else
   {
     # we didn't get either response?
     loop_failed_exit();
   }


}

##################################################################
sub init_pattern_array(){

@pattern_array = 
 (
 0x7e7e7e7e,
 0x1e1e1e1e,
 0xf1f1f1f1,
 0xb5b5b5b5,
 0x4a4a4a4a,
 0x78787878,
 0xe7e7e7e7,
 0xaa55aa55,
 0x7f7f7f7f,
 0x0f0f0f0f,
 0x00ff00ff,
 0x25252525,


 0xffffffff,
 0xfefefefe,
 0xfdfdfdfd,
 0xfcfcfcfc,
 0xfbfbfbfb,
 0xfafafafa,
 0xf9f9f9f9,
 0xf8f8f8f8,
 0xf7f7f7f7,
 0xf6f6f6f6,
 0xf5f5f5f5,
 0xf4f4f4f4,
 0xf3f3f3f3,
 0xf2f2f2f2,
 0xf0f0f0f0,
 0x7d7d7d7d,
 0x7c7c7c7c,
 0x7b7b7b7b,
 0x7a7a7a7a,
 0x79797979,
 0x77777777,
 0x76767676,
 0x75757575,
 0x74747474,
 0x73737373,
 0x72727272,
 0x71717171,
 0x70707070,
 0xefefefef,
 0xeeeeeeee,
 0xedededed,
 0xecececec,
 0xebebebeb,
 0xeaeaeaea,
 0xe9e9e9e9,
 0xe8e8e8e8,
 0xe6e6e6e6,
 0xe5e5e5e5,
 0xe4e4e4e4,
 0xe3e3e3e3,
 0xe2e2e2e2,
 0xe1e1e1e1,
 0xe0e0e0e0,
 0x6f6f6f6f,
 0x6e6e6e6e,
 0x6d6d6d6d,
 0x6c6c6c6c,
 0x6b6b6b6b,
 0x6a6a6a6a,
 0x69696969,
 0x68686868,
 0x67676767,
 0x66666666,
 0x65656565,
 0x64646464,
 0x63636363,
 0x62626262,
 0x61616161,
 0x60606060,
 0xdfdfdfdf,
 0xdededede,
 0xdddddddd,
 0xdcdcdcdc,
 0xdbdbdbdb,
 0xdadadada,
 0xd9d9d9d9,
 0xd8d8d8d8,
 0xd7d7d7d7,
 0xd6d6d6d6,
 0xd5d5d5d5,
 0xd4d4d4d4,
 0xd3d3d3d3,
 0xd2d2d2d2,
 0xd1d1d1d1,
 0xd0d0d0d0,
 0x5f5f5f5f,
 0x5e5e5e5e,
 0x5d5d5d5d,
 0x5c5c5c5c,
 0x5b5b5b5b,
 0x5a5a5a5a,
 0x59595959,
 0x58585858,
 0x57575757,
 0x56565656,
 0x55555555,
 0x54545454,
 0x53535353,
 0x52525252,
 0x51515151,
 0x50505050,
 0xcfcfcfcf,
 0xcececece,
 0xcdcdcdcd,
 0xcccccccc,
 0xcbcbcbcb,
 0xcacacaca,
 0xc9c9c9c9,
 0xc8c8c8c8,
 0xc7c7c7c7,
 0xc6c6c6c6,
 0xc5c5c5c5,
 0xc4c4c4c4,
 0xc3c3c3c3,
 0xc2c2c2c2,
 0xc1c1c1c1,
 0xc0c0c0c0,
 0x4f4f4f4f,
 0x4e4e4e4e,
 0x4d4d4d4d,
 0x4c4c4c4c,
 0x4b4b4b4b,
 0x49494949,
 0x48484848,
 0x47474747,
 0x46464646,
 0x45454545,
 0x44444444,
 0x43434343,
 0x42424242,
 0x41414141,
 0x40404040,
 0xbfbfbfbf,
 0xbebebebe,
 0xbdbdbdbd,
 0xbcbcbcbc,
 0xbbbbbbbb,
 0xbabababa,
 0xb9b9b9b9,
 0xb8b8b8b8,
 0xb7b7b7b7,
 0xb6b6b6b6,
 0xb4b4b4b4,
 0xb3b3b3b3,
 0xb2b2b2b2,
 0xb1b1b1b1,
 0xb0b0b0b0,
 0x3f3f3f3f,
 0x3e3e3e3e,
 0x3d3d3d3d,
 0x3c3c3c3c,
 0x3b3b3b3b,
 0x3a3a3a3a,
 0x39393939,
 0x38383838,
 0x37373737,
 0x36363636,
 0x35353535,
 0x34343434,
 0x33333333,
 0x32323232,
 0x31313131,
 0x30303030,
 0xafafafaf,
 0xaeaeaeae,
 0xadadadad,
 0xacacacac,
 0xabababab,
 0xaaaaaaaa,
 0xa9a9a9a9,
 0xa8a8a8a8,
 0xa7a7a7a7,
 0xa6a6a6a6,
 0xa5a5a5a5,
 0xa4a4a4a4,
 0xa3a3a3a3,
 0xa2a2a2a2,
 0xa1a1a1a1,
 0xa0a0a0a0,
 0x2f2f2f2f,
 0x2e2e2e2e,
 0x2d2d2d2d,
 0x2c2c2c2c,
 0x2b2b2b2b,
 0x2a2a2a2a,
 0x29292929,
 0x28282828,
 0x27272727,
 0x26262626,
 0x24242424,
 0x23232323,
 0x22222222,
 0x21212121,
 0x20202020,
 0x9f9f9f9f,
 0x9e9e9e9e,
 0x9d9d9d9d,
 0x9c9c9c9c,
 0x9b9b9b9b,
 0x9a9a9a9a,
 0x99999999,
 0x98989898,
 0x97979797,
 0x96969696,
 0x95959595,
 0x94949494,
 0x93939393,
 0x92929292,
 0x91919191,
 0x90909090,
 0x1f1f1f1f,
 0x1d1d1d1d,
 0x1c1c1c1c,
 0x1b1b1b1b,
 0x1a1a1a1a,
 0x19191919,
 0x18181818,
 0x17171717,
 0x16161616,
 0x15151515,
 0x14141414,
 0x13131313,
 0x12121212,
 0x11111111,
 0x10101010,
 0x8f8f8f8f,
 0x8e8e8e8e,
 0x8d8d8d8d,
 0x8c8c8c8c,
 0x8b8b8b8b,
 0x8a8a8a8a,
 0x89898989,
 0x88888888,
 0x87878787,
 0x86868686,
 0x85858585,
 0x84848484,
 0x83838383,
 0x82828282,
 0x81818181,
 0x80808080,
 0x0e0e0e0e,
 0x0d0d0d0d,
 0x0c0c0c0c,
 0x0b0b0b0b,
 0x0a0a0a0a,
 0x09090909,
 0x08080808,
 0x07070707,
 0x06060606,
 0x05050505,
 0x04040404,
 0x03030303,
 0x02020202,
 0x01010101,
 0x00000000
);




}

