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
Error occurred while calculating annotation data.
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

# Content
1 #!/usr/bin/perl -w
2
3 #
4 # i-scream central monitoring system
5 # http://www.i-scream.org.uk
6 # 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 #-----------------------------------------------------------------
24 # i-scream host plugin - top parsing (cpu, proc, mem, & swap)
25 # $Author: tdb $
26 # $Id: i-scream_top.pl,v 1.6 2002/05/21 16:47:12 tdb Exp $
27 #
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 # 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
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 $topbin = "/usr/bin/top -d1 -n2 -b";
56 }
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 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
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 }