Looking Glass Source

13 Oct 1997

      To all interested parties:

The availability of this code is being made public in the hope that
other ISPs will put up trouble shooting sites of their own. I beleive
that the more troubleshooting sites publicly available at the major
exchange points the better.

I make no guarantees as to the stability or portibility of this code. I
have it running on an Ultra 1 with Solaris 2.5.1 and Apache 1.2.4 with
mod_perl. I can see no reason why it wouldn't run on any web server with
perl installed on it seperately. The code, as written, requires perl
5.004. With a few variable declaration changes it can be made to run
under 5.002. It also requires the Net::Telnet module which can be found
on CPAN and installed in a matter of minutes. It also requires the CGI
module which comes standard with the 5.004 release of PERL.

There are five variable near the beginning of the code that need to be
defined before this program will work properly.

Now that all of that is said, enjoy!

Mark Tripod
Senior Backbone Engineer
Exodus Communications

                --- CODE BEGINS HERE ---

#!/usr/local/bin/perl -w

#########################################################
#                                                       #
#       CGI program to allow NCC engineers              #
#       to access our routers for troubleshooting       #
#       purposes.                                       #
#                                                       #
#       Mark Tripod  Exodus Communications              #
#                       9/23/97                         #
#                                                       #
#########################################################

use strict;
use Net::Telnet;
use CGI;

require 5.004; # With a few minor code modifications this could be 
               # changed to 5.002

################
#  Begin MAIN  #
################

# Global variables
use vars qw(@return $site $router %Sites); 

############
# DEFINE THESE VARIABLE FIRST
############
my $company = '';               # Company name for WWW header
my $logo = '/icons/logo.gif';   # Path to company logo (if exists)
my $timeout = '45';             # Time to wait for remote command to
respond
my $user = '';                  # User ID to login to routers
my $passwd = '';                # Router login password
my $email = '';                 # email account to send comments to

# Sites passed over command line must be defined 
# in a file called "looking-glass.sites".
# The file format is a two column tab seperated list containing
# the site name in the first column and the router IP
# address in the second column. Each line contains one site entry. 
# This is done not only for cleaner looking URIs,
# but for security reasons also.

open(SITES, 'looking-glass.sites') || die "Looking Glass Sites: $!\n";
while( defined( my $var = <SITES> ) ) {
  my ($sitename, $siteip) = split(/\t/, $var);
  $Sites{$sitename} = $siteip;
  }
close(SITES);

my $q = new CGI;
$q->use_named_parameters(1);

#$q->nph(1); # I was playing with using non-parsed headers for the
tracing
             # and ping utilities, but I haven't had time to work out
all
             # of the buffering issues.

print $q->header();

if ($q->request_method eq 'POST') { 
  &ExecCmd(); 
  &DisplayResult();
  }
elsif ($q->request_method eq 'GET') {
  # Site to look into comes from command line (or in this case
  # the text after the "?" in the HTML link)
  $site = shift;
  die &Usage() unless $site;
  $router = $Sites{$site};
  &DisplayForm();
  }
else { &DisplayForm(); }

print "<HR SIZE=2 WIDTH=85%>";
print "<I><CENTER>Please email questions/comments to
$email</CENTER></I>";
print $q->end_html();

##############
#  End MAIN  #
##############

sub DisplayForm {
  my $Site;
  if ($Sites{$site} eq '') { &NoSupport(); return; }
  if ($site eq 'Mae-West-mfs') { $Site = 'Mae-West (MFS)'; }
  elsif ($site eq 'Mae-West-ames') { $Site = 'Mae-West (AMES)'; }
  else { $Site = $site; }

# Some JavaScript for a help button that is displayed. I use the help
window to
# display an explaination for each of the commands listed on the web
page
# as well as list pointers to Ciscos online documentation if more
information
# is needed.

  print <<"Script";
<SCRIPT>
  function HelpWin() {

Win1=open('/public/look_help.html',"HelpWin","height=400,width=400,scrollbars=yes,resize=yes");
    }
</SCRIPT>
Script

  print $q->start_html('title'=>"$company : $Site Looking Glass",
                       'BGCOLOR'=>'FFFFFF',
                       'TEXT'=>'0F0F0F'
                      );
  print "<IMG SRC=\"$logo\">\n";
  print "<H2><CENTER>$Site Looking Glass</CENTER><BR></H2>\n";
  print $q->start_form();
  print $q->hidden('name'=>'site', 'default'=>$site);
  print "Select a query type:<BR><BR>\n";

# Leading spaces are needed in the value list below to keep
# the radio button names from being displayed right next
# to the buttons themselves. I supposed I could strip them,
# but I can't see any useful reason to do so.
  print $q->radio_group( 'name'=>'query_type',
                         'values'=>[' Access List',
                                    ' BGP',
                                    ' BGP Summary',
                                    ' Dampened AS Paths',
                                    ' Environmental',
                                    ' Route Flap Statistics',
                                    ' Ping from this site',
                                    ' Trace from this site'],
                         'default'=>' BGP',
                         'rows'=>'3', 'cols'=>'3',
                         'linebreak'=>'true'
                       );
  print "<BR><BR>Address: ";
  print $q->textfield( 'name'=>'address', 'size'=>'18');
  print "<BR><BR>\n";
  print "<TABLE WIDTH=100\%>";
  print "<TR><TD WIDTH=33\%><CENTER>", $q->submit('Submit'),
"</CENTER>\n";
  print "<TD WIDTH=33\%><CENTER>";
  print "<INPUT TYPE=button NAME=but1 VALUE=\"View Help\"
onclick=\"HelpWin()\"></CENTER>\n";
  print "<TD WIDTH=33\%><CENTER>", $q->reset(), "</CENTER>\n";
  print "</TABLE>";
  print "<BR>\n";
  print $q->endform();
}

