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.1
Committed: Mon Nov 19 21:42:11 2001 UTC (24 years, 1 month ago) by tdb
Content type: text/plain
Branch: MAIN
Log Message:
Initial set of i-scream ihost plugins. These are derived completely from
statgrab, and offer no new features over it. They do, however, allow for
parts of this code to be replaced in other languages if required.
Only a few minor changes were made, mainly for efficiency, commenting, and
some changes of chop to chomp :)

File Contents

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