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