/
makani
/
lg
Обзор
Документация
Войти
/
makani
/
lg
Код
Запросы
0
Задачи
Вики
Пакеты
0
Релизы
0
Аналитика
Безопасность
develop
lg.cgi
1 282 строки
42 KB
Makani
EnableIPv4 attribute in lg.conf
02 авг 2017, 20:06
02 авг 2017, 20:06
0c45ed5
Код
Авторство
О чём код?
#!/usr/bin/perl # # Looking Glass CGI with ssh, telnet, rexec and remote LG support # with IPv4 and IPv6 support # # Copyright (C) 2000-2014 Cougar <cougar@random.ee> # http://www.version6.net/ # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # use strict qw(subs vars); my $configfile = "lg.conf"; #$configfile = "lg.conf"; $ENV{HOME} = "."; # SSH needs access for $HOME/.ssh use XML::Parser; my $SYS_progid = '$Id: lg.cgi,v 1.30 2004/11/25 14:12:42 cougar Exp $'; my $default_ostype = "ios"; my $lgurl; my $logfile; my $asfile; my $logoimage; my $logoalign; my $logolink; my $title; my $favicon; my $email; my $rshcmd; my $ipv4enabled; my $ipv6enabled; my $httpmethod = "POST"; my $timeout; my $disclaimer; my $securemode = 1; my $ssh2key; my $ssh2pubkey; my %router_list; my @routers; my %namemap; my %ostypes; my %logicalsystem; my %cmdmap; my $default_router; my $xml_current_router_name = ""; my $xml_current_cgi_name = ""; my $xml_current_replace_name = ""; my $xml_current_replace_proto = ""; my %valid_query = ( "ios" => { "ipv4" => { "bgp" => "show ip bgp %s", "advertised-routes" => "show ip bgp neighbors %s advertised-routes", "summary" => "show ip bgp summary", "ping" => "ping %s", "trace" => "traceroute %s" }, "ipv6" => { "bgp" => "show bgp ipv6 unicast %s", "advertised-routes" => "show bgp ipv6 unicast neighbors %s advertised-routes", "summary" => "show bgp ipv6 unicast summary", "ping" => "ping ipv6 %s", "trace" => "traceroute ipv6 %s" } }, "iosxr" => { "ipv4" => { "bgp" => "show bgp ipv4 unicast %s", "advertised-routes" => "show bgp ipv4 unicast neighbors %s advertised-routes", "summary" => "show bgp ipv4 unicast summary", "ping" => "ping %s", "trace" => "traceroute %s" }, "ipv6" => { "bgp" => "show bgp ipv6 unicast %s", "advertised-routes" => "show bgp ipv6 unicast neighbors %s advertised-routes", "summary" => "show bgp ipv6 unicast summary", "ping" => "ping ipv6 %s", "trace" => "traceroute ipv6 %s" } }, "zebra" => { "ipv4" => { "bgp" => "show ip bgp %s", "advertised-routes" => "show ip bgp neighbors %s advertised-routes", "summary" => "show ip bgp summary", "ping" => "ping %s", "trace" => "traceroute %s" }, "ipv6" => { "bgp" => "show bgp ipv6 %s", "advertised-routes" => "show bgp ipv6 neighbors %s advertised-routes", "summary" => "show bgp ipv6 summary", "ping" => "ping ipv6 %s", "trace" => "traceroute ipv6 %s" } }, "junos" => { "ipv4" => { "trace" => "traceroute %s as-number-lookup" }, "ipv6" => { "trace" => "traceroute %s" }, "ipv46" => { "bgp" => "show bgp %s", "advertised-routes" => "show route advertising-protocol bgp %s %s", "summary" => "show bgp summary", "ping" => "ping count 5 %s" } }, "vyatta" => { "ipv4" => { "bgp" => "show ip bgp %s", "advertised-routes" => "show ip bgp neighbors %s advertised-routes", "summary" => "show ip bgp summary", "ping" => "ping %s", "trace" => "traceroute %s" } }, "routeros" => { "ipv46" => { "advertised-routes" => "/routing bgp advertisements print where peer=\"%s\" && prefix=\"%s\"", "ping" => "/tool ping \"%s\" count=5", "trace" => "/tool traceroute \"%s\"" } } ); my %whois = ( "RIPE" => "https://apps.db.ripe.net/search/query.html?searchtext=AS%s&flags=&sources=RIPE_NCC&grssources=&inverse=&types=#resultsAnchor#resultsAnchor", "ARIN" => "http://whois.arin.net/rest/asn/AS%s/pft", "APNIC" => "http://www.apnic.net/apnic-bin/whois.pl?searchtext=AS%s", "default" => "http://www.sixxs.net/tools/whois/?AS%s" ); $| = 1; &read_config; # grab CGI data my $incoming; if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'}); } else { $incoming = $ENV{'QUERY_STRING'}; } my %FORM = &cgi_decode($incoming); my $date = localtime; if ($logfile ne "") { open(LOG, ">>$logfile"); ($ENV{REMOTE_HOST}) && ( print LOG "$ENV{'REMOTE_HOST'} "); ($ENV{REMOTE_ADDR}) && ( print LOG "$ENV{'REMOTE_ADDR'} "); print LOG "- - [$date]"; ($ENV{HTTP_REFERER}) && ( print LOG " $ENV{'HTTP_REFERER'}"); } my $query_cmd = ""; if (defined $valid_query{$ostypes{$FORM{router}}}{"ipv46"}{$FORM{query}}) { $query_cmd = $valid_query{$ostypes{$FORM{router}}}{"ipv46"}{$FORM{query}}; } elsif (defined $valid_query{$ostypes{$FORM{router}}}{lc($FORM{protocol})}{$FORM{query}}) { $query_cmd = $valid_query{$ostypes{$FORM{router}}}{lc($FORM{protocol})}{$FORM{query}}; } elsif (($FORM{router} ne "") || ($FORM{protocol} ne "") || ($FORM{query})) { if ($logfile ne "") { print LOG " \"$FORM{router}\" \"ILLEGAL QUERY: [$ostypes{$FORM{router}}] [$FORM{protocol}] [$FORM{query}]\"\n"; close(LOG); } &print_head; &print_form; &print_tail; exit; } if ((! defined $router_list{$FORM{router}}) || ($query_cmd eq "")) { if ($logfile ne "") { print LOG "\n"; close(LOG); } &print_head; &print_form; &print_tail; exit; } $FORM{addr} =~ s/\s.*// if (($FORM{query} eq "ping") || ($FORM{query} eq "trace")); $FORM{addr} =~ s/[^\s\d\.:\w\-_\/\$]//g; if ($router_list{$FORM{router}} =~ /^http[s]{0,1}:/) { if ($logfile ne "") { print LOG " \"$FORM{router}\" \"$FORM{query}" . ($FORM{addr} ne "" ? " $FORM{addr}" : "") . "\"\n"; close LOG; } if ($router_list{$FORM{router}} =~ /\?/) { $incoming = "&$incoming"; } else { $incoming = "?$incoming"; } my $remote = $router_list{$FORM{router}}; if (defined $cmdmap{$remote}{lc($FORM{protocol})}) { $incoming .= "&"; my $mapref = $cmdmap{$remote}{lc($FORM{protocol})}; foreach my $key (keys (%{$mapref})) { next if ($key eq "DEFAULT"); (my $urlkey = $key) =~ s/([+*\/\\])/\\$1/g; if (${$mapref}{$key} eq "") { $incoming =~ s/([\?\&])($urlkey)=[^\&]*\&/$1/g; } elsif (${$mapref}{$key} =~ /=/) { $incoming =~ s/([\?\&])($urlkey)\&/"${1}${$mapref}{$2}&"/e; } } foreach my $key (keys (%{$mapref})) { next if ($key eq "DEFAULT"); $incoming =~ s/([\?\&])($key)=/"${1}${$mapref}{$2}="/e; } $incoming =~ s|&$||g; if (defined ${$mapref}{DEFAULT}) { $incoming .= "&${$mapref}{DEFAULT}"; } } print "Location: $router_list{$FORM{router}}${incoming}\n\n"; exit; } my $command = sprintf($query_cmd, $FORM{addr}); print LOG " \"$FORM{router}\" \"$command\"\n"; close LOG; &print_head($command); if ($FORM{addr} !~ /^[\w\.\^\$\-\/ ]*$/) { if ($FORM{addr} =~ /^[\w\.\^\$\-\:\/ ]*$/) { if (($FORM{protocol} ne "IPv6") && ($ostypes{$FORM{router}} ne "junos")){ &print_error("ERROR: IPv6 address for IPv4 query"); } } else { &print_error("Illegal characters in parameter string"); } } $FORM{addr} = "" if ($FORM{addr} =~ /^[ ]*$/); if ($query_cmd =~ /%s/) { &print_error("Parameter missing") if ($FORM{addr} eq ""); } else { &print_warning("No parameter needed") if ($FORM{addr} ne ""); } my %AS; if ($asfile =~ /\.db$/) { use DB_File; tie (%AS, 'DB_File', $asfile, O_RDONLY, 0644, $DB_HASH) or print STDERR "Can\'t read AS database $asfile: $!\n"; } else { %AS = &read_as_list($asfile); } my $table; $table = "table inet.0" if ($FORM{protocol} eq "IPv4"); $table = "table inet6.0" if ($FORM{protocol} eq "IPv6"); if ($ostypes{$FORM{router}} eq "junos") { if ($command =~ /^show bgp n\w*\s+([\d\.A-Fa-f:]+)$/) { # show bgp n.. <IP> ---> show bgp neighbor <IP> $command = "show bgp neighbor $1"; } elsif ($command =~ /^show bgp n\w*\s+([\d\.A-Fa-f:]+) ro\w*$/) { # show bgp n.. <IP> ro.. ---> show route receive-protocol bgp <IP> $command = "show route receive-protocol bgp $1 $table"; } elsif ($command =~ /^show bgp neighbors ([\d\.A-Fa-f:]+) routes all$/) { # show bgp neighbors <IP> routes all ---> show route receive-protocol bgp <IP> all $command = "show route receive-protocol bgp $1 all $table"; } elsif ($command =~ /^show bgp neighbors ([\d\.A-Fa-f:]+) routes damping suppressed$/) { # show bgp neighbors <IP> routes damping suppressed ---> show route receive-protocol bgp <IP> damping suppressed $command = "show route receive-protocol bgp $1 damping suppressed $table"; } elsif ($command =~ /^show bgp n\w*\s+([\d\.A-Fa-f:]+) advertised-routes ([\d\.A-Fa-f:\/]+)$/) { # show ip bgp n.. <IP> advertised-routes <prefix> ---> show route advertising-protocol bgp <IP> <prefix> exact detail $command = "show route advertising-protocol bgp $1 $2 exact detail $table"; } elsif ($command =~ /^show bgp n\w*\s+([\d\.A-Fa-f:]+) receive-protocol ([\d\.A-Fa-f:\/]+)$/) { # show ip bgp n.. <IP> receive-protocol <prefix> ---> show route receive-protocol bgp <IP> <prefix> exact detail $command = "show route receive-protocol bgp $1 $2 exact detail $table"; } elsif ($command =~ /^show bgp n\w*\s+([\d\.A-Fa-f:]+) a[\w\-]*$/) { # show ip bgp n.. <IP> a.. ---> show route advertising-protocol bgp <IP> $command = "show route advertising-protocol bgp $1 $table"; } elsif ($command =~ /^show bgp\s+([\d\.A-Fa-f:]+\/\d+)$/) { # show bgp <IP>/mask ---> show route protocol bgp <IP> all $command = "show route protocol bgp $1 terse exact all $table"; } elsif ($command =~ /^show bgp\s+([\d\.A-Fa-f:]+)$/) { # show bgp <IP> ---> show route protocol bgp <IP> all $command = "show route protocol bgp $1 terse $table"; } elsif ($command =~ /^show bgp\s+([\d\.A-Fa-f:\/]+) exact$/) { # show bgp <IP> exact ---> show route protocol bgp <IP> exact detail all $command = "show route protocol bgp $1 exact detail all $table"; } elsif ($command =~ /^show bgp re\w*\s+(.*)$/) { # show ip bgp re <regexp> ---> show route aspath-regex <regexp> all my $re = $1; $re = ".*${re}" if ($re !~ /^\^/); $re = "${re}.*" if ($re !~ /\$$/); $re =~ s/_/ /g; $command = "show route protocol bgp aspath-regex \"$re\" all $table terse"; } } &run_command($FORM{router}, $router_list{$FORM{router}}, $command); &print_tail; exit; sub read_config { my $xp = new XML::Parser(ProtocolEncoding => "ISO-8859-1", Handlers => {Char => \&xml_charparse, Start => \&xml_startparse, End => \&xml_endparse}); $xp->parsefile($configfile); undef($xp); } sub xml_charparse { my ($xp,$str) = @_; return if $str =~ /^\s*$/m; my $elem = lc($xp->current_element); if ($xml_current_router_name ne "") { if ($elem eq "url") { $router_list{$xml_current_router_name} = $str; push @routers, $xml_current_router_name; } elsif ($elem eq "title") { $namemap{$xml_current_router_name} .= $str; } else { die("Illegal value for configuration tag \"" . $xp->current_element . "\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif (($xml_current_cgi_name ne "") && ($xml_current_replace_name ne "")) { if (($elem eq "replace") || ($elem eq "default")) { $cmdmap{$xml_current_cgi_name}{"ipv4"}{$xml_current_replace_name} .= $str if ($xml_current_replace_proto ne "ipv6"); $cmdmap{$xml_current_cgi_name}{"ipv6"}{$xml_current_replace_name} .= $str if ($xml_current_replace_proto ne "ipv4"); } else { die("Illegal value for configuration tag \"" . $xp->current_element . "\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($elem eq "lgurl") { $lgurl = $str; } elsif ($elem eq "logfile") { $logfile = $str; } elsif ($elem eq "aslist") { $asfile = $str; } elsif ($elem eq "logoimage") { $logoimage = $str; } elsif ($elem eq "htmltitle") { $title = $str; } elsif ($elem eq "favicon") { $favicon = $str; } elsif ($elem eq "contactmail") { $email = $str; } elsif ($elem eq "rshcmd") { $rshcmd = $str; } elsif ($elem eq "httpmethod") { $httpmethod = $str; } elsif ($elem eq "timeout") { $timeout = $str; } elsif ($elem eq "disclaimer") { $disclaimer = "<CENTER><TABLE WIDTH=\"85%\"><TR><TD><DIV ALIGN=\"CENTER\"><FONT SIZE=-3>Disclaimer: $str</FONT></DIV></TD></TR></TABLE></CENTER>\n"; } elsif ($elem eq "securemode") { if ($str =~ /^(0|off|no)$/i) { $securemode = 0; } elsif ($str =~ /^(1|on|yes)$/i) { $securemode = 1; } else { die("Illegal securemode \"$str\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($elem eq "separator") { push @routers, "---- $str ----"; } elsif ($elem eq "ssh2key") { $ssh2key = $str; } elsif ($elem eq "ssh2pubkey") { $ssh2pubkey = $str; } else { print "<!-- C [$xml_current_router_name] [" . $xp->current_element . "] [$str] -->\n"; } } sub xml_startparse { my ($xp,$str,@attrval) = @_; my $elem = lc($xp->current_element); my $str2 = lc($str); if ($elem eq "") { if ($str2 ne "lg_conf_file") { die("Illegal configuration tag \"$str\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($elem eq "lg_conf_file") { if ($str2 eq "logoimage") { for (my $i = 0; $i <= $#attrval; $i += 2) { if (lc($attrval[$i]) eq "align") { $logoalign = " Align=\"" . $attrval[$i+1] . "\""; } elsif (lc($attrval[$i]) eq "link") { $logolink = $attrval[$i+1]; } else { die("Illegal parameter for LogoImage \"" . $attrval[$i] . "\" at line " . $xp->current_line . ", column " . $xp->current_column); } } } elsif (($str2 ne "lgurl") && ($str2 ne "logfile") && ($str2 ne "aslist") && ($str2 ne "htmltitle") && ($str2 ne "favicon") && ($str2 ne "contactmail") && ($str2 ne "rshcmd") && ($str2 ne "httpmethod") && ($str2 ne "timeout") && ($str2 ne "disclaimer") && ($str2 ne "securemode") && ($str2 ne "ssh2key") && ($str2 ne "ssh2pubkey") && ($str2 ne "router_list") && ($str2 ne "argument_list")) { die("Illegal configuration tag \"$str\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($elem eq "router_list") { if ($str2 eq "router") { for (my $i = 0; $i <= $#attrval; $i += 2) { if (lc($attrval[$i]) eq "name") { $xml_current_router_name = $attrval[$i+1]; $ostypes{$xml_current_router_name} = lc($default_ostype); $ipv4enabled ++; } elsif (lc($attrval[$i]) eq "default") { if (lc($attrval[$i+1]) eq "yes") { $default_router = $xml_current_router_name; } elsif (lc($attrval[$i]) eq "enableipv4") { + if (lc($attrval[$i+1]) eq "yes") { + $ipv4enabled++; + } } elsif (lc($attrval[$i]) eq "enableipv6") { if (lc($attrval[$i+1]) eq "yes") { $ipv4enabled--; $ipv6enabled++; } } elsif (lc($attrval[$i]) eq "ostype") { $ostypes{$xml_current_router_name} = lc($attrval[$i+1]); } elsif (lc($attrval[$i]) eq "logical-system") { $logicalsystem{$xml_current_router_name} = lc($attrval[$i+1]); } } if ($xml_current_router_name eq "") { die("Variable \"Name\" missing at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($str2 eq "separator") { } else { die("Illegal configuration tag \"$str\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($elem eq "router") { if (($str2 ne "title") && ($str2 ne "url")) { die("Illegal configuration tag \"$str\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($elem eq "argument_list") { if ($str2 eq "lg") { for (my $i = 0; $i <= $#attrval; $i += 2) { if (lc($attrval[$i]) eq "url") { $xml_current_cgi_name = $attrval[$i+1]; } } if ($xml_current_cgi_name eq "") { die("Variable \"URL\" missing at line " . $xp->current_line . ", column " . $xp->current_column); } } else { die("Illegal configuration tag \"$str\" at line " . $xp->current_line . ", column " . $xp->current_column); } } elsif ($elem eq "lg") { if ($str2 eq "replace") { for (my $i = 0; $i <= $#attrval; $i += 2) { if (lc($attrval[$i]) eq "param") { $xml_current_replace_name = $attrval[$i+1]; } elsif (lc($attrval[$i]) eq "proto") { $xml_current_replace_proto = lc($attrval[$i+1]); } } if ($xml_current_replace_name eq "") { die("Variable \"Param\" missing at line " . $xp->current_line . ", column " . $xp->current_column); } $cmdmap{$xml_current_cgi_name}{"ipv4"}{$xml_current_replace_name} = "" if ($xml_current_replace_proto ne "ipv6"); $cmdmap{$xml_current_cgi_name}{"ipv6"}{$xml_current_replace_name} = "" if ($xml_current_replace_proto ne "ipv4"); } elsif ($str2 eq "default") { $xml_current_replace_name = "DEFAULT"; } else { die("Illegal configuration tag \"$str\" at line " . $xp->current_line . ", column " . $xp->current_column); } } else { die("ASSERT str=\"$str\" elem=\"" . $xp->current_element . "\" at line " . $xp->current_line . ", column " . $xp->current_column); } } sub xml_endparse { my ($xp,$str) = @_; my $elem = lc($xp->current_element); my $str2 = lc($str); if ($elem eq "router_list") { if ($str2 eq "router") { $xml_current_router_name = ""; } } elsif ($elem eq "lg") { if (($str2 eq "replace") || ($str2 eq "default")) { $xml_current_replace_name = ""; $xml_current_replace_proto = ""; } } } sub print_head { my ($arg) = @_; my ($titlestr) = $title; $titlestr .= " - $arg" if ($arg ne ""); print "Content-type: text/html; charset=utf-8\n\n"; print "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n"; print "<!--\n\t$SYS_progid\n\thttp://freshmeat.net/projects/lg/\n-->\n"; print "<HTML>\n"; print "<HEAD>\n"; print "<TITLE>$titlestr</TITLE>\n"; if ($favicon ne "") { print "<LINK REL=\"shortcut icon\" HREF=\"${favicon}\">\n"; } print "<meta name=description content=\"$titlestr\"\>\n"; print "<meta name=keywords content=\"Looking glass, LG, BGP, prefix-list, AS-path, ASN, traceroute, ping, IPv6, Cisco, Juniper, Zebra, Quagga, internet\"/>\n"; print "<style>em { font-style: normal; background: #ffff00; color: #000000; }</style>\n"; print "</HEAD>\n"; print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\">\n"; if ($logoimage ne "") { print "<TABLE BORDER=\"0\" WIDTH=\"100%\"><TR><TD$logoalign>"; print "<A HREF=\"$logolink\">" if ($logolink ne ""); print "<IMG SRC=\"$logoimage\" BORDER=\"0\" ALT=\"LG\">"; print "</A>" if ($logolink ne ""); print "</TD></TR></TABLE>\n"; } print "<CENTER>\n"; print "<H2>$titlestr</H2>\n"; print "</CENTER>\n"; print "<P>\n"; print "<HR SIZE=2 WIDTH=\"85%\" NOSHADE>\n"; print "<P>\n"; } sub print_form { if ($httpmethod eq "GET") { print "<FORM ACTION=\"$lgurl\">\n"; } else { print "<FORM METHOD=$httpmethod ACTION=\"$lgurl\">\n"; } print <<EOT; <CENTER> <TABLE BORDER=0 BGCOLOR="#EFEFEF"><TR><TD> <TABLE BORDER=0 CELLPADDING=2 CELLSPACING=2> <TR> <TH BGCOLOR="#000000" NOWRAP><FONT COLOR="#FFFFFF">Type of Query</FONT></TH> <TH BGCOLOR="#000000" NOWRAP><FONT COLOR="#FFFFFF">Additional parameters</FONT></th> <TH BGCOLOR="#000000" NOWRAP><FONT COLOR="#FFFFFF">Node</FONT></TH></TR> <TR><TD> <TABLE BORDER=0 CELLPADDING=2 CELLSPACING=2> <TR><TD><INPUT TYPE=radio NAME=query VALUE=bgp></TD><TD> bgp</TD></TR> <TR><TD><INPUT TYPE=radio NAME=query VALUE=advertised-routes></TD><TD> bgp advertised-routes</TD></TR> <TR><TD><INPUT TYPE=radio NAME=query VALUE=summary></TD><TD> bgp summary</TD></TR> <TR><TD><INPUT TYPE=radio NAME=query VALUE=ping></TD><TD> ping</TD></TR> <TR><TD><INPUT TYPE=radio NAME=query VALUE=trace CHECKED></TD><TD> trace</TD></TR> EOT if ($ipv4enabled && $ipv6enabled) { print <<EOT; <TR><TD></TD><TD><SELECT NAME=protocol> <OPTION VALUE=IPv4> IPv4 <OPTION VALUE=IPv6> IPv6 </SELECT></TD></TR> </TABLE> EOT } elsif ($ipv4enabled) { print "</TABLE>\n<INPUT TYPE=hidden NAME=protocol VALUE=IPv4>\n"; } elsif ($ipv6enabled) { print "</TABLE>\n<INPUT TYPE=hidden NAME=protocol VALUE=IPv6>\n"; } print <<EOT; </TD> <TD ALIGN=CENTER> <BR><INPUT NAME=addr SIZE=30><BR><FONT SIZE=-1> <SUP> </SUP> </FONT></TD> <TD ALIGN=RIGHT> <BR><SELECT NAME=router> EOT my $remotelg = 0; my $optgroup = 0; for (my $i = 0; $i <= $#routers; $i++) { my $router = $routers[$i]; if ($router =~ /^---- (.*) ----$/) { $router = $1; print "</OPTGROUP>\n" if ($optgroup); print "<OPTGROUP LABEL=\"" . html_encode($router) . "\">\n"; $optgroup = 1; next; } my $descr = ""; my $default = ""; if ($FORM{router} ne "") { if ($router eq $FORM{router}) { $default = " selected"; } } elsif ($router eq $default_router) { $default = " SELECTED"; } if (defined $namemap{$router}) { $descr = $namemap{$router}; } else { $descr = $router; } if ($router_list{$router} =~ /^http/) { $descr .= " *"; $remotelg++; } print "<OPTION VALUE=\"". html_encode($router) . "\"$default> " . html_encode($descr) . "\n"; } print "</OPTGROUP>\n" if ($optgroup); if ($remotelg) { $remotelg = "<SUP>*</SUP> remote LG script"; } else { $remotelg = "<SUP> </SUP> "; } print <<EOT; </SELECT><BR><FONT SIZE=-1> $remotelg</FONT></TD> </TR> <TR><TD ALIGN=CENTER COLSPAN=3> <P> <INPUT TYPE=SUBMIT VALUE=Submit> | <INPUT TYPE=RESET VALUE=Reset> <P> </TD></TR> </TABLE> </TD></TR></TABLE> </CENTER> <P> </FORM> EOT } sub print_tail { print <<EOT; <P> <HR SIZE=2 WIDTH="85%" NOSHADE> $disclaimer <P> <CENTER> <I>Please email questions or comments to <A HREF="mailto:$email">$email</A>.</I> <P> </CENTER> </BODY> </HTML> EOT } sub print_error { print "<CENTER><FONT SIZE=+2 COLOR=\"#ff0000\">" . join(" ", @_) . "</FONT></CENTER>\n"; &print_tail; exit 1; } sub print_warning { print "<CENTER><FONT SIZE=+2 COLOR=\"#0000ff\">WARNING! " . join(" ", @_) . "</FONT></CENTER>\n"; print <<EOT; <P> <HR SIZE=2 WIDTH="85%" NOSHADE> <P> EOT } my $regexp = 0; sub run_command { my ($hostname, $host, $command) = @_; my $best = 0; my $count = 0; my $telnet; my $ssh; my $ssh2; my @output; # This regexp is from RFC 2396 - URI Generic Syntax if ($host !~ /^(([^:\/?#]+):)?(\/\/([^\/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?/) { die ("Illegal URI: \"$host\""); } my $scheme = $2; $host = $4; if ($host !~ /^((([^:\@\[]+)(:([^\@]+))?)\@)?([^\/?#]*)$/) { die ("Can't extract login/pass from host: \"$host\""); } my $login = $3; my $password = $5; $host = $6; my $port; if ($host =~ /^\[(.+)\](:([\d,]+))?$/) { $host = $1; $port = $3; } elsif ($host =~ /^([^:]+)(:([\d,]+))?$/) { $host = $1; $port = $3; } else { die ("Illegal host address \"$host\""); } print "<B>Router:</B> " . html_encode($hostname) . "\n"; print "<BR>\n"; print "<B>Command:</B> " . html_encode($command) . "\n"; print "<P><PRE><CODE>\n"; if (($command =~ /show route protocol bgp aspath-regex \"(.*)\"/) || ($command =~ /show ip bgp reg\w*\s+(.*)/)) { $regexp = $1; } #vyatta support my $prependcommand; my $postpendcommand; if ($ostypes{$FORM{router}} eq "vyatta") { if ($command =~ /^show/i) { $prependcommand = "\/usr\/bin\/vtysh -c '"; $postpendcommand = "'"; } elsif ($command =~ /^trace/i) { $prependcommand = "\/usr\/bin\/"; $postpendcommand = " -A -n"; } elsif ($command =~ /^ping/i) { $prependcommand = "\/bin\/"; $postpendcommand = " -c 10"; } } else { $prependcommand = ""; $postpendcommand = " ; quit"; } if ($scheme eq "rsh") { print_error("Configuration error, missing rshcmd") if ($rshcmd eq ""); open(P, "$rshcmd $host \'$command\' |"); while (<P>) { showlines($_); } close(P); } elsif ($scheme eq "ssh") { eval " use IO::Handle; use Net::SSH::Perl; use Net::SSH::Perl::Cipher; "; die $@ if $@; my $remotecmd = "$prependcommand" . "$command" . "$postpendcommand"; $remotecmd = "set cli logical-system $logicalsystem{$FORM{router}}; " . $command if (defined $logicalsystem{$FORM{router}}); $port = 22 if ($port eq ""); my $ssh = Net::SSH::Perl->new($host, port => $port); if ($] > 5.007) { require Encode; $login = Encode::encode_utf8($login); $password = Encode::encode_utf8($password); $remotecmd = Encode::encode_utf8($remotecmd); } $ssh->login($login, $password); $ssh->register_handler('stdout', sub { showlines($_[1]->bytes); }); $ssh->register_handler('stderr', sub { showlines($_[1]->bytes); }); $ssh->cmd("$remotecmd"); } elsif ($scheme eq "ssh2") { eval " use Net::SSH2; "; die $@ if $@; my $remotecmd = "$prependcommand" . "$command" . "$postpendcommand"; $remotecmd = "set cli logical-system $logicalsystem{$FORM{router}}; " . $command if (defined $logicalsystem{$FORM{router}}); $port = 22 if ($port eq ""); $ssh2 = Net::SSH2->new(); $ssh2->connect($host, $port) or die $!; if ($password) { $ssh2->auth_password($login, $password); } else { $ssh2->auth_publickey($login, $ssh2pubkey, $ssh2key); } my $chan = $ssh2->channel(); $chan->blocking(1); $chan->exec("$remotecmd"); while ($chan->read($_, 1024)) { showlines($_); }; $chan->close; } elsif ($scheme eq "telnet") { my @output; eval " use Net::Telnet; "; die $@ if $@; if ($ostypes{$FORM{router}} eq "zebra") { if (($command =~ /^ping /) || ($command =~ /^traceroute /)) { $port = $1 if ($port =~ /^(\d+),\d*$/); $port = 2601 if ($port eq ""); } else { $port = $1 if ($port =~ /^\d*,(\d+)$/); $port = 2605 if ($port eq ""); } } $port = 23 if ($port eq ""); my $telnet = new Net::Telnet; $telnet->errmode( sub { print "ERROR:" . join('|', @_) . "\n"; } ); $telnet->timeout($timeout); $telnet->option_callback( sub { return; } ); $telnet->option_accept(Do => 31); # TELOPT_NAWS $telnet->open(Host => $host, Port => $port); if ($login ne "") { $telnet->waitfor('/(ogin|name|word):.*$/'); $telnet->print("$login"); } if ($password ne "") { $telnet->waitfor('/word:.*$/'); $telnet->print("$password"); } $telnet->waitfor(Match => '/.*[\$%>] {0,1}$/', Match => '/^[^#]*[\$%#>] {0,1}$/'); $telnet->telnetmode(0); $telnet->put(pack("C9", 255, # TELNET_IAC 250, # TELNET_SB 31, 0, 200, 0, 0, # TELOPT_NAWS 255, # TELNET_IAC 240)); # TELNET_SE $telnet->telnetmode(1); my $telnetcmd = $command; $telnetcmd .= " | no-more" if ($ostypes{$FORM{router}} eq "junos"); $telnet->print("$telnetcmd"); $telnet->getline; # read out command line while (1) { if ($#output >= 0) { $_ = shift (@output); } elsif (! $telnet->eof) { my ($prematch, $match) = $telnet->waitfor( Match => '/\n/', Match => '/[\$%#>] {0,1}$/', Errmode => "return") or do { }; if ($match =~ /[\$%#>] {0,1}$/) { $telnet->print("quit"); $telnet->close; last; } push @output, $prematch . $match; next; } else { last; } showlines($_); } } else { print_error("Configuration error, no such scheme: $scheme\n"); } print "</CODE></PRE>\n"; } my $best = 0; my $hidden = 0; my $count = 0; my $telnet; my $lastip = ""; my $inemptyheader = 1; my $linebuf = ""; my $in_func_showlines = 0; sub showlines { my $input = shift; if ($command =~ /^ping/i) { print $input; return; } $linebuf .= $input; return if ($in_func_showlines); $in_func_showlines = 1; while ($linebuf =~ /\n/) { my $line1; ($line1, $linebuf) = split(/\n/, $linebuf, 2); showline ($line1); } $in_func_showlines = 0; } sub showline { $_ = shift; chomp; next if (/Type escape sequence to abort./); next if (/Translating .*\.\.\.domain server/); next if (/Logical system: /); next if (($inemptyheader) && (/^$/)); $inemptyheader = 0; $_ = html_encode($_); if ($command =~ /^trace/i) { s/(\[AS\s*)(\d+)(\])/($1 . " " . as2link($2) . $3)/e; } elsif ($command eq "show ip bgp summary") { s/( local AS number )(\d+)/($1 . as2link($2))/e; s/^([\d\.]+\s+\d+\s+)(\d+)/($1 . as2link($2))/e; s/^(\d+\.\d+\.\d+\.\d+)(\s+.*\s+)([1-9]\d*)$/($1 . $2 . bgplink($3, "neighbors+$1+routes"))/e; s/^(\d+\.\d+\.\d+\.\d+)(\s+)/(bgplink($1, "neighbors+$1") . $2)/e; # Zebra IPv6 neighbours s/^(.{15} 4\s+)(\d+)/($1 . as2link($2))/e; s/^([\dA-Fa-f]*:[\dA-Fa-f:]*)(\s+)/(bgplink($1, "neighbors+$1") . $2)/e; s/^([\dA-Fa-f]*:[\dA-Fa-f:]*)$/bgplink($1, "neighbors+$1")/e; } elsif ($command eq "show bgp ipv6 summary") { s/^(.{15} 4\s+)(\d+)/($1 . as2link($2))/e; if (/^([\dA-Fa-f]*:[\dA-Fa-f:]*)\s+4\s+/) { $lastip = $1; s/^([\dA-Fa-f:]+)(\s+.*\s+)([1-9]\d*)$/($1 . $2 . bgplink($3, "neighbors+${lastip}+routes"))/e; s/^([\dA-Fa-f:]+)(\s+)/(bgplink($1, "neighbors+$1") . $2)/e; $lastip = ""; } if (/^([\dA-Fa-f:]+)$/) { $lastip = $1; s/^([\dA-Fa-f:]+)$/bgplink($1, "neighbors+$1")/e; } if (($lastip ne "") && (/^(\s+.*\s+)([1-9]\d*)$/)) { s/^(\s+.*\s+)([1-9]\d*)$/($1 . bgplink($2, "neighbors+${lastip}+routes"))/e; $lastip = ""; } } elsif ($command eq "show bgp summary") { # JunOS if ($securemode) { next if (/\.l[23]vpn/); # don't show MPLS next if (/inet6?\.2/); # don't show multicast next if (/\.inet6?\.0/); # don't show VRFs } if (/^([\dA-Fa-f:][\d\.A-Fa-f:]+)\s+/) { $lastip = $1; # IPv4 #s/^(\d+\.\d+\.\d+\.\d+)(\s+.*\s+)([1-9]\d*)(\s+\d+\s+\d+\s+\d+\s+\d+\s+[\d:ywdh]+\s+)(\d+)\/(\d+)\/(\d+)(\s+)/($1 . $2 . bgplink($3, "neighbors+$1+routes") . $4 . bgplink($5, "neighbors+$1+routes") . "\/" . bgplink($6, "neighbors+$1+routes+all") . "\/" . bgplink($7, "neighbors+$1+routes+damping+suppressed") . $8)/e; s/^(\d+\.\d+\.\d+\.\d+)(\s+)([1-9]\d*)(\s+\d+\s+\d+\s+\d+\s+\d+\s+[\d:ywdh]+\s+)(\d+)\/(\d+)\/(\d+)(\s+)/($1 . $2 . bgplink($3, "neighbors+$1+routes") . $4 . bgplink($5, "neighbors+$1+routes") . "\/" . bgplink($6, "neighbors+$1+routes+all") . "\/" . bgplink($7, "neighbors+$1+routes+damping+suppressed") . $8)/e; # IPv4/IPv6 s/^([\dA-Fa-f:][\d\.A-Fa-f:]+\s+)(\d+)(\s+)/($1 . as2link($2) . $3)/e; s/^([\dA-Fa-f:][\d\.A-Fa-f:]+)(\s+)/(bgplink($1, "neighbors+$1") . $2)/e; } if (($lastip ne "") && (/(\s+inet6?\.0: )(\d+)\/(\d+)\/(\d+)$/)) { s/^(\s+inet6?\.0: )(\d+)\/(\d+)\/(\d+)$/($1 . bgplink($2, "neighbors+${lastip}+routes") . "\/" . bgplink($3, "neighbors+${lastip}+routes+all") . "\/" . bgplink($4, "neighbors+${lastip}+routes+damping+suppressed"))/e; } } elsif (($command =~ /^show ip bgp\s+n\w*\s+[\d\.]+\s+(ro|re|a)/i) || ($command =~ /^show bgp ipv6\s+n\w*\s+[\dA-Fa-f:]+\s+(ro|re|a)/i) || ($command =~ /^show ip bgp\s+re/i) || ($command =~ /^show bgp ipv6\s+re/i) || ($command =~ /^show ip bgp\s+[\d\.]+\s+[\d\.]+\s+(l|s)/i) || ($command =~ /^show (ip bgp|bgp ipv6) prefix-list/i) || ($command =~ /^show (ip bgp|bgp ipv6) route-map/i)) { s/^([\*r ](>|d|h| ).{59})([\d\s,\{\}]+)([ie\?])$/($1 . as2link($3, $regexp) . $4)/e; s/^([\*r ](>|d|h| )[i ])([\d\.A-Fa-f:\/]+)(\s+)/($1 . bgplink($3, $3) . $4)/e; s/^([\*r ](>|d|h| )[i ])([\d\.A-Fa-f:\/]+)$/($1 . bgplink($3, $3))/e; s/^(( ){20}.{41})([\d\s,\{\}]+)([ie\?])$/($1 . as2link($3, $regexp) . $4)/e; s/(, remote AS )(\d+)(,)/($1 . as2link($2) . $3)/e; } elsif ($command =~ /^show route (?:advertising|receive)-protocol bgp [\d\.A-Fa-f:]+ [\d\.A-Fa-f:\/]+ /i) { s/^([ \*] )([\d\.A-Fa-f:\/]+)(\s+)/($1 . bgplink($2, $2) . $3)/e; s/^( AS path: )([\d\s,\{\}\[\]]+)( [IE\?] \((?:LocalAgg)?\))$/($1 . as2link($2) . $3)/e; s/^( Communities: )([\d: ]+)/($1 . community2link($2))/e; } elsif ($command =~ /^show route ((advertising|receive)-protocol) bgp\s+([\d\.A-Fa-f:]+)/i) { my $type = $1; my $ip = $3; s/^([\* ] [\d\.\s].{62})([\d\s,\{\}\[\]]+)([IE\?])$/($1 . as2link($2) . $3)/e; s/^([\* ] [\d\.\s].{22}\s)([\d\.A-Fa-f:]+)(\s+)/($1 . bgplink($2, "neighbors+$2") . $3)/e; s/^([\dA-Fa-f:\/]+)(\s+)/(bgplink($1, "$1+exact") . $2)/e; s/^([\d\.\/]+)(\s+)/(bgplink($1, "$1+exact") . $2)/e; s/^([\dA-Fa-f:\/]+)(\s*)$/(bgplink($1, "$1+exact") . $2)/e; s/^([\d\.\/]+)\s*$/(bgplink($1, "$1+exact"))/e; s/^([ \*] )([\d\.A-Fa-f:\/]+)(\s+)/($1 . bgplink($2, "neighbors+$ip+" . (($type eq "advertising-protocol")?"advertised-routes":"receive-protocol") . "+$2") . $3)/e; } elsif (($command =~ /^show ip bgp n\w*\s+([\d\.]+)/i) || ($command =~ /^show ip bgp n\w*$/i)) { $lastip = $1 if ($1 ne ""); $lastip = $1 if (/^BGP neighbor is ([\d\.]+),/); if ($securemode) { s/((Local|Foreign) port: )\d+/${1}???/g; } s/(Prefix )(advertised)( [1-9]\d*)/($1 . bgplink($2, "neighbors+$lastip+advertised-routes") . $3)/e; s/( Prefixes Total: )(\d+)( )/($1 . bgplink($2, "neighbors+$lastip+advertised-routes") . $3)/e; s/(prefixes )(received)( [1-9]\d*)/($1 . bgplink($2, "neighbors+$lastip+routes") . $3)/e; s/^( Prefixes Current: \s+)(\d+)(\s+)(\d+)/($1 . bgplink($2, "neighbors+$lastip+advertised-routes") . $3 . bgplink($4, "neighbors+$lastip+routes"))/e; s/(\s+)(Received)( prefixes:\s+[1-9]\d*)/($1 . bgplink($2, "neighbors+$lastip+routes") . $3)/e; s/^( Saved \(soft-reconfig\):\s+)(\d+|n\/a)(\s+)(\d+)/($1 . $2 . $3 . bgplink($4, "neighbors+$lastip+received-routes"))/e; s/( [1-9]\d* )(accepted)( prefixes)/($1 . bgplink($2, "neighbors+$lastip+routes") . $3)/e; s/^( [1-9]\d* )(accepted|denied but saved)( prefixes consume \d+ bytes)/($1 . bgplink($2, "neighbors+$lastip+received-routes") . $3)/e; s/^(BGP neighbor is )(\d+\.\d+\.\d+\.\d+)(,)/($1 . pinglink($2) . $3)/e; s/^( Description: )(.*)$/$1<B>$2<\/B>/; s/(,\s+remote AS )(\d+)(,)/($1 . as2link($2) . $3)/e; s/(, local AS )(\d+)(,)/($1 . as2link($2) . $3)/e; s/( update prefix filter list is )(\S+)/($1 . bgplink($2, "prefix-list+$2"))/e; s/(Route map for \S+ advertisements is\s+)(\S+)/($1 . bgplink($2, "route-map+$2"))/e; } elsif ($command =~ /^show bgp ipv6 n\w*\s+([\dA-Fa-f:]+)/i) { my $ip = $1; if ($securemode) { s/((Local|Foreign) port: )\d+/${1}???/g; } s/(Prefix )(advertised)( [1-9]\d*)/($1 . bgplink($2, "neighbors+$ip+advertised-routes") . $3)/e; s/^( [1-9]\d* )(accepted)( prefixes)/($1 . bgplink($2, "neighbors+$ip+routes") . $3)/e; s/^( Description: )(.*)$/$1<B>$2<\/B>/; s/(\s+remote AS )(\d+)(,)/($1 . as2link($2) . $3)/e; s/(\s+local AS )(\d+)(,)/($1 . as2link($2) . $3)/e; s/( update prefix filter list is )(\S+)/($1 . bgplink($2, "prefix-list+$2"))/e; s/(Route map for \S+ advertisements is\s+)(\S+)/($1 . bgplink($2, "route-map+$2"))/e; } elsif ($command =~ /^show bgp n\w*\s+([\d\.A-Fa-f:]+)/i) { my $ip = $1; if ($securemode) { if ($hidden) { $hidden = 0 unless (/^ /); next if ($hidden); } s/^(Peer:\s+[\d\.A-Fa-f:]+\+)\d+(\s+AS\s+\d+\s+Local:\s+[\d\.A-Fa-f:]+\+)\d+(\s+AS\s+\d+)/${1}???${2}???${3}/g; if (/^ Table (.*\.l[23]vpn|inet6?\.2|\S+\.inet6?\.0)/) { s/^( Table) \S+/$1 (hidden)/g; $hidden = 1; } } s/(\s+AS )(\d+)/($1 . as2link($2))/eg; s/(\s+AS: )(\d+)/($1 . as2link($2))/eg; s/^( Active prefixes:\s+)(\d+)/($1 . bgplink($2, "neighbors+$ip+routes"))/e; s/^( Received prefixes:\s+)(\d+)/($1 . bgplink($2, "neighbors+$ip+routes+all"))/e; s/^( Suppressed due to damping:\s+)(\d+)/($1 . bgplink($2, "neighbors+$ip+routes+damping+suppressed"))/e; s/^( Advertised prefixes:\s+)(\d+)/($1 . bgplink($2, "neighbors+$ip+advertised-routes"))/e; s/^( )(Export)(: )/($1 . bgplink($2, "neighbors+$ip+advertised-routes") . $3)/e; s/^( )(Import)(: )/($1 . bgplink($2, "neighbors+$ip+routes+all") . $3)/e; # JUNOS bugfix s/([^ ])( )(Import)(: )/($1 . "\n " . $2 . bgplink($3, "neighbors+$ip+routes+all") . $4)/e; } elsif ($command =~ /^show route protocol bgp .* terse/i) { s/^(.{20} B .{25} (?:>| ).{15}[^ ]*)( [\d\s,\{\}]+)(.*)$/($1 . as2link($2, $regexp) . $3)/e; s/^([\* ] )([\d\.A-Fa-f:\/]+)(\s+)/($1 . bgplink($2, "$2+exact") . $3)/e; } elsif (($command =~ /^show route protocol bgp /i) || ($command =~ /^show route aspath-regex /i)) { if ($securemode) { s/(Task: BGP_[\d\.A-Fa-f:]+\+)\d+/${1}???/g; } if (/^ (.)BGP /) { if ($1 eq "*") { $best = "\#FF0000"; } else { $best = ""; } } elsif (/^[\d\.A-Fa-f:\/\s]{19}([\*\+\- ])\[BGP\//) { if ($1 =~ /[\*\+]/) { $best = "\#FF0000"; } elsif ($1 eq "-") { $best = "\#008800"; } else { $best = ""; } } elsif (/^$/) { $best = ""; } s/( from )([0-9A-Fa-f][0-9\.A-Fa-f:]+)/($1 . bgplink($2, "neighbors+$2"))/e; s/( Source: )([0-9\.A-Fa-f:]+)/($1 . bgplink($2, "neighbors+$2"))/e; s/(\s+AS: )([\d ]+)/($1 . as2link($2))/eg; s/(Community: )([\d: ]+)/($1 . community2link($2))/e; s/(Communities: )([\d: ]+)/($1 . community2link($2))/e; s/(^\s+AS path: )(Merged\[3\]: )?([\d ]+)/($1 . $2 . as2link($3))/e; s/^([\dA-Fa-f:]+[\d\.A-Fa-f:\/]+)(\s*)/("<B>" . bgplink($1, "$1+exact") . "<\/B>$2")/e; $_ = "<FONT COLOR=\"${best}\">$_</FONT>" if ($best ne ""); } elsif ($command =~ /bgp/) { s|^(BGP routing table entry for) (\S+)|$1 <B>$2</B>|; s|^(Paths:\ .*)\ best\ \#(\d+) |$1\ <FONT\ COLOR="\#FF0000">best\ \#$2</FONT>|x && do { $best = $2; }; # Fix for IPv6 route output where there are no addional 3 spaces before addresses if ((/^ Advertised to non peer-group peers:$/) && ($command =~ / ipv6 /)) { $count--; } if ((/^ (\d+.*)/ && ! /^ \d+\./) || (/^ Local/)) { $count++; $_ = as2link($_); } $_ = "<FONT COLOR=\"\#FF0000\">$_</FONT>" if $best && $best == $count; s/( from )([0-9A-Fa-f][0-9\.A-Fa-f:]+)( )/($1 . bgplink($2, "neighbors+$2") . $3)/e; s/(Community: )([\d: ]+)/($1 . community2link($2))/e; s/(Communities: )([\d: ]+)/($1 . community2link($2))/e; s/(^\s+AS path: )([\d ]+)/($1 . as2link($2))/e; if ($command =~ /-protocol/) { s/^([ \*] )([\d\.A-Fa-f:\/]+)(\s+)/($1 . bgplink($2, "$2+exact") . $3)/e; } } print "$_\n"; } ######## Portion of code is borrowed from NCSA WebMonitor "mail" code sub cgi_decode { my ($incoming) = @_; my %FORM; my $ref = "FORM"; my @pairs = split(/&/, $incoming); foreach (@pairs) { my ($name, $value) = split(/=/, $_); $name =~ tr/+/ /; $value =~ tr/+/ /; $name =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie; $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie; $FORM{$name} .= $value; } return (%FORM); } sub read_as_list { my ($fn) = @_; local *F; my %AS; if (! open(F, $fn)) { print "<!-- Can't read AS list from $fn: $! -->\n"; return; } while (<F>) { chop; if (/^#include\s+(.+)$/) { my %AS2 = &read_as_list($1); foreach my $key (keys (%AS2)) { $AS{$key} = $AS2{$key}; } undef %AS2; next; } next if (/^$/ || /^\s*#/); my ($asnum, $descr) = split /\t+/; $asnum =~ s/^[^\d]*(\d+)[^\d]*$/$1/; $AS{$asnum} = $descr; } close(F); return (%AS); } sub as2link { my ($line, $regexp) = @_; my $prefix; my $suffix; if ($line =~ /^([^\d]*)((\d)|(\d[\d\s\[\]\{\}]*\d))([^\d]*)$/) { $prefix = $1; $line = $4; $suffix = $5; } return($prefix . $line . $suffix) if ($line =~ /^\s*$/); if ($line =~ /:/) { return($prefix . $line . $suffix); } my @aslist = split(/[^\d]+/, $line); my @separators = split(/[\d]+/, $line); my @regexplist = split(/[_^$ ]+/, $regexp); $line = ""; for (my $i = 0; $i <= $#aslist; $i++) { my $as = $aslist[$i]; my $sep = ""; $sep = $separators[$i + 1] if ($i <= $#separators); my $astxt = $as; for (my $j = 0; $j <= $#regexplist; $j++) { if ($regexplist[$j] eq $as) { $astxt = "<EM>$as</EM>"; last; } } my $rep; if (! defined $AS{$as}) { $rep = $astxt; } else { my $link = ""; if ($AS{$as} =~ /(\w+):/) { if (defined $whois{$1}) { $link = sprintf(" HREF=\"$whois{$1}\" TARGET=_lookup", $as); } elsif (defined $whois{default}) { $link = sprintf(" HREF=\"$whois{default}\" TARGET=_lookup", $as); } } my $descr = $AS{$as}; $descr = "$2 ($1)" if ($descr =~ /^([^:]+):(.*)$/); $rep = "<A title=\"" . html_encode($descr) . "\"${link}>$astxt</A>"; } $line .= $rep . $sep; } $suffix =~ s/(aggregated by )(\d+)( )/($1 . as2link($2) . $3)/e; return($prefix . $line . $suffix); } sub community2link { my ($line) = @_; my $prefix; my $suffix; my @communitylist = split(/[^\d:]+/, $line); my @separators = split(/[\d:]+/, $line); $line = ""; for (my $i = 0; $i <= $#communitylist; $i++) { my $community = $communitylist[$i]; my $sep = ""; $sep = $separators[$i + 1] if ($i <= $#separators); my $rep; if (! defined $AS{$community}) { $rep = $community; } else { my $link = ""; my $descr = $AS{$community}; my $asnum = $1 if ($community =~ /^(\d+):/); if (defined $AS{$asnum . ":URL"}) { $rep = "<A HREF=\"" . $AS{$asnum . ":URL"} . "\" TARGET=_lookup>$community</A> (" . html_encode($descr) . ")"; } else { $rep = html_encode("$community ($descr)"); } } $line .= $rep . $sep; } return($line); } sub bgplink { my ($txt, $cmd) = @_; my $link = $lgurl; my $router = $FORM{router}; $router =~ s/\+/%2B/; $router =~ s/=/%3D/; $router =~ s/\&/%26/g; $link .= "?query=bgp"; $link .= "&protocol=" . $FORM{protocol}; $link .= "&addr=$cmd"; $link .= "&router=$router"; $link =~ s/ /+/g; return("<A HREF=\"$link\">$txt</A>"); } sub pinglink { my ($ip) = @_; my $link = $lgurl; my $router = $FORM{router}; $router =~ s/\+/%2B/; $router =~ s/=/%3D/; $router =~ s/\&/%26/g; $link .= "?query=ping"; $link .= "&protocol=" . $FORM{protocol}; $link .= "&addr=$ip"; $link .= "&router=$router"; $link =~ s/ /+/g; return("<A HREF=\"$link\"><B>$ip</B></A>"); } sub html_encode { ($_) = @_; s|[\r\n]||g; s|&|&|g; s|<|<|g; s|>|>|g; return $_; }