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