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 (22 years, 11 months 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

# User Rev Content
1 tdb 1.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     }