File Coverage

blib/lib/RAS/AS5200.pm

Criterion	Covered	Total	%
statement	15	157	9.5
branch	1	56	1.7
condition	1	15	6.6
subroutine	4	11	36.3
pod	8	8	100.0
total	29	247	11.7

### AS5200.pm
### PERL module for talking to a Cisco AS5200 access router
#########################################################

package RAS::AS5200;
$VERSION = "1.04";

use strict "subs"; use strict "refs";

# This uses Net::Telnet to connect to the RAS
use Net::Telnet ;

# The name $ras will be used consistently as the
# reference to the RAS::AS5200 object we're handling

# The constructor method, of course
sub new {
   my($class) = shift ;
   my($ras) = {} ;
   %$ras = @_ ;

   unless ($ras->{hostname}) { warn "ERROR: ", (ref($class) || $class), " - Hostname not specified.\n"; return(); }
   $ras->{'VERSION'} = $VERSION;
   $ras->{prompt} = '\w*[>#]' unless $ras->{prompt};

   bless($ras, ref($class) || $class);
}


# for debugging - printenv() prints to STDERR
# the entire contents of %$ras
sub printenv {
   my($ras) = shift;
   while (($key,$value) = each(%$ras)) { warn "$key = $value\n"; }
   return();
}


# run_command() is the heart of this module's functionality
# This runs the specified commands on the router and returns
# a list of refs to arrays containing the commands' output
sub run_command {
   my($ras) = shift;
   my(@returnlist);
   my($prompt) = '/' . $ras->{prompt} . '$/';

   while ($command = shift) {
      my($session) = new Net::Telnet;
      $session->errmode("return");
      $session->open($ras->{hostname});
      if ($session->errmsg) {
         warn "ERROR: ",ref($ras)," - Cannot connect to host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }

      # If a login name is supplied, wait for the Login: prompt.
      # Otherwise, send a blank password.
      # This is a workaround for 2 changes in early versions of IOS 11
      # 1. IOS 11.3 asks for login and password, 11.2 asks only for password
      # 2. IOS 11.2 - the first password prompt fails to authenticate about
      #    1/4 of the time, so it's best to send a blank password for the
      #    first password prompt
      if ($ras->{login}) {
         $session->waitfor('/Login: $/i');
         if ($session->errmsg) {
            warn "ERROR: ",ref($ras)," - Waiting for login prompt on host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }
         $session->print($ras->{login});
      }
      else {
         $session->waitfor('/Password: $/i');
         if ($session->errmsg) {
            warn "ERROR: ",ref($ras)," - Waiting for password prompt on host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }
         $session->print("");
      }
      $session->waitfor('/Password: $/i');
      $session->print($ras->{password});
      if ($session->errmsg) {
         warn "ERROR: ",ref($ras)," -  Waiting for password prompt on host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }

      # Okay, we're logged in. Get the command prompt.
      $session->waitfor($prompt);
      if ($session->errmsg) {
         warn "ERROR: ",ref($ras)," - Waiting for command prompt on host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }
      my(@output);

      # If the command was prefixed with "ENABLE " then go into enable mode first.
      if ($command =~ s/^ENABLE //) {
         $session->print("enable");
         $session->waitfor('/Password: $/');
         $session->print($ras->{enablepassword});
         if ($session->errmsg) {
            warn "ERROR: ",ref($ras)," - Waiting for enable password prompt on host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }
         $session->waitfor($prompt);
         if ($session->errmsg) {
            warn "ERROR: ",ref($ras)," - Waiting for post-enable command prompt on host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }
      }

      # Send the command and keep paging down and grab the output
      $session->print($command);
      while (1) {
         $session->print(""); my($line) = $session->getline;
         if ($session->errmsg) {
            warn "ERROR: ",ref($ras)," - Waiting on output from command \"$command\" on host $ras->{hostname} - ",$session->errmsg,"\n"; return(); }
         if ($line eq "[confirm]") { $session->print("y"); next; }
         if ($line =~ /^$ras->{prompt}$/) { $session->print("exit"); $session->close; last; }
         $line =~ s/^\s?--More--\s*\010+\s+\010+//;
         push(@output, $line);
      }

      shift(@output); # Trim the echoed command
      push(@returnlist, \@output);
   } # end of shifting commands

   # We're returning a list of references to lists.
   # Each ref points to an array containing the returned text
   # from the command, and the list of refs corresponds
   # to the list of commands we were given
   return(@returnlist);
} # end of run_command


# usergrep() - takes a username and returns an array of
# ports on which the user was found
sub usergrep {
   my($ras) = shift;
   my($username) = shift; return() unless $username;
   if ($ras->{truncateusernames}) { $username = substr($username,0,10); }
   my($output) = $ras->run_command('show users');
   my(@ports);

   foreach (@$output) {
      my($port,$user);
      next unless (/^\s+\d+ tty \d+\s/ || /^\s+Se\d+\:\d+\s/);
      $port = unpack("x0 a12", $_) ; $port =~ s/^\s*\d* //; $port =~ s/\s*$//;
      $user = unpack("x13 a10", $_); $user =~ s/^\s*//; $user =~ s/\s*$//;
      ($user eq $username) && push(@ports,$port);
   }
   return(@ports);
}


# userports() returns a hash of arrays
# keys are the usernames of all users currently connected
# values are arrays of ports that that user in connected on
sub userports {
   my($ras) = shift;
   my($output) = $ras->run_command('show users');
   my(%userports);

   foreach (@$output) {
     my($port,$user);
     next unless (/^\s+\d+ tty \d+\s/ || /^\s+Se\d+\:\d+\s/);
     $port = unpack("x0 a12", $_) ; $port =~ s/^\s*\d* //; $port =~ s/\s*$//;
     $user = unpack("x13 a10", $_); $user =~ s/^\s*//; $user =~ s/\s*$//;
     push(@{$userports{$user}},$port);
   }
   return(%userports);
}


# portusage() returns an array: 1st element is the # of ports and the
# rest of the elements are usernames of users currently logged on
sub portusage {
   my($ras) = shift;
   my($interfaces,$connections) = $ras->run_command('sho isdn status','show users');
   my(@users, $totalports);

   $totalports = 23 * scalar(grep(/^ISDN Serial\S+ interface$/, @$interfaces));

   foreach (@$connections) {
      my($port,$user);
      next unless (/^\s+\d+ tty \d+ / || /^\s+Se\d+\:\d+ /);
      $user = unpack("x13 a10", $_); $user =~ s/^\s*(\S+)\s*$/$1/;
      next if ($user =~ /^\s*$/);
      push(@users,$user);
   }

   return($totalports,@users);
}


# userkill() does a usergrep() and then disconnects the specified user
sub userkill {
   my($ras) = shift;
   my($username); $username = shift; return() unless $username;
   if ($ras->{truncateusernames}) { $username = substr($username,0,10); }
   my(@ports) = $ras->usergrep($username);
   return('') unless @ports;

   my(@killcommands);
   foreach (@ports) {
      if (/^tty/)   { push(@killcommands, "ENABLE clear line $_"); }
      elsif (/^Se/) { push(@killcommands, "ENABLE clear int $_"); }
   }

   $ras->run_command(@killcommands);
   return(@ports);
}


# killexcessoutoctets() takes a bytelimit and if a interfaces
# outoctets/bytes exceeds that limit the interface is cleared and then the
# counters for the interface are reset. Used to stop radius counters
# wrapping ie. 32 bit signed int wraps into negative at about 2 gig
sub killexcessoutoctets {
  my($ras) = shift;
  my($bytelimit) = shift;
  my %userports = $ras->userports;

  foreach $user (keys %userports) {
    foreach $arraycnt (0 .. (@{$userports{$user}} - 1)) {
      my($result) = $ras->run_command('show interface ' .  $userports{$user}[$arraycnt]);
      foreach (@$result) {
        next unless (/\s+\d+ packets output, (\d+) bytes.+/);
        my $outoctets = $1;
        if ($outoctets > $bytelimit) {
          $ras->run_command('ENABLE clear int ' .  $userports{$user}[$arraycnt] , 'ENABLE clear counter ' .  $userports{$user}[$arraycnt]);
           next;
        }
      }
    }
  }
 return(1);
}

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

1;#So PERL knows we're cool

__END__;