1#!/usr/bin/perl 2# 3# CGI.pm web script to handle stats POSTs 4# 5# Copyright (C) 2010, Broadcom Corporation. All Rights Reserved. 6# 7# Permission to use, copy, modify, and/or distribute this software for any 8# purpose with or without fee is hereby granted, provided that the above 9# copyright notice and this permission notice appear in all copies. 10# 11# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 12# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 13# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 14# SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 15# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION 16# OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN 17# CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 18# 19# $Id: stats.pl,v 1.5 2003/10/16 21:13:40 Exp $ 20# 21 22use CGI; 23use CGI qw/escape unescape/; 24use CGI qw/:standard :html3/; 25 26$query = new CGI; 27$savedir = "/tmp"; 28 29print $query->header; 30print $query->start_html("Broadcom Internal Board Statistics"); 31print $query->h1("Broadcom Internal Board Statistics"); 32 33# Here's where we take action on the previous request 34&save_parameters($query) if $query->param('action') eq 'save'; 35$query = &restore_parameters($query) if $query->param('action') eq 'restore'; 36 37# Here's where we create the form 38print $query->startform; 39print "Board type: "; 40print $query->popup_menu(-name=>'boardtype', 41 -values=>['', 42 'bcm94710dev', 43 'bcm94710r4']); 44 45print $query->p; 46if (opendir(DIR, $savedir)) { 47 $pattern = $query->param('boardtype'); 48 @boards = ''; 49 foreach (readdir(DIR)) { 50 /^$pattern\_(\d+)/ && push(@boards, $1); 51 } 52 closedir(DIR); 53 if ($pattern && @boards) { 54 print "Board number: "; 55 print $query->popup_menu(-name=>'boardnum', 56 -values=>\@boards); 57 } else { 58 print "No boards"; 59 } 60} else { 61 print "No boards"; 62} 63 64print $query->p; 65if (opendir(DIR, $savedir.&clean_name($query))) { 66 @reports = grep(!/^\./, readdir(DIR)); 67 @labels{@reports} = map($unused = localtime($_), @reports); 68 closedir(DIR); 69 if (@reports) { 70 print "Report: "; 71 print $query->popup_menu(-name=>'savefile', 72 -values=>\@reports, 73 -labels=>\%labels); 74 } else { 75 print "No reports"; 76 } 77} else { 78 print "No reports"; 79} 80 81print $query->p; 82print $query->submit('action', 'restore'); 83print $query->endform; 84print $query->hr; 85 86foreach (split('\n', $query->param('/proc/net/dev'))) { 87 (/^Inter/ || /^ face/) && next; 88 ($name, $rest) = /^\s*(\S+):(.*)$/; 89 ($rx_bytes{$name}, $rx_packets{$name}, $rx_errs{$name}, $rx_drop{$name}, 90 $rx_fifo{$name}, $rx_frame{$name}, $rx_compressed{$name}, $rx_multicast{$name}, 91 $tx_bytes{$name}, $tx_packets{$name}, $tx_errs{$name}, $tx_drop{$name}, 92 $tx_fifo{$name}, $tx_colls{$name}, $tx_carrier{$name}, $tx_compressed{$name}) = 93 $rest =~ /\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+)/; 94} 95 96print table({-border=>undef}, 97 Tr({-align=>LEFT,-valign=>TOP}, 98 [th('Board type').td($query->param('boardtype')), 99 th('Board number').td($query->param('boardnum')), 100 th('CPU clock').td($query->param('clkfreq')), 101 th('OS name').td($query->param('os_name')), 102 th('OS version').td($query->param('os_version')), 103 th('Uptime').td($query->param('uptime')), 104 105 th('WAN MAC address').td($query->param('wan_hwaddr')), 106 th('WAN IP address').td($query->param('wan_ipaddr')), 107 th('WAN protocol').td($query->param('wan_proto')), 108 th('WAN receive bytes').td($rx_bytes{$query->param('wan_ifname')}), 109 th('WAN receive packets').td($rx_packets{$query->param('wan_ifname')}), 110 th('WAN receive errors').td($rx_errs{$query->param('wan_ifname')}), 111 th('WAN receive drops').td($rx_drop{$query->param('wan_ifname')}), 112 th('WAN transmit bytes').td($tx_bytes{$query->param('wan_ifname')}), 113 th('WAN transmit packets').td($tx_packets{$query->param('wan_ifname')}), 114 th('WAN transmit errors').td($tx_errs{$query->param('wan_ifname')}), 115 th('WAN transmit drops').td($tx_drop{$query->param('wan_ifname')}), 116 117 th('LAN MAC address').td($query->param('lan_hwaddr')), 118 th('LAN IP address').td($query->param('lan_ipaddr')), 119 th('LAN protocol').td($query->param('lan_proto')), 120 th('LAN receive bytes').td($rx_bytes{$query->param('lan_ifname')}), 121 th('LAN receive packets').td($rx_packets{$query->param('lan_ifname')}), 122 th('LAN receive errors').td($rx_errs{$query->param('lan_ifname')}), 123 th('LAN receive drops').td($rx_drop{$query->param('lan_ifname')}), 124 th('LAN transmit bytes').td($tx_bytes{$query->param('lan_ifname')}), 125 th('LAN transmit packets').td($tx_packets{$query->param('lan_ifname')}), 126 th('LAN transmit errors').td($tx_errs{$query->param('lan_ifname')}), 127 th('LAN transmit drops').td($tx_drop{$query->param('lan_ifname')}), 128 ])); 129 130# Here we print out a bit at the end 131print $query->end_html; 132 133sub save_parameters { 134 local($query) = @_; 135 local($dir) = $savedir.&clean_name($query); 136 local($filename) = time; 137 138 opendir(DIRHANDLE, $dir) ? closedir(DIRHANDLE) : mkdir($dir, 0755); 139 if (open(FILE, ">$dir/$filename")) { 140 $query->param('savefile', $filename); 141 $query->save(FILE); 142 close FILE; 143 # print "<STRONG>State has been saved to file $dir/$filename</STRONG>\n"; 144 } else { 145 # print "<STRONG>Error:</STRONG> couldn't write to file $dir/$filename: $!\n"; 146 } 147} 148 149sub restore_parameters { 150 local($query) = @_; 151 local($dir) = $savedir.&clean_name($query); 152 local($filename) = $query->param('savefile'); 153 154 if (!($filename eq "") && 155 open(FILE, "$dir/$filename")) { 156 $query = new CGI(FILE); # Throw out the old query, replace it with a new one 157 close FILE; 158 # print "<STRONG>State has been restored from file $filename</STRONG>\n"; 159 } else { 160 # print "<STRONG>Error:</STRONG> couldn't restore file $dir/$filename: $!\n"; 161 } 162 return $query; 163} 164 165 166# Very important subroutine -- get rid of all the naughty 167# metacharacters from the file name. If there are, we 168# complain bitterly and die. 169sub clean_name { 170 local($query) = @_; 171 local($name) = $query->param('boardtype')."_".$query->param('boardnum'); 172 unless ($name=~/^[\w\._-]+$/) { 173 # print "<STRONG>$name has naughty characters. Only "; 174 # print "alphanumerics are allowed. You can't use absolute names.</STRONG>"; 175 die "Attempt to use naughty characters"; 176 } 177 return $name; 178} 179