--- /dev/null
+#!/usr/bin/perl\r
+##\r
+## fetch_stat.pl\r
+##\r
+## Fetches and summarizes stats from Dell PowerConnect 27xx\r
+## Written by Joakim Andersson, joakim at iqcc dot se\r
+##\r
+## 1) Install the Perl-modules you might be missing\r
+## 2) Adjust the settings in the settings-file\r
+## 3) Run the script\r
+##\r
+## Arguments: \r
+## clear_stats - Clear the portstats when script starts\r
+## clear_session - Forces a cached session to be ignored, useful for testing only \r
+## clear_wraps - Forgets about previous counter-wraps\r
+## settings=file - Read settings from this file\r
+##\r
+## For changelog please visit http://www.iqcc.se\r
+##\r
+\r
+my $ver = '1.42 (2007-04-19)';\r
+\r
+use 5.004;\r
+use strict;\r
+use Digest::MD5 qw(md5_hex);\r
+use LWP::UserAgent;\r
+use Net::HTTP;\r
+use Time::HiRes;\r
+\r
+####################################################\r
+##\r
+## File containing settings\r
+##\r
+\r
+my $SETTINGS_FILE = 'settings.txt';\r
+\r
+##################################################\r
+\r
+my @do_delta = qw(goodOctetRCV rxGood goodOctetSND txGood rx64Octets rx65TO127Octets rx128TO255Octets rx256TO511Octets rx512TO1023Octets rx1024ToMa );\r
+\r
+my $TR_COLOR = '#FFFF80';\r
+my %graph_names = ('bps' => 'bits per second', 'pps' => 'packets per second');\r
+my %graph_rev_type = ('bps' => 'pps', 'pps' => 'bps');\r
+\r
+my $cookie = '';\r
+\r
+my %SET = ( 'VERBOSE' => 3 ); # Settings\r
+my %STATS = (); # To maintain delta-stats \r
+my %OLD_STATS = (); # To cache previous values\r
+my %PORTS = (); # To maintain non-statistics info about each port\r
+my %WRAPS = (); # To maintain counter-wraps\r
+my %system = (); # System-info\r
+my @GRAPHS = (); # Graphs to create\r
+my @do_ports = ();\r
+\r
+# Setting time\r
+my %time = ();\r
+&upd_time();\r
+\r
+# Looking for valid args\r
+my $clear_session = 0;\r
+my $clear_stat = 0;\r
+my $clear_wraps = 0;\r
+\r
+foreach (@ARGV)\r
+{\r
+ ($_, my $value) = split(/=/);\r
+ \r
+ if (/^clear_stats?$/)\r
+ {\r
+ $clear_stat = 1;\r
+ }\r
+ elsif (/^clear_sessions?$/)\r
+ {\r
+ $clear_session = 1;\r
+ }\r
+ elsif (/^clear_wraps?$/)\r
+ {\r
+ $clear_wraps = 1;\r
+ }\r
+ elsif (/^settings$/ && $value)\r
+ {\r
+ $SETTINGS_FILE = $value;\r
+ }\r
+}\r
+\r
+my $numberOfPorts = 0;\r
+my $numberOfTrunks = 0;\r
+\r
+# Reading settings\r
+# Will be refreshed when changed later\r
+if (&refresh_settings() == 2)\r
+{\r
+ ##\r
+ ## Errors in the settings!\r
+ ##\r
+ \r
+ die "Errors exists in '$SETTINGS_FILE', unable to start fetch_stat.pl $ver!";\r
+}\r
+\r
+# Settings was OK\r
+&log("fetch_stat.pl $ver started at $time{'date_time'}", $SET{'VERBOSE'});\r
+\r
+# Creating UserAgent-object\r
+my $ua = LWP::UserAgent->new();\r
+$ua->agent("Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)");\r
+\r
+# Reads cached cookie, if wanted\r
+if ($SET{'COOKIE_FILE'})\r
+{\r
+ open (COOKIE, $SET{'COOKIE_FILE'}) || warn "Unable to open cookie-file $SET{'COOKIE_FILE'}, first run ever?\n";\r
+ $cookie = <COOKIE>;\r
+ close COOKIE;\r
+}\r
+\r
+if ($clear_session && $cookie)\r
+{\r
+ $cookie = '';\r
+ print "Cleared old session-cookie\n" if ($SET{'VERBOSE'});\r
+}\r
+elsif ($cookie)\r
+{\r
+ $cookie =~ tr/\n\r\t//d;\r
+ print "Trying to reuse old session-cookie '$cookie'\n" if ($SET{'VERBOSE'});\r
+ \r
+ # Fetches system info\r
+ # Will reset $cookie if failure\r
+ print "Polling link- and system info...\n" if ($SET{'VERBOSE'} >= 2);\r
+ &get_system_info;\r
+}\r
+\r
+##\r
+## If we don't have a valid session login and fetch system info again\r
+##\r
+\r
+unless ($cookie)\r
+{\r
+ &login;\r
+ print "Polling link- and system info...\n" if ($SET{'VERBOSE'} >= 2);\r
+ &get_system_info;\r
+}\r
+\r
+\r
+##\r
+## Reading or clearing wraps\r
+##\r
+\r
+if ($SET{'WRAPS_FILE'})\r
+{\r
+ if ($clear_wraps || $clear_stat)\r
+ {\r
+ ##\r
+ ## Removes cached wraps\r
+ ##\r
+ \r
+ if (-e $SET{'WRAPS_FILE'})\r
+ {\r
+ &log("Clearing cached wraps", $SET{'VERBOSE'});\r
+ unlink $SET{'WRAPS_FILE'};\r
+ }\r
+ }\r
+ else\r
+ {\r
+ ##\r
+ ## Reads cached wraps\r
+ ##\r
+ \r
+ open (WRAPS, $SET{'WRAPS_FILE'});\r
+ while (<WRAPS>)\r
+ {\r
+ my ($name, $value) = split(/\t/, $_, 2);\r
+ chop $value;\r
+ \r
+ $WRAPS{$name} = $value;\r
+ #print "$name = $value\n";\r
+ }\r
+ close WRAPS;\r
+ }\r
+}\r
+\r
+##\r
+## Loops forever, hopefully\r
+##\r
+\r
+my $loop = 0;\r
+my $runtime = 'n/a';\r
+my $maxlen_portname = 10;\r
+my $autoadded_ports = 0;\r
+\r
+my %do_ports = {};\r
+#my @do_ports = ();\r
+\r
+print "\n" if ($SET{'VERBOSE'}); #Init complete\n\r
+$| = 1;\r
+\r
+while ( $loop == 0)\r
+{\r
+ $loop++;\r
+ ##\r
+ ## Refreshes settings if needed\r
+ ##\r
+ \r
+ my $settings_changed = &refresh_settings();\r
+ \r
+ if ($settings_changed == 2)\r
+ {\r
+ ##\r
+ ## Errors!\r
+ ##\r
+ \r
+ &log("Errors found in the settings, keeping the old settings!", $SET{'VERBOSE'});\r
+ #sleep $SET{'REFRESH_RATE'};\r
+ #next;\r
+ $settings_changed = 0;\r
+ }\r
+ elsif ($settings_changed || ($loop == 1) || $autoadded_ports)\r
+ {\r
+ ##\r
+ ## New settings read, or first loop\r
+ ## Also if ports has been auto-added\r
+ ##\r
+ \r
+ %do_ports = %{$SET{'PORTS'}}; # Ports on the switch\r
+\r
+ ##\r
+ ## Finds longest portname + clears stats if wanted\r
+ ##\r
+ \r
+ $maxlen_portname = 10;\r
+ foreach my $portnum (@do_ports)\r
+ {\r
+ my $this_len = length($do_ports{$portnum});\r
+ $maxlen_portname = $this_len if ($maxlen_portname < $this_len);\r
+ \r
+ ##\r
+ ## Clears stats of these ports if program was called with arg clear_stat\r
+ ##\r
+ \r
+ if ($clear_stat)\r
+ {\r
+ print "Clearing stats for port $portnum...\n" if ($SET{'VERBOSE'});\r
+ &clear_stat($portnum);\r
+ }\r
+ }\r
+\r
+ if ($clear_stat)\r
+ {\r
+ exit;\r
+ }\r
+\r
+ $autoadded_ports = 0;\r
+ }\r
+ \r
+ ##\r
+ ## Login if we miss a valid session\r
+ ##\r
+ \r
+ &login unless ($cookie);\r
+ \r
+ # Remembers the time when this loop started\r
+ my $start_time = [ Time::HiRes::gettimeofday() ];\r
+ \r
+ # Updates time\r
+ &upd_time();\r
+ \r
+ ##\r
+ ## Polling every defined port\r
+ ##\r
+ \r
+ my $wraps_occured = 0;\r
+ print "Polling stats ($time{'time'})...\n" if ($SET{'VERBOSE'} >= 2);\r
+ \r
+ foreach my $portnum (@do_ports)\r
+ {\r
+ ##\r
+ ## Initiates the hashes\r
+ ##\r
+ \r
+ my $STAT = { 'time' => [ Time::HiRes::gettimeofday() ] };\r
+ my $OLD_STAT = $STATS{$portnum};\r
+ my $PORT = $PORTS{$portnum} ||= {};\r
+ \r
+ if ($SET{'VERBOSE'} >= 2)\r
+ {\r
+ # Builds the info\r
+ my $name = "$portnum:";\r
+ print $name, ' ' x (6 - length($name));\r
+ \r
+ $name = $do_ports{$portnum}; #"$do_ports{$portnum}...";\r
+ print $name, ' ' x ($maxlen_portname - length($name) + 2);\r
+ }\r
+ \r
+ ##\r
+ ## Is it a switchport or a local interface?\r
+ ##\r
+ \r
+ if ($portnum =~ /^T?\d+$/)\r
+ {\r
+ ##\r
+ ## Polls this port on the switch\r
+ ##\r
+ \r
+ my $arg = ($portnum =~ /^T(\d+)$/) ? "TrunkNo=$1" : "PortNo=$portnum";\r
+ \r
+ # Fetches the page\r
+ my $res = $ua->get("http://$SET{'SWITCH'}/portStats.htm?$arg",\r
+ 'Cookie' => $cookie\r
+ );\r
+ \r
+ &log_n_die("Unable to fetch /portStats.htm?$arg - ".$res->status_line) unless ($res->is_success);\r
+ \r
+ # Parsing content\r
+ my $data = $res->content;\r
+ $data =~ tr/\r//d;\r
+ \r
+ if ($data =~ /^<title>Login<\/title>$/m)\r
+ {\r
+ ##\r
+ ## Invalid session!\r
+ ##\r
+ \r
+ &log("Session invalid", $SET{'VERBOSE'});\r
+ \r
+ $cookie = '';\r
+ last;\r
+ }\r
+ \r
+ ##\r
+ ## Parses the data, is stored in javascript-variables in the beginning of the page\r
+ ##\r
+ \r
+ my $row = 0;\r
+ my $wraps = 0;\r
+ my @wraps = ();\r
+ \r
+ foreach (split(/\n+/, $data))\r
+ {\r
+ $row++;\r
+ #print "RAD $row: $_\n";\r
+ \r
+ last if (/^<\/script>$/); # May need adjustment for future firmwares\r
+ next unless (/^var (.+)="(\d*)";$/);\r
+ \r
+ my $name = $1;\r
+ next if ($STAT->{$name}); # Skips already found variables, a bug in the current firmware\r
+ \r
+ my $value = reverse $2; # Values are stored reversed in the HTML-page\r
+ $value += 0; # Perhaps unneeded, but zero is better that nothing\r
+ \r
+ # To determine wraps we need the current value\r
+ # Ugly as hell\r
+ $STAT->{"curr:$name"} = $value;\r
+ \r
+ ##\r
+ ## Adding previous wraps of this counter\r
+ ##\r
+ \r
+ if ($WRAPS{"$portnum:$name"})\r
+ {\r
+ $value += 4294967296 * $WRAPS{"$portnum:$name"};\r
+ }\r
+ \r
+ ##\r
+ ## Looking for wrapped counters\r
+ ## 32bit counters is not enough\r
+ ## \r
+ \r
+ if ($OLD_STAT && $value < $OLD_STAT->{$name})\r
+ {\r
+ ##\r
+ ## We guess this is a wrap\r
+ ## With 32bit counters 4294967296 is the max value\r
+ ## Resets of the statistics may cause problems here\r
+ ##\r
+ \r
+ if ($wraps < 2)\r
+ {\r
+ ##\r
+ ## Max two wraps per poll is considered valid\r
+ ##\r
+ \r
+ my $tmp = ++$WRAPS{"$portnum:$name"};\r
+ my $new = $STAT->{"curr:$name"};\r
+ my $old = $OLD_STAT->{"curr:$name"};\r
+ \r
+ &log("$do_ports{$portnum} (port $portnum): Probable wrap of $name has occured. $old -> $new. (tot $OLD_STAT->{$name} -> $value, wraps $tmp)", $SET{'VERBOSE'} >= 3);\r
+ \r
+ $value += 4294967296;\r
+ \r
+ $wraps++;\r
+ $wraps_occured++;\r
+ push (@wraps, $name);\r
+ }\r
+ else\r
+ {\r
+ ##\r
+ ## Hmmm, this is probably *not* a wrap\r
+ ## Resetting the wrap-counter and old stats\r
+ ##\r
+ \r
+ &log("$do_ports{$portnum} (port $portnum): Wasn't wraps, most likely a reset of the stats instead. Resetting our old stats and wraps", $SET{'VERBOSE'} >= 3);\r
+ \r
+ undef $OLD_STAT;\r
+ delete $OLD_STATS{$portnum};\r
+ \r
+ # Reverting previous wraps\r
+ foreach (@wraps)\r
+ {\r
+ $STAT->{$_} = $STAT->{"curr:$_"};\r
+ }\r
+ @wraps = ();\r
+ \r
+ # Cleaning wraps for this port\r
+ foreach (keys %WRAPS)\r
+ {\r
+ next unless (/^$portnum:/);\r
+ #print "Deleted $_: $WRAPS{$_}\n";\r
+ delete $WRAPS{$_};\r
+ }\r
+ }\r
+ }\r
+ \r
+ # Memorizing this counter\r
+ $STAT->{$name} = $value;\r
+ }\r
+ \r
+ unless ($STAT->{'portIndex'} || $STAT->{'portTrunkIndex'})\r
+ {\r
+ ##\r
+ ## Hmmmmm, didn't find any of those expected variables\r
+ ##\r
+ \r
+ if ($portnum =~ /^T(\d+)$/ && ($numberOfTrunks < $1))\r
+ {\r
+ # Port out of bounds\r
+ &log_n_die("Unable to poll trunk $1 ($portnum), because max supported by switch is $numberOfTrunks");\r
+ }\r
+ elsif ($portnum =~ /^(\d+)$/ && ($numberOfPorts < $1))\r
+ {\r
+ # Trunk out of bounds\r
+ &log_n_die("Unable to poll port $1, because max supported by switch is $numberOfPorts");\r
+ }\r
+ \r
+ # Should always recieve portIndex, just a failsafe\r
+ &log("Bug? Unable to poll port $portnum, unknown cause", $SET{'VERBOSE'});\r
+ print $data;\r
+ exit;\r
+ }\r
+ }\r
+ elsif ($portnum =~ /^C\d+$/)\r
+ {\r
+ ##\r
+ ## This was a local iptables' chain\r
+ ## Variables are added to $STAT if successful\r
+ ##\r
+ \r
+ my $def = ${$SET{'CHAINS'}}{$portnum};\r
+ unless (&poll_chain($def, $STAT))\r
+ {\r
+ ##\r
+ ## The poll failed\r
+ ##\r
+ \r
+ &log("Poll of chain $portnum definition '$def' failed!");\r
+ next;\r
+ }\r
+ }\r
+ else\r
+ {\r
+ ##\r
+ ## This was assumes to be a local interface\r
+ ## Variables are added to $STAT if successful\r
+ ##\r
+ \r
+ unless (&poll_interface($portnum, $STAT))\r
+ {\r
+ ##\r
+ ## The poll failed\r
+ ##\r
+ \r
+ &log("Poll of local interface '$portnum' failed!");\r
+ next;\r
+ }\r
+ }\r
+ \r
+ ##\r
+ ## Do we have old info, so we can compute delta-values?\r
+ ##\r
+ \r
+ if (defined $OLD_STAT)\r
+ {\r
+ ##\r
+ ## Computing delta values of some variables\r
+ ##\r
+ \r
+ # Elapsed time since last run\r
+ $STAT->{'delta_time'} = Time::HiRes::tv_interval($OLD_STAT->{'time'}, $STAT->{'time'});\r
+ \r
+ if ($STAT->{'delta_time'} > 0)\r
+ {\r
+ ##\r
+ ## Calcs delta for some variables\r
+ ##\r
+ \r
+ foreach (@do_delta)\r
+ {\r
+ my $diff = $STAT->{$_} - $OLD_STAT->{$_};\r
+ $STAT->{"delta_$_"} = $diff / $STAT->{'delta_time'};\r
+ \r
+ if ($diff < 0)\r
+ {\r
+ ##\r
+ ## Should never get a negative value!\r
+ ##\r
+ \r
+ &log("Negative delta! Port $portnum, variable $_: now '$STAT->{$_}', prev '$OLD_STAT->{$_}' = diff '$diff'", $SET{'VERBOSE'});\r
+ }\r
+ }\r
+ \r
+ ##\r
+ ## Calcs errors/sec per in/out\r
+ ##\r
+ \r
+ # error-pps in\r
+ my $value = 0;\r
+ $value += ($STAT->{$_} - $OLD_STAT->{$_}) foreach (qw(rxFCS rxUnderSize rxOverSize rxFragment rxJabber));\r
+ $STAT->{'err_in_pps'} = $value / $STAT->{'delta_time'};\r
+ \r
+ # error-pps out\r
+ $value = 0;\r
+ $value += ($STAT->{$_} - $OLD_STAT->{$_}) foreach (qw(txDrop txCollisions));\r
+ $STAT->{'err_out_pps'} = $value / $STAT->{'delta_time'};\r
+ \r
+ ##\r
+ ## Show stats in the shell?\r
+ ##\r
+ \r
+ if ($SET{'VERBOSE'} >= 2)\r
+ {\r
+ my @values = ();\r
+ \r
+ foreach (qw(goodOctetRCV rxGood goodOctetSND txGood))\r
+ {\r
+ my $value = $STAT->{"delta_$_"};\r
+ \r
+ if ($PORT->{'has_link'} || $value > 0)\r
+ {\r
+ if (/Octet/)\r
+ {\r
+ # Bytes -> bits\r
+ $value = &shorten_num($value*8,undef,1024) . 'bps';\r
+ }\r
+ else\r
+ {\r
+ # Packets\r
+ $value = &shorten_num($value,undef,1000) . 'pps';\r
+ }\r
+ }\r
+ else\r
+ {\r
+ $value = '-';\r
+ }\r
+ push (@values, $value);\r
+ }\r
+ \r
+ print "out:", ' ' x (8 - length($values[0])), $values[0];\r
+ print " / ", ' ' x (8 - length($values[1])), $values[1];\r
+ \r
+ print " in:", ' ' x (8 - length($values[2])), $values[2];\r
+ print " / ", ' ' x (8 - length($values[3])), $values[3];\r
+ \r
+ my $tot_err_pps = $STAT->{'err_in_pps'}+$STAT->{'err_out_pps'};\r
+ if ($tot_err_pps > 0)\r
+ {\r
+ $tot_err_pps = &shorten_num($tot_err_pps,undef,1000) . 'pps';\r
+ }\r
+ else\r
+ {\r
+ $tot_err_pps = '-';\r
+ }\r
+ print " err:", ' ' x (8 - length($tot_err_pps)), $tot_err_pps;\r
+ \r
+ my $show = &shorten_num($STAT->{'delta_time'}, 6);\r
+ print " delta: ${show}s";\r
+ }\r
+ }\r
+ \r
+ ##\r
+ ## Shall we write to RRD-file\r
+ ##\r
+ \r
+ if ($SET{'RRD_FILE_PREFIX'} && !$SET{"RRD_SKIP_PORT_$portnum"})\r
+ {\r
+ ##\r
+ ## Yep, we shall save RRD data for this port\r
+ ##\r
+ \r
+ my $filename = $SET{'RRD_FILE_PREFIX'} . "_$portnum.rrd";\r
+ my $status = 1;\r
+ \r
+ unless (-e $filename)\r
+ {\r
+ # Doesn't exist, create it\r
+ ($status, my $message) = &create_rrd($filename);\r
+ &log("Port $portnum: $message", $SET{'VERBOSE'} >= 4);\r
+ \r
+ if ($status == 0)\r
+ {\r
+ # Will not try create RRD for this port again\r
+ $SET{"RRD_SKIP_PORT_$portnum"} = 1;\r
+ &log("Create failed, disabling RRD for port $portnum", 1);\r
+ }\r
+ }\r
+ \r
+ if ($status == 1)\r
+ {\r
+ ##\r
+ ## No errors found, writing\r
+ ##\r
+ ## Order of data:\r
+ ## kbps out and in\r
+ ## pps out and in\r
+ ## error-pps out and in\r
+ ##\r
+ \r
+ my @values = ();\r
+ \r
+ foreach (qw(delta_goodOctetSND delta_goodOctetRCV\r
+ delta_txGood delta_rxGood\r
+ err_out_pps err_in_pps\r
+ ))\r
+ {\r
+ my $value = $STAT->{$_};\r
+ $value *= 8/1024 if (/Octet/); # Octets -> kbit\r
+ $value =~ s/(\.\d\d)\d+$/$1/;\r
+ push(@values, $value);\r
+ }\r
+ \r
+ # Uses the timestamp from our previous Time::HiRes gettimeofday\r
+ # HOWEVER if we're syncing to RRD and we're in sync the loop-start-time is used\r
+ my $timestamp = ${$STAT->{'time'}}[0];\r
+ $timestamp = $time{'unixtime'} if ($SET{'rrd_in_sync'});\r
+ \r
+ #print "\n$timestamp - ", scalar localtime( $timestamp ), "\n";\r
+ \r
+ my $string = join(':', $timestamp, @values);\r
+ \r
+ ##\r
+ ## Updates the RRD\r
+ ##\r
+ \r
+ RRDs::update($filename, $string);\r
+ \r
+ my $error = &RRDs::error;\r
+ &log("Unable to update RRD '$filename' with '$string'!: $error", $SET{'VERBOSE'} >= 1) if ($error);\r
+ }\r
+ }\r
+ \r
+ ##\r
+ ## Is this port considered active?\r
+ ## Used when we hide inactive ports in the HTML\r
+ ##\r
+ \r
+ $PORT->{'is_active'} = $PORT->{'has_link'};\r
+ if (!$PORT->{'is_active'} && ($STAT->{'delta_txGood'} || $STAT->{'delta_rxGood'}))\r
+ {\r
+ ##\r
+ ## According to last polling of linkinfo the port is down, but\r
+ ## the count of packets travelling the port has increased since\r
+ ## last loop, so we assume it's gone up\r
+ ##\r
+ \r
+ $PORT->{'is_active'} = 1;\r
+ $STAT->{'link_changed'} = 1;\r
+ }\r
+ }\r
+ \r
+ # Memorizes the previous stat for this port\r
+ $OLD_STATS{$portnum} = $STATS{$portnum} if ($STATS{$portnum});\r
+ $STATS{$portnum} = $STAT;\r
+ \r
+ print "\n" if ($SET{'VERBOSE'} >= 2);\r
+ }\r
+ \r
+ ##\r
+ ## Writes cached wraps\r
+ ##\r
+ \r
+ if ($wraps_occured > 0 && $SET{'WRAPS_FILE'})\r
+ {\r
+ #&log("Saving wraps-cache", $SET{'VERBOSE'} >= 2);\r
+ \r
+ open (WRAPS, ">$SET{'WRAPS_FILE'}") || &log("Failed to save wraps-cache to file '$SET{'WRAPS_FILE'}'!", $SET{'VERBOSE'});\r
+ foreach (sort keys %WRAPS)\r
+ {\r
+ print WRAPS "$_\t$WRAPS{$_}\n";\r
+ }\r
+ close WRAPS;\r
+ }\r
+ \r
+ # Ends loop here if we don't have a valid session\r
+ next unless ($cookie);\r
+ \r
+ ##\r
+ ## Checking and logging increased errors, but only if a logfile is defined\r
+ ##\r
+ \r
+ if ($SET{'LOG_FILE'})\r
+ {\r
+ foreach my $portnum (@do_ports)\r
+ {\r
+ my $STAT = $STATS{$portnum};\r
+ next unless ($STAT->{'delta_time'});\r
+ \r
+ my $OLD_STAT = $OLD_STATS{$portnum};\r
+ \r
+ foreach (qw(txDrop txCollisions rxFCS rxUnderSize rxOverSize rxFragment rxJabber))\r
+ {\r
+ my $diff = $STAT->{$_} - $OLD_STAT->{$_};\r
+ next unless ($diff > 0);\r
+\r
+ my $deltatime = &shorten_num($STAT->{'delta_time'}, 4); # Only stripping decimals\r
+ my $rate = &shorten_num($diff / $STAT->{'delta_time'}, 3, 1000);\r
+ \r
+ # Log and possibly print if verbose >= 3\r
+ &log("$do_ports{$portnum} (port $portnum): $_ has increased by $diff the last $deltatime secs (rate ${rate}pps)", $SET{'VERBOSE'} >= 3);\r
+ }\r
+ }\r
+ }\r
+ \r
+ ##\r
+ ## We doesn't fetches system and linkinfo every loop, since it takes a while\r
+ ##\r
+ \r
+ if ($settings_changed || ($loop % $SET{'POLL_LINKINFO_EVERY_NTH_LOOP'} == 0))\r
+ {\r
+ ##\r
+ ## Also fetches general system-info now\r
+ ##\r
+ \r
+ print "Polling link- and system info...\n" if ($SET{'VERBOSE'} >= 2);\r
+ &get_system_info;\r
+ }\r
+ else\r
+ {\r
+ # Won't fetch, so we assumes the switch has been up\r
+ # We assumes that the whole loop will take refresh_rate seconds \r
+ $system{'sysUpTime'} += $SET{'REFRESH_RATE'}*100;\r
+ &parse_sysuptime;\r
+ }\r
+ \r
+ # Ends loop here if we don't have a valid session\r
+ next unless ($cookie);\r
+ \r
+ ##\r
+ ## Generates graphs\r
+ ##\r
+ \r
+ if ($SET{'HTML_FILE'} && $SET{'GRAPH_BPS_EVERY_NTH_LOOP'} && (($loop+1) % $SET{'GRAPH_BPS_EVERY_NTH_LOOP'} == 0))\r
+ {\r
+ print "Graphing BPS...\n" if ($SET{'VERBOSE'} >= 2);\r
+ &generate_rrd_graphs('bps');\r
+ }\r
+ \r
+ if ($SET{'HTML_FILE'} && $SET{'GRAPH_PPS_EVERY_NTH_LOOP'} && (($loop+1) % $SET{'GRAPH_PPS_EVERY_NTH_LOOP'} == 0))\r
+ {\r
+ print "Graphing PPS...\n" if ($SET{'VERBOSE'} >= 2);\r
+ &generate_rrd_graphs('pps');\r
+ }\r
+ \r
+ ##\r
+ ## Generates web-page if wanted\r
+ ##\r
+ \r
+ if ($SET{'HTML_FILE'})\r
+ {\r
+ $runtime = Time::HiRes::tv_interval($start_time, [ Time::HiRes::gettimeofday() ]);\r
+ &generate_html;\r
+ }\r
+ \r
+ ##\r
+ ## Pauses\r
+ ##\r
+ \r
+ $runtime = Time::HiRes::tv_interval($start_time, [ Time::HiRes::gettimeofday() ]);\r
+ my $sleep = $SET{'REFRESH_RATE'} - $runtime;\r
+ \r
+ ##\r
+ ## RRD creates "sharper" graphs if data is polled near each RRD_STEP-interval\r
+ ## If wanted we try to 'slide' to stay near that interval\r
+ ##\r
+ \r
+ if ($SET{'RRD_FILE_PREFIX'} && $SET{'SYNC_SLEEP_TO_RRD'})\r
+ {\r
+ # If using the default RRD_STEP 30s, we get a value between 0 and +30\r
+ # 0 is the ideal point\r
+ # Negative means we need to sleep a bit shorter to get near 0\r
+ # Positive means we need to sleep a bit longer to get near 0\r
+ my $half_step = $SET{'RRD_STEP'} / 2;\r
+ my $diff = $half_step - ($time{'unixtime'}+$half_step) % $SET{'RRD_STEP'};\r
+ \r
+ if ($diff != 0)\r
+ {\r
+ ##\r
+ ## Need adjusting\r
+ ##\r
+ \r
+ # Max 5 seconds each loop\r
+ $diff = 5 if ($diff > 5);\r
+ $diff = -5 if ($diff < -5);\r
+ $sleep += $diff;\r
+ \r
+ $diff = '+'.$diff if ($diff > 0);\r
+ &log("Adjusting sleep with $diff secs to sync with RRD_STEP = $SET{'RRD_STEP'} secs", $SET{'VERBOSE'});\r
+ $SET{'rrd_in_sync'} = 0;\r
+ }\r
+ elsif ($SET{'rrd_in_sync'} != 1)\r
+ {\r
+ print "Sync with RRD_STEP = $SET{'RRD_STEP'} secs is OK\n" if ($SET{'VERBOSE'} >= 2);\r
+ $SET{'rrd_in_sync'} = 1;\r
+ }\r
+ }\r
+ \r
+ # Always sleeps atleast 2 secs!\r
+ $sleep = 2 if ($sleep < 1);\r
+ \r
+ print "\n" if ($SET{'VERBOSE'} > 1);\r
+# Time::HiRes::sleep($sleep);\r
+}\r
+\r
+exit;\r
+\r
+\r
+##\r
+## Create the HTML-page\r
+##\r
+\r
+sub generate_html\r
+{\r
+ #print "HTML refresh: $refresh\n";\r
+ \r
+ open (HTML, ">$SET{'HTML_FILE'}") || warn "Unable to write to html-file '$SET{'HTML_FILE'}'!";\r
+ print HTML <<END;\r
+<html>\r
+<head>\r
+<title>Statistics for $SET{'SWITCH'} - $system{'systemName'} $system{'locationName'}</title>\r
+<meta http-equiv="Refresh" content="$SET{'REFRESH_RATE'}">\r
+</head>\r
+\r
+<body bgcolor="White" text="Black" link="Black" vlink="Black">\r
+\r
+<center>\r
+<p>\r
+<table border="0" cellpadding="4" cellspacing="0" style="font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; font-size: 10;" width="980">\r
+\r
+<tr align=left valign=bottom>\r
+<th align=right rowspan=2 bgcolor="silver">#</th>\r
+<th rowspan=2 bgcolor="silver">Equipment</th>\r
+<th colspan=4 bgcolor="lime"><a title="When polling a local interface, it's traffic transmitted from it">OUT: Switch -> Equipment:</a></th>\r
+<th colspan=2 bgcolor="red">Errors</th>\r
+<td bgcolor="silver"></td>\r
+<th colspan=4 bgcolor="lime"><a title="When polling a local interface, it's traffic recieved by it">IN: Equipment -> Switch:</a></th>\r
+<th colspan=5 bgcolor="red">Errors</th>\r
+</tr>\r
+<tr align=left valign=bottom>\r
+<th bgcolor="lime" colspan=2><a title="goodOctetSND (bytes), txGood (packets)">TOT</a></th>\r
+<th bgcolor="lime"><a title="txBroadcast (packets)">Bcast</a></th>\r
+<th bgcolor="lime"><a title="txMulticast (packets)">Mcast</a></th>\r
+<th bgcolor="red"><a title="txDrop (packets)">Drop</a></th>\r
+<th bgcolor="red"><a title="txCollisions (packets)">Coll</a></th>\r
+<td bgcolor="silver"></td>\r
+\r
+<th bgcolor="lime" colspan=2><a title="goodOctetRCV (bytes), rxGood (packets)">TOT</a></th>\r
+<th bgcolor="lime"><a title="rxBroadcast (packets)">Bcast</a></th>\r
+<th bgcolor="lime"><a title="rxMulticast (packets)">Mcast</a></th>\r
+<th bgcolor="red"><a title="rxFCS (packets)">FCS</a></th>\r
+<th bgcolor="red"><a title="rxUnderSize (packets)">Usize</a></th>\r
+<th bgcolor="red"><a title="rxOverSize (packets)">Osize</a></th>\r
+<th bgcolor="red"><a title="rxFragment (packets)">Frag</a></th>\r
+<th bgcolor="red"><a title="rxJabber (packets)">Jabb</a></th>\r
+</tr>\r
+END\r
+ \r
+ foreach my $portnum (@do_ports)\r
+ {\r
+ ##\r
+ ## Each port\r
+ ##\r
+ \r
+ my $STAT = $STATS{$portnum};\r
+ my $OLD_STAT = $OLD_STATS{$portnum};\r
+ my $PORT = $PORTS{$portnum};\r
+ my $is_err = 0;\r
+ \r
+ # Hides ports that are not active\r
+ next if ($SET{'HIDE_INACTIVE_PORTS'} && !$PORT->{'is_active'} && !$SET{"ALWAYS_SHOW_PORT_$portnum"});\r
+ \r
+ ##\r
+ ## Shall we add a link and/or title?\r
+ ##\r
+ \r
+ my $portnum_link = '';\r
+ my $portnum_title = '';\r
+ \r
+ if ($PORT->{'rrd_bps_file'})\r
+ {\r
+ # Link to BPS-graph\r
+ $portnum_link = $PORT->{'rrd_bps_file'};\r
+ $portnum_title = "Click to view graphs";\r
+ }\r
+ elsif ($PORT->{'rrd_pps_file'})\r
+ {\r
+ # Link to PPS-graph\r
+ $portnum_link = $PORT->{'rrd_pps_file'};\r
+ $portnum_title = "Click to view graphs";\r
+ }\r
+ \r
+ if ($portnum =~ /^C\d+$/)\r
+ {\r
+ # Chain\r
+ my @def = split(/\s*,\s*/, ${$SET{'CHAINS'}}{$portnum});\r
+ \r
+ $portnum_title .= ", " if ($portnum_title);\r
+ $portnum_title .= "OUT = chain $def[0] row $def[1]";\r
+ $portnum_title .= ", IN = chain $def[2] row $def[3]" if ($def[2]);\r
+ }\r
+ \r
+ $portnum_link = "href=\"$portnum_link\"" if ($portnum_link);\r
+ $portnum_title = "title=\"$portnum_title\"" if ($portnum_title);\r
+ \r
+ ##\r
+ ## Writing\r
+ ##\r
+ \r
+ print HTML <<END;\r
+<tr align=right valign=top onmouseover="this.style.backgroundColor='$TR_COLOR'" onmouseout="this.style.backgroundColor=''">\r
+<th bgcolor="silver"><a $portnum_link $portnum_title>$portnum</a></th>\r
+<td align=left>$do_ports{$portnum}</td>\r
+END\r
+ \r
+ foreach (qw(\r
+goodOctetSND txGood txBroadcast txMulticast\r
+is_err txDrop txCollisions no_err\r
+space\r
+goodOctetRCV rxGood rxBroadcast rxMulticast\r
+is_err rxFCS rxUnderSize rxOverSize rxFragment rxJabber no_err\r
+ )) # txError rxError \r
+ {\r
+ ##\r
+ ## Visar värden\r
+ ##\r
+ \r
+ if ($_ eq 'space')\r
+ {\r
+ print HTML "<td></td>";\r
+ next;\r
+ }\r
+ elsif ($_ eq 'is_err')\r
+ {\r
+ $is_err = 1;\r
+ next;\r
+ }\r
+ elsif ($_ eq 'no_err')\r
+ {\r
+ $is_err = 0;\r
+ next;\r
+ }\r
+ \r
+ my $value = my $real_value = $STAT->{$_};\r
+ my $diff = $value - $OLD_STAT->{$_};\r
+ my $make_boldred = ($is_err && defined $OLD_STAT->{$_} && ($diff > 0));\r
+ $diff = ($make_boldred) ? " (+$diff)" : '';\r
+ \r
+\r
+ # Exact value for mouse-over\r
+ my $value_sep = &add_sep($real_value);\r
+ \r
+ # Writing da stuff\r
+ print HTML "<td><a title=\"$value_sep$diff\">$value</a></td>";\r
+ }\r
+ \r
+ print HTML "</tr>\n";\r
+ }\r
+ \r
+ print HTML <<END;\r
+</table>\r
+\r
+<br><br><br>\r
+<table border="0" cellpadding="4" cellspacing="0" style="font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; font-size: 10;" width=980>\r
+\r
+<tr align=left valign=bottom>\r
+<th align=right rowspan=2 bgcolor="silver">#</th>\r
+<th rowspan=2 bgcolor="silver">Equipment</th>\r
+<th bgcolor="lime"></th>\r
+<th bgcolor="silver" width=0></th>\r
+<th colspan=23 bgcolor="lime">IN: Equipment -> Switch: Amount of packets per framesize</th>\r
+</tr>\r
+<tr align=center valign=bottom>\r
+<th bgcolor="lime">Link</th>\r
+<th bgcolor="silver" width=0></th>\r
+<th bgcolor="lime" colspan=3><a title="rx64Octets (packets, percent, packets/s)">64 byte</a></th>\r
+<td bgcolor="silver" width=0></td>\r
+<th bgcolor="lime" colspan=3><a title="rx65TO127Octets (packets, percent, packets/s)">65-127 byte</a></th>\r
+<td bgcolor="silver" width=0></td>\r
+<th bgcolor="lime" colspan=3><a title="rx128TO255Octets (packets, percent, packets/s)">128-255 byte</a></th>\r
+<td bgcolor="silver" width=0></td>\r
+<th bgcolor="lime" colspan=3><a title="rx256TO511Octets (packets, percent, packets/s)">256-511 byte</a></th>\r
+<td bgcolor="silver" width=0></td>\r
+<th bgcolor="lime" colspan=3><a title="rx512TO1023Octets (packets, percent, packets/s)">512-1024 byte</a></th>\r
+<td bgcolor="silver" width=0></td>\r
+<th bgcolor="lime" colspan=3><a title="rx1024ToMa (packets, percent, packets/s)">1025- byte</a></th>\r
+</tr>\r
+END\r
+ \r
+ foreach my $portnum (@do_ports)\r
+ {\r
+ ##\r
+ ## Each port\r
+ ##\r
+ \r
+ next unless ($portnum =~ /^T?\d+$/); # No such info for local interfaces\r
+ \r
+ my $STAT = $STATS{$portnum};\r
+ my $OLD_STAT = $OLD_STATS{$portnum};\r
+ my $PORT = $PORTS{$portnum};\r
+ \r
+ # Hides ports that are not up, if wanted\r
+ next if ($SET{'HIDE_INACTIVE_PORTS'} && !$PORT->{'is_active'} && !$SET{"ALWAYS_SHOW_PORT_$portnum"});\r
+ \r
+ ##\r
+ ## Shall we add a link to graphs?\r
+ ##\r
+ \r
+ my $graph_link = '';\r
+ \r
+ if ($PORT->{'rrd_bps_file'})\r
+ {\r
+ # Link to BPS-graph\r
+ $graph_link = $PORT->{'rrd_bps_file'};\r
+ }\r
+ elsif ($PORT->{'rrd_pps_file'})\r
+ {\r
+ # Link to PPS-graph\r
+ $graph_link = $PORT->{'rrd_pps_file'};\r
+ }\r
+ \r
+ $graph_link = "href=\"$graph_link\" title=\"Click to view graphs\"" if ($graph_link);\r
+ \r
+ ##\r
+ ## Make linkinfo bold if it recently changed\r
+ ##\r
+ \r
+ my $link = $PORT->{'link'};\r
+ $link = 'up?' if ($link eq 'down' && $PORT->{'is_active'});\r
+ $link = "<b>$link</b>" if ($STAT->{'link_changed'});\r
+ \r
+ ##\r
+ ## Writing\r
+ ##\r
+ \r
+ print HTML <<END;\r
+<tr align=right valign=top onmouseover="this.style.backgroundColor='$TR_COLOR'" onmouseout="this.style.backgroundColor=''">\r
+<th bgcolor="silver"><a $graph_link>$portnum</a></th>\r
+<td align=left>$do_ports{$portnum}</td>\r
+<td align=right><a title="$PORT->{'link_change_at'}">$link</a></td>\r
+<td></td>\r
+END\r
+ \r
+ foreach (qw( rx64Octets rx65TO127Octets rx128TO255Octets rx256TO511Octets rx512TO1023Octets rx1024ToMa ))\r
+ {\r
+ ##\r
+ ## The amount of packets\r
+ ##\r
+ \r
+ my $tmp = $STAT->{$_};\r
+ my $value_sep = &add_sep($tmp);\r
+ my $value = $tmp;\r
+ my $proc = 0;\r
+ eval { $proc = int($tmp / $STAT->{'rxGood'} * 100) };\r
+ \r
+ \r
+ print HTML "<td><a title=\"$value_sep\">$value</a></td>";\r
+ \r
+ ##\r
+ ## Percent of total\r
+ ##\r
+ \r
+ \r
+ print HTML "<td>$proc\%</td>";\r
+ \r
+ ##\r
+ ## Delta\r
+ ##\r
+ \r
+ my $delta = $STAT->{"delta_$_"};\r
+ \r
+ if ($delta > 0)\r
+ {\r
+ $value = &shorten_num($delta, undef, 1000) . 'pps';\r
+ $value = "<b>$value</b>" if ($SET{'BOLD_ABOVE_PPS'} && $delta > $SET{'BOLD_ABOVE_PPS'} && $value =~ /pps$/);\r
+ $value = "<font color=\"silver\">$value</font>" if ($SET{'GREY_BELOW_PPS'} && $delta < $SET{'GREY_BELOW_PPS'});\r
+ }\r
+ else\r
+ {\r
+ $value = '';\r
+ }\r
+ \r
+ $value_sep = &add_sep($delta);\r
+ \r
+ print HTML "<td><a title=\"$value_sep\">$value</a></td>";\r
+ print HTML "<td></td>" unless ($_ eq 'rx1024ToMa');\r
+ }\r
+ \r
+ print HTML "</tr>\n";\r
+ }\r
+ \r
+ my $created = localtime;\r
+ my $tmp = $runtime;\r
+ $tmp =~ s/(\.\d\d).+$/$1/;\r
+ \r
+ # ServiceTag $system{'serviceTag'}, Serial $system{'serialNum'}\r
+ print HTML <<END;\r
+</table>\r
+\r
+<p>\r
+<font color=silver>Generated by fetch_stat.pl ver $ver written by Joakim Andersson - http://www.iqcc.se</font>\r
+</div>\r
+\r
+</center>\r
+\r
+</body>\r
+</html>\r
+END\r
+ \r
+ close HTML;\r
+}\r
+\r
+##\r
+## Logga in mot Dell-switchen för att få sessions-cookien\r
+##\r
+\r
+sub login\r
+{\r
+ ##\r
+ ## Fetched the loginpage to get the initial Session-value\r
+ ##\r
+ \r
+ &log("Logging in into $SET{'SWITCH'}...", $SET{'VERBOSE'});\r
+ \r
+ my $res = $ua->get("http://$SET{'SWITCH'}/login11.htm");\r
+ &log_n_die("Unable to fetch /login11.htm - ".$res->status_line) unless ($res->is_success);\r
+ \r
+ my $data = $res->content;\r
+ my $session = '';\r
+ \r
+ # Finds the Session-value, needed to compute the password that is sent when logging in\r
+ if ($data =~ /^<input type="hidden" name="Session" value="(.*)">/m)\r
+ {\r
+ $session = $1;\r
+ }\r
+ \r
+ unless ($session)\r
+ {\r
+ &log_n_die("Unable to find variable Session in the page! $data");\r
+ }\r
+ \r
+ if ($session =~ /^0+$/)\r
+ {\r
+ &log_n_die("Session $session is invalid! You may need to wait a while, or possibly reboot the switch");\r
+ }\r
+ \r
+ print "Found 'Session': $session\n" if ($SET{'VERBOSE'} >= 2);\r
+ #$session = '8c6e05969fb0748f7fa239628432ffe4';\r
+ \r
+ ##\r
+ ## Logging in to fetch the cookie\r
+ ##\r
+ \r
+ my $md5_password = md5_hex($SET{'USERNAME'} . $SET{'PASSWORD'} . $session);\r
+ print "Computed MD5: $md5_password\n" if ($SET{'VERBOSE'} >= 2);\r
+ \r
+ my $sock = Net::HTTP->new(Host => $SET{'SWITCH'}) || die $@;\r
+ $sock->write_request(POST => "/tgi/login.tgi",\r
+ 'User-Agent' => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)",\r
+ 'Content-Type' => 'application/x-www-form-urlencoded',\r
+ 'Cache-Control' => 'no-cache',\r
+ 'Accept' => '*/*',\r
+ "Username=$SET{'USERNAME'}&Password=$md5_password&Session=$session"\r
+ );\r
+ \r
+ my($code, $mess, %h) = $sock->read_response_headers;\r
+ \r
+ unless ($code == 302)\r
+ {\r
+ &log_n_die("Didn't recieve code 302 when logging in! $mess");\r
+ }\r
+ \r
+ ##\r
+ ## Finding the Cookie we should recieve when logged in successfully\r
+ ##\r
+ ## Set-Cookie : SSID=0f9a03b3d15acd65af5dfcf6550c5eb6; path=/\r
+ ##\r
+ \r
+ unless ($h{'Set-Cookie'})\r
+ {\r
+ foreach (sort keys %h)\r
+ {\r
+ print "$_ = $h{$_}\n";\r
+ }\r
+ \r
+ &log_n_die("Didn't recieve cookie! $h{'Set-Cookie'}");\r
+ }\r
+ \r
+ $h{'Set-Cookie'} =~ /(SSID=.+?)\;/ || &log_n_die("Unable to interpret SSID from $h{'Set-Cookie'}!");\r
+ $cookie = $1;\r
+ \r
+ &log("Logged in, using session-cookie: $cookie", $SET{'VERBOSE'});\r
+ \r
+ ##\r
+ ## Caching the session for future runs\r
+ ## Prevents hanging of the web-interface if script is restarted un too often\r
+ ##\r
+ \r
+ if ($SET{'COOKIE_FILE'})\r
+ {\r
+ open (COOKIE, ">$SET{'COOKIE_FILE'}") || &log_n_die("Unable to save the cookie to file $SET{'COOKIE_FILE'}!");\r
+ print COOKIE $cookie;\r
+ close COOKIE;\r
+ }\r
+ else\r
+ {\r
+ print "Doesn't cache session\n" if ($SET{'VERBOSE'} >= 2);\r
+ }\r
+}\r
+\r
+##\r
+## Resets stats for a port\r
+##\r
+\r
+sub clear_stat\r
+{\r
+ my $portnum = shift;\r
+ \r
+ # Port- / Trunk-specifik options\r
+ my $arg = ($portnum =~ /^T(\d+)$/) ? "TrunkNo=$1&TrunkNo\$select=$1" : "PortNo=$portnum&PortNo\$select=$portnum";\r
+\r
+ my $sock = Net::HTTP->new(Host => $SET{'SWITCH'}) || die $@;\r
+ $sock->write_request(POST => "/tgi/portstats.tgi",\r
+ 'User-Agent' => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)",\r
+ 'Content-Type' => 'application/x-www-form-urlencoded',\r
+ 'Cache-Control' => 'no-cache',\r
+ 'Accept' => '*/*',\r
+ 'Cookie' => $cookie,\r
+ 'Referer' => "http://$SET{'SWITCH'}/portStats.htm",\r
+ "$arg&RefreshRate\$select=15000&clrCnts=OK"\r
+ );\r
+ \r
+ my ($code, $mess, %h) = $sock->read_response_headers;\r
+ #print "$code : $mess\n";\r
+ \r
+ #foreach (sort keys %h)\r
+ #{\r
+ # print " $_ : $h{$_}\n";\r
+ #}\r
+ \r
+ #unless ($code == 302)\r
+ #{\r
+ # print "Fick inte tillbaka code 302! $mess\n";\r
+ #}\r
+ \r
+ #my $buf;\r
+ #$sock->read_entity_body($buf, 1024);\r
+ #print $buf;\r
+ \r
+ return ($code == 302); # 302 = Probably OK\r
+}\r
+\r
+##\r
+## Reading systeminfo that doesn't change\r
+##\r
+\r
+sub get_system_info\r
+{\r
+ my $res = $ua->get("http://$SET{'SWITCH'}/portConfig.htm",\r
+ 'Cookie' => $cookie\r
+ );\r
+ \r
+ &log_n_die("Unable to fetch /portConfig.htm - ".$res->status_line) unless ($res->is_success);\r
+ \r
+ # Content\r
+ my $data = $res->content;\r
+ $data =~ tr/\r//d;\r
+ \r
+ if ($data =~ /^<title>Login<\/title>$/m)\r
+ {\r
+ ##\r
+ ## Invalid session!\r
+ ##\r
+ \r
+ &log("Session invalid", $SET{'VERBOSE'});\r
+ \r
+ $cookie = '';\r
+ return 0;\r
+ }\r
+ \r
+ ##\r
+ ## Finds the info we needs\r
+ ##\r
+ \r
+ my $row = 0;\r
+ my %vars = ();\r
+ foreach (split(/\n+/, $data))\r
+ {\r
+ $row++;\r
+ #print "RAD $row: $_\n";\r
+ \r
+ last if (/^<\/script>$/); # May need adjustment in future firmwares\r
+ next unless (/^var (.+)="(\d*)";$/);\r
+ \r
+ my $name = $1;\r
+ my $value = $2;\r
+ \r
+ #next if ($stat{$name});\r
+ #print " $name -> $value\n";\r
+ $vars{$name} = $value;\r
+ }\r
+ \r
+ ##\r
+ ## Parses info about every port\r
+ ##\r
+ \r
+ # Setting NumOfPorts if we don't have it\r
+ $numberOfPorts = $vars{'numberOfPorts'};\r
+ $numberOfTrunks = $vars{'numberOfTrunks'};\r
+ \r
+ my $tot = $numberOfPorts + $numberOfTrunks;\r
+ \r
+ foreach my $num (1 .. $tot)\r
+ {\r
+ my $trunknum = $num - $numberOfPorts;\r
+ my $portnum = $num;\r
+ $portnum = "T$trunknum" if ($trunknum > 0); # It's a trunk\r
+ \r
+ my $PORT = $PORTS{$portnum} ||= { 'link_changes' => 0, 'link_change_at' => 'No change detected' };\r
+ \r
+ # var portLinkList="0101110101011100000000";\r
+ # var portSpeedList="0202110201012200333333";\r
+ # var portDuplexList="0101110101011100222222";\r
+ # var portANList="1111111111111111222222";\r
+ # var portBPList="0000000000000000222222";\r
+ # var portFcList="0100000100000000333333";\r
+ \r
+ my $index = $num - 1;\r
+ my $portLink = substr($vars{'portLinkList'}, $index, 1);\r
+ my $portSpeed = substr($vars{'portSpeedList'}, $index, 1);\r
+ my $portDuplex = substr($vars{'portDuplexList'}, $index, 1);\r
+ #my $portAN = substr($vars{'portANList'}, $index, 1);\r
+ my $portFc = substr($vars{'portFcList'}, $index, 1);\r
+ my $portBP = substr($vars{'portBPList'}, $index, 1);\r
+ \r
+ #$PORT->{'link'} = '-' if ($PORT->{'link'} eq 'up?');\r
+ my $link = 'down';\r
+ \r
+ if ($portLink)\r
+ {\r
+ $link = ('10','100','1000','active')[$portSpeed];\r
+ $link .= ('/Half','/Full','')[$portDuplex];\r
+ $link .= '/FC' if ($portFc == 1);\r
+ $link .= '/BP' if ($portBP == 1);\r
+ }\r
+ \r
+ if ($PORT->{'link'} && ($link ne $PORT->{'link'}))\r
+ {\r
+ &log("$do_ports{$portnum} (port $portnum): Change of link detected; $PORT->{'link'} -> $link", $SET{'VERBOSE'} >= 3);\r
+ \r
+ # To show in the HTML\r
+ $PORT->{'link_changes'}++;\r
+ $PORT->{'link_change_at'} = "Change detected $time{'date_time'}; $PORT->{'link'} -> $link. $PORT->{'link_changes'} changes";\r
+ \r
+ # Triggers the link to be shown in bold\r
+ $STATS{$portnum}->{'link_changed'} = 1;\r
+ }\r
+ \r
+ $PORT->{'link'} = $link;\r
+ $PORT->{'is_active'} = $PORT->{'has_link'} = $portLink;\r
+ \r
+ if ($SET{'AUTOADD_ACTIVE_PORTS'} && $portLink && !defined $SET{'PORTS'}->{$portnum})\r
+ {\r
+ ##\r
+ ## We shall autoadd active ports\r
+ ##\r
+ \r
+ if ($trunknum > 0)\r
+ {\r
+ $SET{'PORTS'}->{$portnum} = "Trunk $trunknum";\r
+ &log("Auto-added trunk $portnum as $portnum, link detected", $SET{'VERBOSE'} >= 1);\r
+ }\r
+ else\r
+ {\r
+ $SET{'PORTS'}->{$portnum} = "Port $portnum";\r
+ &log("Auto-added port $portnum, link detected", $SET{'VERBOSE'} >= 1);\r
+ }\r
+ \r
+ $autoadded_ports = 1;\r
+ }\r
+ }\r
+ return 1;\r
+}\r
+\r
+\r
+##\r
+## Rewrites 1024 as 1k, with a given number of digits\r
+##\r
+\r
+sub shorten_num\r
+{\r
+ my $num = shift;\r
+ my $digits = shift || 3;\r
+ my $base = shift || 1024;\r
+ my $unit = '';\r
+ \r
+ foreach (qw(k M G T P E Z Y))\r
+ {\r
+ last if ($num < $base);\r
+ \r
+ $unit = $_;\r
+ $num /= $base;\r
+ }\r
+ \r
+ $num = ($num >= 1000) ? substr($num, 0, 4) : substr($num, 0, $digits);\r
+ $num =~ s/(\.\d*)0+$/$1/;\r
+ $num =~ s/\.$//;\r
+ \r
+ return $num . $unit;\r
+}\r
+\r
+sub log\r
+{\r
+ my $text = shift;\r
+ my $print_too = shift;\r
+ \r
+ print "$text\n" if ($print_too);\r
+ \r
+ unless (fileno(LOG))\r
+ {\r
+ return unless ($SET{'LOG_FILE'});\r
+ open (LOG, ">>$SET{'LOG_FILE'}") || die("Unable to write to $SET{'LOG_FILE'}!");\r
+ \r
+ select LOG;\r
+ $| = 1;\r
+ select STDOUT;\r
+ }\r
+\r
+ print LOG "$time{'date_time'}: $text\n";\r
+}\r
+\r
+sub log_n_die\r
+{\r
+ my $text = shift;\r
+ &log($text);\r
+ die $text;\r
+}\r
+\r
+\r
+sub upd_time\r
+{\r
+ my $unixtime = shift || time;\r
+\r
+ my ($sec,$min,$hour,$daynum,$monnum,$year,$weekdaynum) = localtime($unixtime);\r
+ $sec = "0$sec" if ($sec < 10);\r
+ $min = "0$min" if ($min < 10);\r
+ $hour = "0$hour" if ($hour < 10);\r
+ my $day = $daynum;\r
+ $day = "0$day" if ($day < 10);\r
+ my $mon = $monnum + 1;\r
+ $mon = "0$mon" if ($mon < 10);\r
+ $year += 1900;\r
+\r
+ %time = (sec => $sec, min => $min, hour => $hour, day => $day, daynum => $daynum, weekdaynum => $weekdaynum, mon => $mon, monnum => $monnum, year => $year, unixtime => $unixtime, date_time => "$year-$mon-$day $hour:$min:$sec", date => "$year-$mon-$day", 'time' => "$hour:$min:$sec");\r
+}\r
+\r
+##\r
+## Reads the settings\r
+## Returns 0 when fails\r
+##\r
+\r
+sub refresh_settings\r
+{\r
+ ##\r
+ ## Checks if the settings-file has changed\r
+ ##\r
+ \r
+ my $file_modified = (stat($SETTINGS_FILE))[9];\r
+ die "Unable to access settings-file '$SETTINGS_FILE'!" unless ($file_modified);\r
+ \r
+ if ($file_modified eq $SET{'_modified'})\r
+ {\r
+ # 0 = No change\r
+ return 0;\r
+ }\r
+ \r
+ ##\r
+ ## Changed, re-reading settings\r
+ ##\r
+ \r
+ my %NEW_SET = ();\r
+ $NEW_SET{'_modified'} = $file_modified;\r
+ \r
+ if ($SET{'_modified'})\r
+ {\r
+ &log("Refreshing settings from $SETTINGS_FILE...", $SET{'VERBOSE'});\r
+ }\r
+ \r
+ # Prevents attempts to re-read settings if errors are found\r
+ $SET{'_modified'} = $NEW_SET{'_modified'};\r
+ \r
+ ##\r
+ ## Reads the settings\r
+ ##\r
+ \r
+ open (SET, $SETTINGS_FILE) || &log_n_die("Unable to open settings-file '$SETTINGS_FILE'!");\r
+ while (<SET>)\r
+ {\r
+ next if (/^#/); # Ignoring comments\r
+ tr/\n\r//d; # Stripping linefeeds\r
+ s/\s+$//; # Stripping trailing white spaces\r
+ next unless ($_); # Ignores empty lines\r
+ \r
+ my ($name, $value) = split(/\s*=\s*/, $_, 2);\r
+ \r
+ $NEW_SET{$name} = $value;\r
+ }\r
+ close SET;\r
+ \r
+ ##\r
+ ## Checking basic required variables\r
+ ##\r
+ \r
+ my $errors = 0;\r
+ \r
+ foreach (qw(SWITCH USERNAME PASSWORD REFRESH_RATE POLL_LINKINFO_EVERY_NTH_LOOP\r
+ VERBOSE GRAPHS_PER_ROW GRAPH_WIDTH GRAPH_HEIGHT))\r
+ {\r
+ next if (defined $NEW_SET{$_});\r
+ \r
+ &log("Error: Required setting $_ is not defined", 1);\r
+ $errors++;\r
+ }\r
+ \r
+ ##\r
+ ## Checking numerical-only settings\r
+ ##\r
+ \r
+ foreach (qw(REFRESH_RATE POLL_LINKINFO_EVERY_NTH_LOOP VERBOSE\r
+ AUTOADD_ACTIVE_PORTS HIDE_INACTIVE_PORTS\r
+ GREY_BELOW_PPS BOLD_ABOVE_PPS GREY_BELOW_BPS\r
+ BOLD_ABOVE_BPS GREY_BELOW_PROC\r
+ GRAPH_BPS_EVERY_NTH_LOOP GRAPH_PPS_EVERY_NTH_LOOP\r
+ RRD_STEP GRAPH_WIDTH GRAPH_HEIGHT GRAPHS_PER_ROW\r
+ GRAPH_SLOPE_MODE ))\r
+ {\r
+ next unless (defined $NEW_SET{$_});\r
+ next if ($NEW_SET{$_} =~ /^\d+$/);\r
+ \r
+ # Permits simple expressions\r
+ if ($NEW_SET{$_} =~ /^[\d\-+*\/\.\,]+$/)\r
+ {\r
+ my $new_value = eval $NEW_SET{$_};\r
+ if ($new_value =~ /^(\d+)(\.\d+)?$/)\r
+ {\r
+ #print "$new_value = $1 (stripped $2);\n";\r
+ $NEW_SET{$_} = $1;\r
+ }\r
+ else\r
+ {\r
+ &log("Error: Setting $_; evaluation of expression '$NEW_SET{$_}' failed $!", 1); \r
+ $errors++;\r
+ }\r
+ next;\r
+ }\r
+ \r
+ &log("Error: Setting $_ requires a numerical integer value, has value '$NEW_SET{$_}'", 1);\r
+ $errors++;\r
+ }\r
+ \r
+ ##\r
+ ## Checking >1 values\r
+ ##\r
+ \r
+ foreach (qw(REFRESH_RATE POLL_LINKINFO_EVERY_NTH_LOOP RRD_STEP\r
+ GRAPH_WIDTH GRAPH_HEIGHT))\r
+ {\r
+ next unless (defined $NEW_SET{$_});\r
+ next if ($NEW_SET{$_} >= 1);\r
+ \r
+ &log("Error: Setting $_ requires a numerical integer value larger that zero, has value '$NEW_SET{$_}'", 1);\r
+ $errors++;\r
+ }\r
+ \r
+ ##\r
+ ## Checking if RRDs should be written and the module can be loaded\r
+ ##\r
+ \r
+ if ($NEW_SET{'RRD_FILE_PREFIX'})\r
+ {\r
+ ##\r
+ ## Shall log to RRD\r
+ ##\r
+ \r
+ eval('use RRDs;');\r
+ if ($@)\r
+ {\r
+ ##\r
+ ## Unable to load the RRDs-module!\r
+ ##\r
+ \r
+ $NEW_SET{'RRD_FILE_PREFIX'} = '';\r
+ &log("Setting 'RRD_FILE_PREFIX' is set, but the perl-module RRDs.pm could not be loaded! Disabling RRD", 1);\r
+ }\r
+ }\r
+ \r
+ ##\r
+ ## Shall some ports be excluded from RRD and graphing?\r
+ ##\r
+ \r
+ foreach my $portnum (split(/\s*,\s*/, $NEW_SET{'RRD_SKIP_THESE_PORTS'}))\r
+ {\r
+ # Rewrites the list for easy checking\r
+ $NEW_SET{"RRD_SKIP_PORT_$portnum"} = 1;\r
+ }\r
+ \r
+ ##\r
+ ## If hiding inactive ports, always show these ports\r
+ ##\r
+ \r
+ foreach my $portnum (split(/\s*,\s*/, $NEW_SET{'ALWAYS_SHOW_THESE_PORTS'}))\r
+ {\r
+ # Rewrites the list for easy checking\r
+ $NEW_SET{"ALWAYS_SHOW_PORT_$portnum"} = 1;\r
+ }\r
+\r
+ foreach my $portnum (split(/\s*,\s*/, $NEW_SET{'SHOW_THESE_PORTS'}))\r
+ {\r
+ # Rewrites the list for easy checking\r
+ @do_ports=(@do_ports,$portnum);\r
+ }\r
+ \r
+ ##\r
+ ## Parsing ports and graphs\r
+ ##\r
+ \r
+ my %PORTS = ();\r
+ my %CHAINS = ();\r
+ my @GRAPHS = ();\r
+ my @RRD_RRA = ();\r
+ \r
+ foreach (sort keys %NEW_SET)\r
+ {\r
+ #print "$_\n";\r
+ \r
+ if (/^(PORT|TRUNK|INTERFACE)\s*(.+)$/)\r
+ {\r
+ ##\r
+ ## This is a switch PORT/TRUNK or a local interface\r
+ ## PORT 1 = Router\r
+ ##\r
+ \r
+ my $port = $2;\r
+ $port = "T$2" if ($1 eq 'TRUNK');\r
+ #$port = "I$2" if ($1 eq 'INTERFACE');\r
+ # Skips already defined ports\r
+ if ($PORTS{$port})\r
+ {\r
+ &log("Warn: Port $port is already defined, ignoring this definition", 1);\r
+ next;\r
+ }\r
+ \r
+ # Memorizing this name\r
+ $PORTS{$port} = $NEW_SET{$_};\r
+ }\r
+ elsif (/^CHAIN\s*(\d+)\s*(.+)$/)\r
+ {\r
+ ##\r
+ ## This is a CHAIN\r
+ ## CHAIN 1 joxx:-1 = Router\r
+ ##\r
+ \r
+ my $port = "C$1";\r
+ \r
+ # Skips already defined ports\r
+ if ($PORTS{$port})\r
+ {\r
+ &log("Warn: Port $port is already defined, ignoring this definition", 1);\r
+ next;\r
+ }\r
+ \r
+ $CHAINS{$port} = $2;\r
+ \r
+ # Memorizing this name\r
+ $PORTS{$port} = $NEW_SET{$_};\r
+ }\r
+ elsif (/^GRAPH\s*(\d+)\s*\"(.+)\"$/)\r
+ {\r
+ ##\r
+ ## This is a GRAPH\r
+ ## GRAPH "Past 3 hours" = 60*60*3\r
+ ##\r
+ \r
+ my $index = $1;\r
+ my $name = $2;\r
+ \r
+ # Permits simple expressions\r
+ if ($NEW_SET{$_} =~ /^[\d\-+*\/\.\,]+$/)\r
+ {\r
+ my $new_value = eval $NEW_SET{$_};\r
+ if ($new_value =~ /^(\d+)(\.\d+)?$/)\r
+ {\r
+ #print "$new_value = $1 (stripped $2);\n";\r
+ $NEW_SET{$_} = $1;\r
+ }\r
+ else\r
+ {\r
+ &log("Error: Setting $_; evaluation of expression '$NEW_SET{$_}' failed $!", 1); \r
+ $errors++;\r
+ next;\r
+ }\r
+ }\r
+ \r
+ # Memorizing this graph\r
+ push (@GRAPHS, [$index, $name, $NEW_SET{$_}] );\r
+ }\r
+ elsif (/^RRD_RRA/)\r
+ {\r
+ ##\r
+ ## This is a RRD RRA-statement\r
+ ## RRD_RRA 1 = RRA:AVERAGE:0.5:1:360\r
+ ##\r
+ \r
+ # Memorizing this RRA-definition\r
+ push (@RRD_RRA, $NEW_SET{$_});\r
+ }\r
+ }\r
+ \r
+ if ($NEW_SET{'SYNC_SLEEP_TO_RRD'} && ($NEW_SET{'RRD_STEP'} != $NEW_SET{'REFRESH_RATE'}))\r
+ {\r
+ &log("Can only sync sleep to RRD_STEP if REFRESH_RATE == RRD_STEP", 1);\r
+ $NEW_SET{'SYNC_SLEEP_TO_RRD'} = 0;\r
+ }\r
+ \r
+ # No ports defined?\r
+ unless (%PORTS)\r
+ {\r
+ &log("Err: No PORTs to poll is defined!", 1);\r
+ $errors++;\r
+ }\r
+ \r
+ # Memorizing the ports\r
+ $NEW_SET{'PORTS'} = \%PORTS;\r
+ \r
+ # No graphs defined?\r
+ if (($NEW_SET{'GRAPH_BPS_EVERY_NTH_LOOP'} || $NEW_SET{'GRAPH_PPS_EVERY_NTH_LOOP'}) && !@GRAPHS)\r
+ {\r
+ &log("Err: No GRAPHs to create is defined!", 1);\r
+ $errors++;\r
+ }\r
+\r
+ # Is selected GRAPH_OVERVIEW defined? FIXME\r
+ #if ($NEW_SET{'GRAPH_RRD_EVERY_NTH_LOOP'} && !defined $GRAPHS[ $NEW_SET{'GRAPH_OVERVIEW'}-1 ])\r
+ #{\r
+ # &log("Err: Selected GRAPH_OVERVIEW $NEW_SET{'GRAPH_OVERVIEW'} does not exist!", 1);\r
+ # $errors++;\r
+ #}\r
+ \r
+ # Memorizing the ports\r
+ $NEW_SET{'GRAPHS'} = \@GRAPHS;\r
+\r
+ # No RRD RRAs defined?\r
+ if ($NEW_SET{'RRD_FILE_PREFIX'} && !@RRD_RRA)\r
+ {\r
+ &log("Err: No RRD_RRAs is defined! Cannot create RRD-files without any", 1);\r
+ $errors++;\r
+ }\r
+ \r
+ # Memorizing the RRA definitions\r
+ $NEW_SET{'RRD_RRA'} = \@RRD_RRA;\r
+ \r
+ # Memorizing the chains\r
+ $NEW_SET{'CHAINS'} = \%CHAINS;\r
+ \r
+ ##\r
+ ## Returns a 2 if basic errors are encountered\r
+ ##\r
+ \r
+ return 2 if ($errors);\r
+ \r
+ # Activating settings\r
+ %SET = %NEW_SET;\r
+ close LOG;\r
+ \r
+ # 1 = Settings changed\r
+ return 1;\r
+}\r
+\r
+##\r
+## Rewrites sysUpTime to a readable time\r
+##\r
+\r
+sub parse_sysuptime\r
+{\r
+ my $secs = $system{'sysUpTime'};\r
+ $secs =~ s/\d\d$//; # Strips last two digits to only have seconds left\r
+ \r
+ my $uptime = '';\r
+ my $days = int($secs / 86400);\r
+ if ($days)\r
+ {\r
+ $secs -= $days*86400;\r
+ $uptime .= "${days}d";\r
+ }\r
+ my $hours = int($secs / 3600);\r
+ if ($hours || $days)\r
+ {\r
+ $secs -= $hours*3600;\r
+ $uptime .= "${hours}h";\r
+ }\r
+ my $mins = int($secs / 60);\r
+ $uptime .= "${mins}m";\r
+ #$secs -= $mins*60;\r
+ #$uptime .= "${mins}m${secs}s";\r
+ \r
+ $system{'uptime'} = $uptime;\r
+}\r
+\r
+##\r
+## 12345678 -> 12'345'678\r
+##\r
+\r
+sub add_sep\r
+{\r
+ my $value = shift;\r
+ $value =~ s/(\.\d+)$//;\r
+ my $decimals = ($1 && $value < 10) ? $1 : '';\r
+ $value = reverse $value;\r
+ \r
+ $value =~ s/(\d\d\d)/$1\'/g;\r
+ $value =~ s/\'$//;\r
+ return (reverse $value) . substr($decimals, 0, 3);\r
+}\r
+\r
+##\r
+## Creates a empty RRD-file\r
+##\r
+\r
+sub create_rrd\r
+{\r
+ my $filename = shift || &error("No filename given to create as a RRD-file!");\r
+ \r
+ # Will not overwrite a existing file\r
+ return (1,"File '$filename' already existed!") if (-e $filename);\r
+ \r
+ # Creating RRD-file\r
+ RRDs::create(\r
+ $filename,\r
+ '--step',\r
+ $SET{'RRD_STEP'},\r
+ 'DS:kbps_out:GAUGE:60:0:1000000',\r
+ 'DS:kbps_in:GAUGE:60:0:1000000',\r
+ 'DS:pps_out:GAUGE:60:0:10000000',\r
+ 'DS:pps_in:GAUGE:60:0:10000000',\r
+ 'DS:err_pps_out:GAUGE:60:0:10000000',\r
+ 'DS:err_pps_in:GAUGE:60:0:10000000',\r
+ @{$SET{'RRD_RRA'}}\r
+ );\r
+ \r
+ my $error = &RRDs::error;\r
+ return(0, "Unable to create RRD-file '$filename'!: $error") if ($error);\r
+ \r
+ my $size = -s $filename;\r
+ unless ($size > 0)\r
+ {\r
+ unlink $filename; # Removes the file so we won't try to write to it later\r
+ return(0, "Unable to create RRD-file '$filename'!: Zero size file");\r
+ }\r
+ \r
+ return (1, "File '$filename' created, size $size bytes");\r
+}\r
+\r
+##\r
+## Generate graphs\r
+##\r
+\r
+sub generate_rrd_graphs\r
+{\r
+ my $type = shift || 'bps'; # bps or pps\r
+ \r
+ ##\r
+ ## Yep, let's create a bunch of files \r
+ ##\r
+ \r
+ $SET{'HTML_FILE'} =~ /^(.*\/)?([^\/]+)(\.[^.]+)$/;\r
+ my $path = $1; # path/to/\r
+ my $base = $2; # stats-file\r
+ my $suffix = $3; # .html\r
+ \r
+ #print "$path - $base - $suffix\n";\r
+ \r
+ # How often the graph-page will change\r
+ my $refresh = $SET{'REFRESH_RATE'} * $SET{'GRAPH_' . uc $type . '_EVERY_NTH_LOOP'};\r
+ \r
+ # Shall we also graph the other type? Otherwise no links\r
+ my $graph_other_type = $SET{'GRAPH_' . uc $graph_rev_type{$type} . '_EVERY_NTH_LOOP'};\r
+ \r
+ my $ucname = ucfirst $graph_names{$type};\r
+ my $rev = $graph_rev_type{$type}; # bps -> pps, pps -> bps\r
+ my $switch = $system{'systemName'} || $SET{'SWITCH'};\r
+ \r
+ my @index_graphs = (); # We will create the page last\r
+ \r
+ ##\r
+ ## Creates a overview for this type\r
+ ##\r
+ \r
+ foreach my $portnum (@do_ports)\r
+ {\r
+ ##\r
+ ## Does each port\r
+ ##\r
+ \r
+ # Skip this port\r
+ next if ($SET{"RRD_SKIP_PORT_$portnum"});\r
+ \r
+ my $rrd_filename = $SET{'RRD_FILE_PREFIX'} . "_$portnum.rrd";\r
+ next unless (-s $rrd_filename); # Will not proceed unless the rrd-data exist\r
+ \r
+ ##\r
+ ## Writes indexfile for each port that will contain the graphs\r
+ ##\r
+ \r
+ my @port_graphs = (); # We will create the page last\r
+ \r
+ my $rrd_port_file = "${base}_${type}_${portnum}$suffix";\r
+ $PORTS{$portnum}->{"rrd_${type}_file"} = $rrd_port_file; # Remembering\r
+ \r
+ ##\r
+ ## Creating graphs\r
+ ##\r
+ \r
+ my @graph_args = ('--interlaced','--lazy');\r
+ push (@graph_args, '--slope-mode') if ($SET{'GRAPH_SLOPE_MODE'});\r
+ \r
+ foreach my $graph_ref (@{$SET{'GRAPHS'}})\r
+ {\r
+ my $i = $graph_ref->[0];\r
+ my $graph_name = $graph_ref->[1];\r
+ my $graph_secs = $graph_ref->[2];\r
+ \r
+ my $image_filename = "${base}_${type}_$portnum-$i.png";\r
+ #unlink $image_filename if ($erase_images);\r
+ \r
+ ##\r
+ ## Mega graph command\r
+ ##\r
+ \r
+ my $averages = my $xsize = my $ysize = 0;\r
+ \r
+ if ($type eq 'bps')\r
+ {\r
+ ##\r
+ ## Bits/s\r
+ ##\r
+ \r
+ ($averages,$xsize,$ysize) = RRDs::graph("$path$image_filename",\r
+ "--start=end-$graph_secs",\r
+ "--title=$do_ports{$portnum} ($portnum) on $switch - $graph_name",\r
+ "--vertical-label=$graph_names{$type}",\r
+ '--base=1024',\r
+ '--imgformat=PNG',\r
+ "--width=$SET{'GRAPH_WIDTH'}",\r
+ "--height=$SET{'GRAPH_HEIGHT'}",\r
+ '--alt-y-mrtg',\r
+ @graph_args,\r
+ "DEF:b=$rrd_filename:kbps_out:AVERAGE",\r
+ "DEF:a=$rrd_filename:kbps_in:AVERAGE",\r
+ 'CDEF:B=b,1024,*',\r
+ 'CDEF:A=a,1024,*',\r
+ 'AREA:B#00FF00:bit/s OUT',\r
+ 'VDEF:B_AVERAGE=B,AVERAGE',\r
+ 'GPRINT:B_AVERAGE:Avg\: %7.2lf%s ',\r
+ 'VDEF:B_MAX=B,MAXIMUM',\r
+ 'GPRINT:B_MAX:Max\: %7.2lf%s ',\r
+ 'VDEF:B_LAST=B,LAST',\r
+ 'GPRINT:B_LAST:Last\: %7.2lf%s\n',\r
+ 'LINE1:A#0000FF:bit/s IN ',\r
+ 'VDEF:A_AVERAGE=A,AVERAGE',\r
+ 'GPRINT:A_AVERAGE:Avg\: %7.2lf%s ',\r
+ 'VDEF:A_MAX=A,MAXIMUM',\r
+ 'GPRINT:A_MAX:Max\: %7.2lf%s ',\r
+ 'VDEF:A_LAST=A,LAST',\r
+ 'GPRINT:A_LAST:Last\: %7.2lf%s'\r
+ );\r
+ }\r
+ else\r
+ {\r
+ ##\r
+ ## Packets/s\r
+ ##\r
+ \r
+ ($averages,$xsize,$ysize) = RRDs::graph("$path$image_filename",\r
+ "--start=end-$graph_secs",\r
+ "--title=$do_ports{$portnum} ($portnum) on $switch - $graph_name",\r
+ "--vertical-label=$graph_names{$type}",\r
+ '--base=1000',\r
+ '--imgformat=PNG',\r
+ "--width=$SET{'GRAPH_WIDTH'}",\r
+ "--height=$SET{'GRAPH_HEIGHT'}",\r
+ '--alt-y-mrtg',\r
+ @graph_args,\r
+ "DEF:d=$rrd_filename:pps_out:AVERAGE",\r
+ "DEF:c=$rrd_filename:pps_in:AVERAGE",\r
+ "DEF:f=$rrd_filename:err_pps_out:AVERAGE",\r
+ "DEF:e=$rrd_filename:err_pps_in:AVERAGE",\r
+ 'AREA:d#00FF00:Pkts/s OUT ',\r
+ 'VDEF:d_AVERAGE=d,AVERAGE',\r
+ 'GPRINT:d_AVERAGE:Avg\: %7.2lf%s',\r
+ 'VDEF:d_MAX=d,MAXIMUM',\r
+ 'GPRINT:d_MAX:Max\: %7.2lf%s',\r
+ 'VDEF:d_LAST=d,LAST',\r
+ 'GPRINT:d_LAST:Last\: %7.2lf%s\n',\r
+ 'LINE1:c#0000FF:Pkts/s IN ',\r
+ 'VDEF:c_AVERAGE=c,AVERAGE',\r
+ 'GPRINT:c_AVERAGE:Avg\: %7.2lf%s',\r
+ 'VDEF:c_MAX=c,MAXIMUM',\r
+ 'GPRINT:c_MAX:Max\: %7.2lf%s',\r
+ 'VDEF:c_LAST=c,LAST',\r
+ 'GPRINT:c_LAST:Last\: %7.2lf%s\n',\r
+ 'LINE1:f#FFA500:Err pkts/s OUT',\r
+ 'VDEF:f_AVERAGE=f,AVERAGE',\r
+ 'GPRINT:f_AVERAGE:Avg\: %7.2lf%s',\r
+ 'VDEF:f_MAX=f,MAXIMUM',\r
+ 'GPRINT:f_MAX:Max\: %7.2lf%s',\r
+ 'VDEF:f_LAST=f,LAST',\r
+ 'GPRINT:f_LAST:Last\: %7.2lf%s\n',\r
+ 'LINE1:e#FF0000:Err pkts/s IN ',\r
+ 'VDEF:e_AVERAGE=e,AVERAGE',\r
+ 'GPRINT:e_AVERAGE:Avg\: %7.2lf%s',\r
+ 'VDEF:e_MAX=e,MAXIMUM',\r
+ 'GPRINT:e_MAX:Max\: %7.2lf%s',\r
+ 'VDEF:e_LAST=e,LAST',\r
+ 'GPRINT:e_LAST:Last\: %7.2lf%s'\r
+ );\r
+ }\r
+ \r
+ my $error = &RRDs::error;\r
+ &log("Unable to create graph '$path$image_filename'! $error", 1) if ($error);\r
+ \r
+ ##\r
+ ## We create graphs first and then the page\r
+ ##\r
+ \r
+ push (@port_graphs, "<img src=\"$image_filename\" width=$xsize height=$ysize>");\r
+ push (@index_graphs, "<a href=\"$rrd_port_file\"><img src=\"$image_filename\" width=$xsize height=$ysize border=0></a>") if ($i == $SET{'GRAPH_OVERVIEW'});\r
+ \r
+ # This graph is done\r
+ }\r
+ \r
+ ##\r
+ ## All graphs for this port done, create the page\r
+ ##\r
+ \r
+ my $switch_link = ($graph_other_type) ? "<br><a href=\"${base}_${rev}_$portnum$suffix\">Switch to $graph_names{$rev}</a>" : '';\r
+\r
+ open(HTML, ">$path$rrd_port_file");\r
+ print HTML <<END;\r
+<html>\r
+<head>\r
+<title>$ucname for $do_ports{$portnum} (port $portnum) on $SET{'SWITCH'} - $system{'systemName'} $system{'locationName'}</title>\r
+<meta http-equiv="Refresh" content="$refresh">\r
+</head>\r
+\r
+<body bgcolor="White" text="Black" link="Black" vlink="Black" alink="Red" style="font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; font-size: 9;">\r
+<center>\r
+<div style="font-size: 13; font-weight: bold;">$ucname - $do_ports{$portnum} (port $portnum)</div>\r
+$switch_link\r
+<br><a href="${base}_$type$suffix">Show overview for $graph_names{$type}</a>\r
+\r
+<p>\r
+END\r
+ \r
+ my $i = 0;\r
+ foreach (@port_graphs)\r
+ {\r
+ print HTML $_;\r
+ print HTML "<br>\n" if ($SET{'GRAPHS_PER_ROW'} && (++$i % $SET{'GRAPHS_PER_ROW'} == 0));\r
+ }\r
+ \r
+ print HTML <<END;\r
+<p>Page updated $time{'date_time'}, refreshes every $refresh sec\r
+ \r
+</center>\r
+</body>\r
+</html>\r
+END\r
+ close HTML;\r
+ # Page for BPS or PPS done för this port\r
+ }\r
+ \r
+ ##\r
+ ## Writing the index-page for this type\r
+ ##\r
+ \r
+ my $type_index_file = "${base}_${type}$suffix";\r
+ my $switch_link = ($graph_other_type) ? "<br><a href=\"${base}_$rev$suffix\">Switch to $graph_names{$rev}</a>" : '';\r
+ \r
+ open(HTML, ">$path$type_index_file");\r
+ print HTML <<END;\r
+<html>\r
+<head>\r
+<title>Overview $graph_names{$type} on $SET{'SWITCH'} - $system{'systemName'} $system{'locationName'}</title>\r
+<meta http-equiv="Refresh" content="$refresh">\r
+</head>\r
+\r
+<body bgcolor="White" text="Black" link="Black" vlink="Black" alink="Red" style="font-family: Verdana, Geneva, Arial, Helvetica, sans-serif; font-size: 9;">\r
+<center>\r
+<div style="font-size: 13; font-weight: bold;">$ucname - Overview</div>\r
+$switch_link\r
+<br><a href="$base$suffix">Return to statistics</a>\r
+<p>\r
+END\r
+ \r
+ my $i = 0;\r
+ foreach (@index_graphs)\r
+ {\r
+ print HTML $_;\r
+ print HTML "<br>\n" if ($SET{'GRAPHS_PER_ROW'} && (++$i % $SET{'GRAPHS_PER_ROW'} == 0));\r
+ }\r
+ \r
+ print HTML <<END;\r
+<p>Page updated $time{'date_time'}, refreshes every $refresh sec\r
+\r
+</center>\r
+</body>\r
+</html>\r
+END\r
+ close HTML;\r
+ \r
+ ##\r
+ ## All ports done\r
+ ##\r
+ \r
+ return 1;\r
+}\r
+\r
+##\r
+## Poll local interface\r
+## We could easily have done this buffered instead\r
+##\r
+\r
+sub poll_interface\r
+{\r
+ my $interface = shift;\r
+ my $STAT = shift || {};\r
+ my $ok = 0;\r
+ \r
+ if ($SET{'USE_ETHTOOL'})\r
+ {\r
+ ##\r
+ ## Poll using ethtool, hopefully\r
+ ##\r
+\r
+ unless (open (ETHTOOL, "$SET{'USE_ETHTOOL'} -S $interface |"))\r
+ {\r
+ ##\r
+ ## Unable to poll successfully!\r
+ ##\r
+ \r
+ &log("Unable to run command '$SET{'USE_ETHTOOL'} -S $interface'! Disabling polling using ethtool", 1);\r
+ $SET{'USE_ETHTOOL'} = '';\r
+ }\r
+ else\r
+ {\r
+ ##\r
+ ## We were able to run the command (hopefully)\r
+ ##\r
+ \r
+ my %E = ();\r
+ \r
+ while (<ETHTOOL>)\r
+ {\r
+ # rx_packets: 6207689\r
+ # tx_packets: 2174409\r
+ # rx_bytes: 4192981116\r
+ \r
+ chomp;\r
+ s/^\s*//;\r
+ my ($name, $value) = split(/\s*\:\s*/, $_, 2);\r
+ next unless ($value =~ /^\d+$/); # Makes sure we don't take crap\r
+ \r
+ $E{$name} = $value;\r
+ }\r
+ close ETHTOOL;\r
+ \r
+ ##\r
+ ## Sanity-check\r
+ ##\r
+ \r
+ my $not_ok = 0;\r
+ \r
+ foreach (qw(rx_bytes rx_packets tx_bytes tx_packets))\r
+ {\r
+ next if (defined $E{$_});\r
+ \r
+ &log("Ethtool didn't provide expected variable $_!", 1);\r
+ $not_ok++;\r
+ }\r
+ \r
+ if ($not_ok)\r
+ {\r
+ &log("Disabling polling using ethtool, ($SET{'USE_ETHTOOL'} -S $interface)", 1);\r
+ $SET{'USE_ETHTOOL'} = '';\r
+ }\r
+ else\r
+ {\r
+ ##\r
+ ## Okay, I'm not certain about the more unusual errors like FCS\r
+ ##\r
+ \r
+ $STAT->{'goodOctetRCV'} = $E{'rx_bytes'};\r
+ $STAT->{'rxGood'} = $E{'rx_packets'};\r
+ $STAT->{'rxBroadcast'} = $E{'rx_broadcast'} if (defined $E{'rx_broadcast'});\r
+ $STAT->{'rxMulticast'} = $E{'rx_multicast'} if (defined $E{'rx_multicast'});\r
+ $STAT->{'rxFCS'} = $E{'rx_align_errors'} + $E{'rx_crc_errors'} if (defined $E{'rx_align_errors'} || defined $E{'rx_crc_errors'});\r
+ $STAT->{'rxUnderSize'} = $E{'rx_short_length_errors'} if (defined $E{'rx_short_length_errors'});\r
+ $STAT->{'rxOverSize'} = $E{'rx_long_length_errors'} if (defined $E{'rx_long_length_errors'});\r
+ $STAT->{'rxFragment'} = ''; # Available?\r
+ $STAT->{'rxJabber'} = ''; # Available?\r
+ \r
+ $STAT->{'goodOctetSND'} = $E{'tx_bytes'};\r
+ $STAT->{'txGood'} = $E{'tx_packets'};\r
+ $STAT->{'txBroadcast'} = $E{'tx_broadcast'} if (defined $E{'tx_broadcast'});\r
+ $STAT->{'txMulticast'} = $E{'tx_multicast'} if (defined $E{'tx_multicast'});\r
+ $STAT->{'txDrop'} = $E{'tx_dropped'} if (defined $E{'tx_dropped'});\r
+ $STAT->{'txCollisions'} = $E{'collisions'} if (defined $E{'collisions'});\r
+ \r
+ $ok = 1;\r
+ }\r
+ }\r
+ }\r
+ \r
+ unless ($SET{'USE_ETHTOOL'})\r
+ {\r
+ ##\r
+ ## Don't poll using ethtool\r
+ ## Opens /proc/net/dev to read some statistics\r
+ ##\r
+ \r
+ unless (open (DEV, '/proc/net/dev'))\r
+ {\r
+ &log("Unable to open '/proc/net/dev'!", 1);\r
+ return 0;\r
+ }\r
+ \r
+ # Searching for this interface\r
+ while (<DEV>)\r
+ {\r
+ #Inter-| Receive | Transmit\r
+ # face |bytes packets errs drop fifo frame compressed multicast|bytes packets errs drop fifo colls carrier compressed\r
+ # eth0:230864891 964901 0 0 0 0 0 0 867172607 936222 0 0 0 0 0 0\r
+ \r
+ if (/^\s*$interface\:\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/)\r
+ {\r
+ ##\r
+ ## Remembering some data\r
+ ##\r
+ \r
+ $STAT->{'goodOctetRCV'} = $1;\r
+ $STAT->{'rxGood'} = $2;\r
+ $STAT->{'rxFCS'} = $6;\r
+ $STAT->{'rxUnderSize'} = '';\r
+ $STAT->{'rxOverSize'} = '';\r
+ $STAT->{'rxFragment'} = '';\r
+ $STAT->{'rxJabber'} = '';\r
+ \r
+ $STAT->{'goodOctetSND'} = $9;\r
+ $STAT->{'txGood'} = $10;\r
+ $STAT->{'txDrop'} = $12;\r
+ $STAT->{'txCollisions'} = $14;\r
+ \r
+ $ok = 1;\r
+ \r
+ last;\r
+ }\r
+ }\r
+ close DEV;\r
+ }\r
+ \r
+ return $ok;\r
+}\r
+\r
+##\r
+## Polls values from a local iptables' chain\r
+##\r
+\r
+sub poll_chain\r
+{\r
+ my $chain = shift;\r
+ my $STAT = shift || {};\r
+ my $ok = 0;\r
+ \r
+ $STAT->{'goodOctetRCV'} = 0;\r
+ $STAT->{'rxGood'} = 0;\r
+ $STAT->{'rxFCS'} = '';\r
+ $STAT->{'rxUnderSize'} = '';\r
+ $STAT->{'rxOverSize'} = '';\r
+ $STAT->{'rxFragment'} = '';\r
+ $STAT->{'rxJabber'} = '';\r
+ \r
+ $STAT->{'goodOctetSND'} = 0;\r
+ $STAT->{'txGood'} = 0;\r
+ $STAT->{'txDrop'} = '';\r
+ $STAT->{'txCollisions'} = '';\r
+ \r
+ ##\r
+ ## Reads info from iptables\r
+ ## chain1,1,chain2,1\r
+ ##\r
+ \r
+ my @def = split(/\s*,\s*/, $chain);\r
+ my @chains = (['OUT',$def[0],$def[1]], ['IN',$def[2],$def[3]]);\r
+ \r
+ foreach my $ref (@chains)\r
+ {\r
+ my $type = $$ref[0];\r
+ my $chain = $$ref[1];\r
+ my $row = $$ref[2] || -1; # Defaults to last row\r
+ next unless ($chain);\r
+ \r
+ unless (open (CHAIN, "iptables -vxn -L $chain |"))\r
+ {\r
+ &log("Unable to execute command 'iptables -vxn -L $chain'!", 1);\r
+ return 0;\r
+ }\r
+ \r
+ my @lines = <CHAIN>;\r
+ close CHAIN;\r
+ \r
+ # Make -1 become the last actual row\r
+ # If 4 lines total, 4-1 = 3 = lines[3] = last row\r
+ $row = scalar @lines + $row if ($row < 0);\r
+ \r
+ # Pick the line to parse\r
+ my $line = $lines[$row];\r
+ \r
+ # Parse that line, expect the first two lines to be packets and bytes\r
+ # 7477 478570 RETURN all -- * * 0.0.0.0/0 0.0.0.0/0\r
+ unless ($line =~ /^\s*(\d+)\s+(\d+)\s/)\r
+ {\r
+ &log("Parsing chain '$chain'; row $row contained '$line', unable to parse!", 1);\r
+ return 0;\r
+ }\r
+ \r
+ #print "$type: $chain - row $row = $line -> pkts $1, bytes $2\n";\r
+ \r
+ if ($type eq 'OUT')\r
+ {\r
+ $STAT->{'goodOctetSND'} = $2;\r
+ $STAT->{'txGood'} = $1;\r
+ }\r
+ else\r
+ {\r
+ $STAT->{'goodOctetRCV'} = $2;\r
+ $STAT->{'rxGood'} = $1;\r
+ }\r
+ }\r
+ return 1;\r
+}\r
projects / IRC.git / commitdiff