Проверка принадлежности ресурса к пирингу

#!/usr/bin/perl ## This code is based on: ## ## Zebra Looking Glass version 1.0 ## 01 FEB 2000 ## Copyright (C) 2000 John W. Fraizer III ## *All* copyright notices must remain in place to use this code. ## ## Zebra interactive console ## Copyright (C) 2000 Vladimir B. Grebenschikov ## require 5.002; use POSIX; use Net::Telnet (); use Socket; ## Set the URL for your site. $url="/cgi-bin/peering.cgi"; ############################################################ #Main ############################################################ { ## Get the form results now so we can override the default router get_form(); print "Content-type: text/html\n\n"; print ' Проверка принадлежности ресурса к пирингу

Проверка на принадлежность ресурса к локальным

Трафик с локальных ресурсов бесплатен.

Результат проверки действителен только для Абонентов компании "Электронный Щит".

'; print " Например: 10.134.0.4 '; ## Set up the address, pw and ports, etc for the selected router. @Form{'router'} = "peering"; $server = '127.0.0.1'; $login_pass = 'gfhnbpfy'; $bgpd = "2601"; $full_tables=1; if ($Form{'query'} == 1) { sh_ip_bgp('ip'); } print '

'; ## All done! exit (0); } ############################################################ sub get_form ############################################################ { #read STDIN read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs @pairs = split(/&/, $buffer); # For each name-value pair: foreach $pair (@pairs) { # Split the pair up into individual variables. local($name, $value) = split(/=/, $pair); # Decode the form encoding on the name and value variables. $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # If they try to include server side includes, erase them, so they # aren't a security risk if the html gets returned. Another # security hole plugged up. $value =~ s///g; @Form{$name} = $value ; } } ############################################################ sub sh_ip_bgp ############################################################ { my $protocol = shift(@_); $port = $bgpd; if($port eq '') { print"Sorry. BGP commands is disabled for this router."; exit(0); } if ($protocol ne 'ip' && $protocol ne 'ipv6') { print "Invalid protocol: $protocol\n"; print "protocol must be 'ip' or 'ipv6'\n\n"; return; } @arr=split /\./,$Form{'arg'}; if ($Form{'arg'} eq ''){ print'

Проверяемый IP адрес не введен!

'; }else{ if ($arr[0] =~ m/^(\d{1,3}\.){3}.\d{1,3}$/){ $command = "sh ip ro $Form{'arg'}"; $getname=0; }else{ $getname=1; if (@addresses = gethostbyname($Form{'arg'})){ @addresses = map { inet_ntoa($_) } @addresses[4 .. $#addresses]; $command="show ip ro $addresses[0]"; }else{ print'

Введен низвестный хост.

'; exit(0); } } execute_command(); } } ############################################################ sub execute_command ############################################################ { my $cmd = $command; my $t = new Net::Telnet (Timeout => 10, Prompt => '/[\>\#] $/', Port => $port); $t->open ($server) or die "Извините, проверка в настоящий момент не доступна."; $t->cmd ($login_pass); if ($cmd) { docmd ($t, $cmd); } } ############################################################ sub docmd ############################################################ { my ($t, $cmd) = @_; my @lines = $t->cmd ($cmd); print "

\n";
  my $flag=1;     
  foreach $string (@lines){
   if( ($string =~ m/Routing entry for 0.0.0.0/i) or $string=~ m/Unknown command/i ){
    $flag=0;   
   }
  }
    if($flag){
	    print("Адрес $Form{'arg'} ");
	    if($getname){ print("($addresses[0])"); }
	    print(" является локальным.");
	    print(" ");

    }else{
    
	print '
	Внимание!    
	Адрес ';

	print ("$Form{'arg'} ");

	if($getname) { print("($addresses[0])"); }

	print " не является локальным!";
	print(" ");

    }
#  print join ('', grep (!/[\>\#] $/, @lines)), "\n";
  print "

"; }