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.2
Committed: Tue Dec 18 04:07:17 2001 UTC (24 years ago) by tdb
Content type: text/plain
Branch: MAIN
Changes since 1.1: +6 -12 lines
Log Message:
Solaris process accounting made me notice the number of times `uname` was
being called. It was way over the top, especially as it's unlikely to
change during an invocation of ihost :) Before it was run by each plugin
every time they were run - in total 50 times a minute :/ Now, it's run once
by ihost at startup, and that's it. The value read at startup is passed as
a command line argument to each plugin. The plugins can fallback on working
out the ostype using `uname` if they don't get given one on the command
line.

File Contents

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