ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/ihost-perl/plugins/perl/i-scream_top.pl
Revision: 1.7
Committed: Fri Mar 28 16:30:34 2003 UTC (21 years, 7 months ago) by tdb
Content type: text/plain
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +1 -1 lines
State: FILE REMOVED
Log Message:
Removed some un-used code from CVS. We can always resurrect this later if
someone feels they want to work on it. Gone are the old perl ihost which
isn't needed now, winhost which is broken and shows no sign of being fixed,
and DBReporter. If someone wants to revive them, I'll undelete them :-)

File Contents

# User Rev Content
1 tdb 1.1 #!/usr/bin/perl -w
2    
3 tdb 1.5 #
4     # i-scream central monitoring system
5 tdb 1.6 # http://www.i-scream.org.uk
6 tdb 1.5 # Copyright (C) 2000-2002 i-scream
7     #
8     # This program is free software; you can redistribute it and/or
9     # modify it under the terms of the GNU General Public License
10     # as published by the Free Software Foundation; either version 2
11     # of the License, or (at your option) any later version.
12     #
13     # This program is distributed in the hope that it will be useful,
14     # but WITHOUT ANY WARRANTY; without even the implied warranty of
15     # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16     # GNU General Public License for more details.
17     #
18     # You should have received a copy of the GNU General Public License
19     # along with this program; if not, write to the Free Software
20     # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21     #
22    
23 tdb 1.1 #-----------------------------------------------------------------
24     # i-scream host plugin - top parsing (cpu, proc, mem, & swap)
25 tdb 1.2 # $Author: tdb $
26 tdb 1.7 # $Id: i-scream_top.pl,v 1.6 2002/05/21 16:47:12 tdb Exp $
27 tdb 1.1 #
28     # A short perl script to get the cpu loads, process details,
29     # memory usage and swap usage by parsing top.
30     #
31     # nb. this is a rather 'heavy' process to run :(
32     #-----------------------------------------------------------------
33    
34    
35     $| = 1;
36    
37    
38     # You'd be silly not to use this ;)
39     use strict;
40    
41 tdb 1.2 # Get the OS type from the args, or try towork it out
42     my($ostype) = $ARGV[0];
43     $ostype = `uname -s` if not defined $ostype;
44     chomp($ostype);
45 tdb 1.1
46     # Decide which paths we should use.
47     my($topbin);
48     my($sysctlbin);
49     if ($ostype eq "SunOS") {
50     # covers: Solaris 7/8
51     $topbin = "/usr/local/sbin/top -d2 -s1 0";
52     }
53     elsif ($ostype eq "Linux") {
54     # covers: Debian r2.2
55 tdb 1.4 $topbin = "/usr/bin/top -d1 -n2 -b";
56 tdb 1.1 }
57     elsif ($ostype eq "FreeBSD") {
58     # covers: FreeBSD 4.X
59     $topbin = "/usr/bin/top -d2 -s1 0";
60     $sysctlbin = "/sbin/sysctl";
61     }
62     else {
63     print "i-scream_top.pl Error: Unable to identify system type - \"$ostype\".\n";
64     print "\"uname -s\" does not report one of the following known types;\n";
65     print " SunOS, Linux, FreeBSD\n";
66     exit(1);
67     }
68    
69     # Run the following components: -
70     &include_top();
71    
72     # End the program normally.
73     exit(0);
74    
75    
76    
77    
78     # sub to print pairs of data, separated by a single space character.
79     # If the second argument is undefined, then the pair is still printed,
80     # however, the value shall be displayed as the the 'default' value
81     # if the passed value was undefined.
82     sub print_pair($$$) {
83     my($default, $name, $value) = @_;
84    
85     if (!defined $value) {
86     $value = $default;
87     }
88    
89     # Remove the trailing linefeed if we've not already done so.
90     chomp($value);
91    
92     # print the pair of data with a space inbetween.
93     print "$name $value\n";
94     }
95    
96    
97     # sub to run a series of regexps on the output of 'top' to
98     # gather various machine statistics.
99     sub include_top() {
100    
101     # Find out some numbers from top.
102     my(@top) = `$topbin`;
103     my($top) = join(" ", @top);
104     $top =~ s/\n/ /g;
105    
106     if($ostype eq "SunOS") {
107     &print_pair(0, "packet.processes.total", $top =~ /([0-9]+?) processes:/);
108     &print_pair(0, "packet.processes.sleeping", $top =~ /([0-9]+?) sleeping/);
109     &print_pair(0, "packet.processes.zombie", $top =~ /([0-9]+?) zombie/);
110     &print_pair(0, "packet.processes.stopped", $top =~ /([0-9]+?) stopped/);
111     &print_pair(0, "packet.processes.cpu", $top =~ /([0-9]+?)\s*on cpu/);
112     &print_pair(0, "packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
113     &print_pair(0, "packet.cpu.user", $top =~ /([^\s]+?)% user/);
114     &print_pair(0, "packet.cpu.kernel", $top =~ /([^\s]+?)% kernel/);
115     &print_pair(0, "packet.cpu.iowait", $top =~ /([^\s]+?)% iowait/);
116     &print_pair(0, "packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
117    
118     # The following need to be specified in megabytes.
119     # If they are preceeded by a G, then multiply by 1024.
120    
121     $top =~ /([0-9]+?)([KMG]) real/;
122     my($real) = $1;
123     $real*=1024 if $2 eq "G";
124     $real/=1024 if $2 eq "K";
125     &print_pair(0, "packet.memory.total", $real);
126    
127     $top =~ /([0-9]+?)([KMG]) free/;
128     my($free) = $1;
129     $free*=1024 if $2 eq "G";
130     $free/=1024 if $2 eq "K";
131     &print_pair(0, "packet.memory.free", $free);
132    
133     $top =~ /([0-9]+?)([KMG]) swap in use/;
134     my($swap_in_use) = $1;
135     $swap_in_use*=1024 if $2 eq "G";
136     $swap_in_use/=1024 if $2 eq "K";
137     # DO NOT print this one out... save it for in a moment...
138    
139     $top =~ /([0-9]+?)([KMG]) swap free/;
140     my($swap_free) = $1;
141     $swap_free*=1024 if $2 eq "G";
142     $swap_free/=1024 if $2 eq "K";
143     &print_pair(0, "packet.swap.free", $swap_free);
144    
145     &print_pair(0, "packet.swap.total", $swap_free + $swap_in_use);
146     }
147     elsif ($ostype eq "FreeBSD") {
148     &print_pair(0, "packet.processes.total", $top =~ /([0-9]+?) processes:/);
149     &print_pair(0, "packet.processes.sleeping", $top =~ /([0-9]+?) sleeping/);
150     &print_pair(0, "packet.processes.zombie", $top =~ /([0-9]+?) zombie/);
151     &print_pair(0, "packet.processes.stopped", $top =~ /([0-9]+?) stopped/);
152     &print_pair(0, "packet.processes.cpu", $top =~ /([0-9]+?)\s*running/);
153     &print_pair(0, "packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
154     &print_pair(0, "packet.cpu.kernel", $top =~ /([^\s]+?)% system/);
155     &print_pair(0, "packet.cpu.iowait", $top =~ /([^\s]+?)% interrupt/);
156     &print_pair(0, "packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
157    
158     # FreeBSD is a bit different, we need to get user and nice.
159     my($user) = 0;
160     if($top =~ /([^\s]+?)% user/) { $user += $1; }
161     if($top =~ /([^\s]+?)% nice/) { $user += $1; }
162     &print_pair(0, "packet.cpu.user", $user);
163    
164     # The following need to be specified in megabytes.
165     # If they are preceeded by a G, then multiply by 1024.
166    
167     # get RAM slightly differently
168     my($real) = `$sysctlbin -n hw.physmem`;
169 tdb 1.3 my($v_free_count) = `$sysctlbin -n vm.stats.vm.v_free_count`;
170     my($v_page_size) = `$sysctlbin -n vm.stats.vm.v_page_size`;
171     my($free) = $v_free_count * $v_page_size;
172 tdb 1.1
173     # turn bytes to megabytes
174     $real = ($real / 1024) / 1024;
175     $free = ($free / 1024) / 1024;
176    
177     &print_pair(0, "packet.memory.total", $real);
178     &print_pair(0, "packet.memory.free", $free);
179    
180     $top =~ /Swap: ([0-9]+?)([KMG]) Total/;
181     my($swap_total) = $1;
182     $swap_total*=1024 if $2 eq "G";
183     $swap_total/=1024 if $2 eq "K";
184     &print_pair(0, "packet.swap.total", $swap_total);
185    
186     $top =~ /Swap:.*, ([0-9]+?)([KMG]) Free/;
187     my($swap_free) = $1;
188     $swap_free*=1024 if $2 eq "G";
189     $swap_free/=1024 if $2 eq "K";
190     &print_pair(0, "packet.swap.free", $swap_free);
191     }
192     elsif ($ostype eq "Linux") {
193     my ($top) = "";
194     foreach my $line (@top) {
195     $top = $line . $top;
196     }
197     $top =~ s/\n/ /g;
198    
199     &print_pair(0, "packet.processes.total", $top =~ /([0-9]+?) processes:/);
200     &print_pair(0, "packet.processes.sleeping", $top =~ /([0-9]+?) sleeping/);
201     &print_pair(0, "packet.processes.zombie", $top =~ /([0-9]+?) zombie/);
202     &print_pair(0, "packet.processes.stopped", $top =~ /([0-9]+?) stopped/);
203     &print_pair(0, "packet.processes.cpu", $top =~ /([0-9]+?)\s*running/);
204     &print_pair(0, "packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
205     &print_pair(0, "packet.cpu.kernel", $top =~ /([^\s]+?)% system/);
206     &print_pair(0, "packet.cpu.iowait", $top =~ /([^\s]+?)% interrupt/);
207     &print_pair(0, "packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
208    
209     # Linux is a bit different, we need to get user and nice.
210     my($user) = 0;
211     if($top =~ /([^\s]+?)% user/) { $user += $1; }
212     if($top =~ /([^\s]+?)% nice/) { $user += $1; }
213     &print_pair(0, "packet.cpu.user", $user);
214    
215     # The following need to be specified in megabytes.
216     # If they are preceeded by a G, then multiply by 1024.
217    
218     $top =~ /Mem:.*?([0-9]+)([KMG])\s+(av|total)/;
219     my($real) = $1;
220     $real*=1024 if $2 eq "G";
221     $real/=1024 if $2 eq "K";
222     &print_pair(0, "packet.memory.total", int($real));
223    
224     $top =~ /Mem:.*?([0-9]+)([KMG])\s+free/;
225     my($free) = $1;
226     $free*=1024 if $2 eq "G";
227     $free/=1024 if $2 eq "K";
228     &print_pair(0, "packet.memory.free", int($free));
229    
230     $top =~ /Swap:.*?([0-9]+)([KMG])\s+(av|total)/;
231     my($swap_total) = $1;
232     $swap_total*=1024 if $2 eq "G";
233     $swap_total/=1024 if $2 eq "K";
234     &print_pair(0, "packet.swap.total", int($swap_total));
235    
236     $top =~ /Swap:.*?([0-9]+)([KMG])\s+free/;
237     my($swap_free) = $1;
238     $swap_free*=1024 if $2 eq "G";
239     $swap_free/=1024 if $2 eq "K";
240     &print_pair(0, "packet.swap.free", int($swap_free));
241     }
242     else {
243     # we could have some catchall here
244     # but as it stands this means we'll just skip top stuff
245     # for unknown systems
246     }
247     }