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