sub ExecCmd {
# Translate commands into usable router statements.
  my %Commands = ( ' Access List'             => 'sh ip access-list',
                   ' BGP'                     => 'sh ip bgp',
                   ' BGP Summary'             => 'sh ip bgp sum',
                   ' Dampened AS Paths'       => 'sh ip bgp damp',
                   ' Environmental'           => 'sh env all',
                   ' Route Flap Statistics'   => 'sh ip bgp flap',
                   ' Ping from this site'     => 'ping',
                   ' Trace from this site'    => 'trace'
                 );
  my $cmd = $Commands{$q->param('query_type')};
  my $address = $q->param('address');
  my $router = $Sites{$q->param('site')};
  $site = $q->param('site');

  my $connection = new Net::Telnet (Host => "$router",
                                    Timeout => 10,
                                    Prompt => '/[\w\-]+>$/');
  $connection->login($user, $passwd);
  $connection->timeout($timeout);
  $connection->errmode('return');
  $connection->max_buffer_length('3048576');
  unless ($connection->cmd("terminal length 0")) { print "Can't set
terminal length"; }

  if (($address ne "") && (($q->param('query_type') eq ' BGP') ||
      ($cmd eq 'ping') || ($cmd eq 'trace'))) {
    @return = $connection->cmd("$cmd $address");
    if ($connection->timed_out()) { @return = 'Command timed out'; }
    }
  elsif (($address eq "") && ($q->param('query_type') eq ' BGP')) {

# I really don't want to kill my routers or the web server just
# because an experienced NOC person didn't bother to read the
# help page.

    @return = 'It is not recommended that the BGP table be queried
without '.
              'an address entry. <BR>This would cause a dump of the
entire '.
              'BGP route table (over 40,000 routes).';
    }
  else {
    @return = $connection->cmd("$cmd");
    if ($address ne "") {
      $address =~ s/\./\\./g;
      my @lines = grep(/$address/, @return);
      @lines = 'No matches found.' unless @lines;
      unshift(@lines, "\n"); # I like things to look nice!
      my @head = splice(@return, 0, 4);
      @return = @head;
      while( defined( my $var = shift( @lines ) ) ) { push(@return,
$var); }
      }
    if ($connection->timed_out()) { @return = 'Command timed out'; }
    }
  $connection->close;
}

sub DisplayResult {
  my $Site;
  if ($site eq 'Mae-West-mfs') { $Site = 'Mae-West (MFS)'; }
  elsif ($site eq 'Mae-West-ames') { $Site = 'Mae-West (AMES)'; }
  else { $Site = $site; }
  print $q->start_html( 'title'=>"$company : $Site Query Results",
                        'BGCOLOR'=>'FFFFFF',
                        'TEXT'=>'000000'
                      );
  print "<IMG SRC=\"$logo\">\n";
  print "<H2><CENTER>$Site Query Results</CENTER><BR></H2>\n";
  print "<PRE>\n";
  print "@return<BR>\n";
  print "</PRE>\n";
}

sub Usage {
  print $q->start_html("Error");
  print "Program cannot be run without a site designation<BR>\n";
  print $q->end_html;
  exit;
}

sub NoSupport {
  print $q->start_html('title'=>"$company : $site Looking Glass",
                       'BGCOLOR'=>'FFFFFF',
                       'TEXT'=>'0F0F0F'
                      );
  print "<IMG SRC=\"$logo\">\n";
  print "<H2><CENTER>$site is not yet supported.</CENTER></H2>";
}

                   --- CODE ENDS HERE ---