ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/generic/statgrab.pl
Revision: 1.13
Committed: Mon Jan 22 23:21:34 2001 UTC (23 years, 10 months ago) by tdb
Content type: text/plain
Branch: MAIN
Changes since 1.12: +16 -10 lines
Log Message: 
Moved the location of binaries to the top of the file. This will make moving
to other operating systems a touch easier.

File Contents

# User Rev Content
1 pjm2 1.1 #!/usr/bin/perl -w
2    
3     #-----------------------------------------------------------------
4     # Machine statistics grabber
5 pjm2 1.6 # $Author: pjm2 $
6 tdb 1.13 # $Id: statgrab.pl,v 1.12 2001/01/22 17:29:28 pjm2 Exp $
7 pjm2 1.1 #
8     # A Perl script to return various information about a host machine
9     # by examining the output of some common Unix/Linux commands.
10     # This is a stopgap to act as a generic way of collecting the
11     # data. It is perhaps more reliable than the current Java host
12     # at doing this and it can obviously be used by a C++ program as
13     # well until the C++ host is ready to find the information out
14     # itself.
15     #-----------------------------------------------------------------
16    
17    
18     $| = 1;
19    
20    
21     # You'd be silly not to use this ;)
22     use strict;
23    
24 tdb 1.13 # Path's
25     my($topbin) = "/usr/local/sbin/top";
26     my($dfbin) = "/usr/bin/df";
27     my($usersbin) = "/usr/ucb/users";
28     my($unamebin) = "/usr/bin/uname";
29    
30 pjm2 1.6 # Run the following components: -
31 tdb 1.3 &print_ident();
32 tdb 1.2 &include_osver();
33 pjm2 1.1 &include_users();
34     &include_top();
35 pjm2 1.5 &include_disk();
36 pjm2 1.1
37 pjm2 1.6 # End the program normally.
38 pjm2 1.1 exit(0);
39    
40    
41    
42 pjm2 1.6
43    
44    
45    
46    
47 tdb 1.3 # prints out an identifier for this version of statgrab.pl
48     # the host should check this when reading data
49     # means the host must be checked and updated to work with newer versions.
50     sub print_ident() {
51 tdb 1.13 print 'version statgrab.pl $Revision: 1.12 $';
52 tdb 1.3 print "\n";
53     }
54 pjm2 1.1
55     # sub to print pairs of data, separated by a single space character.
56 pjm2 1.5 # If the second argument is undefined, then the pair is still printed,
57     # however, the value shall be displayed as the string "unknown".
58 pjm2 1.8 # If $type is non-zero, then "0" is printed instead of "unknown".
59     sub print_pair($$$) {
60     my($type, $name, $value) = @_;
61 pjm2 1.1
62     if (!defined $value) {
63 pjm2 1.8 if ($type) {
64 pjm2 1.9 $value = "0.00";
65 pjm2 1.8 }
66     else {
67     $value = "unknown";
68     }
69 pjm2 1.1 }
70    
71     # Remove the trailing linefeed if we've not already done so.
72     chomp($value);
73    
74     # print the pair of data with a space inbetween.
75     print "$name $value\n";
76     }
77    
78    
79 pjm2 1.5 # sub to find out disk partition information, if it exists.
80     sub include_disk() {
81    
82     # Run the df program.
83 tdb 1.13 my(@df) = `$dfbin -ak`;
84 pjm2 1.5
85     # Go through each line of the program, looking for each thing we want.
86     my($partition_no) = 0;
87     for (my($i) = 0; $i < $#df; $i++) {
88     my($line) = $df[$i];
89 pjm2 1.7 $line =~ /^(\/[^\s]*)\s*([0-9]*)\s*([0-9]*)\s*([0-9]*)\s*[^\s]*\s*(\/[^\s]*)\s*/;
90 pjm2 1.5 # $4 will not match unless everything before it does...
91 pjm2 1.7 if (defined $5) {
92     my ($filesystem, $kbytes, $used, $avail, $mount) = ($1, $2, $3, $4, $5);
93 pjm2 1.8 &print_pair(0, "packet.disk.p$partition_no.attributes.name", $filesystem);
94     &print_pair(1, "packet.disk.p$partition_no.attributes.kbytes", $kbytes);
95     &print_pair(1, "packet.disk.p$partition_no.attributes.used", $used);
96     &print_pair(1, "packet.disk.p$partition_no.attributes.avail", $avail);
97     &print_pair(0, "packet.disk.p$partition_no.attributes.mount", $mount);
98 pjm2 1.5 ++$partition_no;
99     }
100     }
101    
102     }
103    
104     # sub to find out the list of all (non-unique) usernames logged
105     # in to the machine and how many their are. (not
106 pjm2 1.1 sub include_users() {
107    
108     # Find out all users on this machine.
109 tdb 1.13 my($users) = `$usersbin`;
110 pjm2 1.1 my(@users) = split(/\s+/, $users);
111    
112     my($users_count) = $#users + 1;
113     my($users_list) = $users;
114    
115 pjm2 1.8 &print_pair(1, "packet.users.count", $users_count);
116     &print_pair(0, "packet.users.list", $users_list);
117 pjm2 1.1 }
118    
119    
120 pjm2 1.5 # sub to run a series of regexps on the output of 'top' to
121     # gather various machine statistics.
122 pjm2 1.1 sub include_top() {
123    
124     # Find out some numbers from top.
125 tdb 1.13 my(@top) = `$topbin -d2 -s1 0`;
126 pjm2 1.1 my($top) = join(" ", @top);
127     $top =~ s/\n//g;
128    
129 pjm2 1.8 &print_pair(1, "packet.load.load1", $top =~ /load averages:\s*([^\s]+?),/);
130     &print_pair(1, "packet.load.load5", $top =~ /load averages:\s*.+?,\s*([^\s]+?),/);
131     &print_pair(1, "packet.load.load15", $top =~ /load averages:\s*.+?,\s*.+?,\s*([^\s]+?)\s*/);
132     &print_pair(1, "packet.processes.total", $top =~ /([^\s]+?) processes:/);
133     &print_pair(1, "packet.processes.sleeping", $top =~ / ([^\s]+?) sleeping/);
134     &print_pair(1, "packet.processes.zombie", $top =~ / ([^\s]+?) zombie/);
135     &print_pair(1, "packet.processes.stopped", $top =~ / ([^\s]+?) stopped/);
136     &print_pair(1, "packet.processes.cpu", $top =~ /([^\s]+?)\s*on cpu/);
137     &print_pair(1, "packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
138     &print_pair(1, "packet.cpu.user", $top =~ /([^\s]+?)% user/);
139     &print_pair(1, "packet.cpu.kernel", $top =~ /([^\s]+?)% kernel/);
140     &print_pair(1, "packet.cpu.iowait", $top =~ /([^\s]+?)% iowait/);
141     &print_pair(1, "packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
142 pjm2 1.10
143     # The following need to be specified in megabytes.
144     # If they are preceeded by a G, then multiply by 1024.
145    
146     $top =~ /([^\s]+?)([MG]) real/;
147 pjm2 1.11 my($real) = $1;
148     $real*=1024 if $2 eq "G";
149 pjm2 1.10 &print_pair(1, "packet.memory.real", $real);
150    
151     $top =~ /([^\s]+?)([MG]) free/;
152 pjm2 1.11 my($free) = $1;
153     $free*=1024 if $2 eq "G";
154 pjm2 1.10 &print_pair(1, "packet.memory.free", $free);
155    
156     $top =~ /([^\s]+?)([MG]) swap in use/;
157 pjm2 1.11 my($swap_in_use) = $1;
158     $swap_in_use*=1024 if $2 eq "G";
159 pjm2 1.12 # DO NOT print this one out... save it for in a moment...
160 pjm2 1.10
161     $top =~ /([^\s]+?)([MG]) swap free/;
162 pjm2 1.11 my($swap_free) = $1;
163     $swap_free*=1024 if $2 eq "G";
164 pjm2 1.10 &print_pair(1, "packet.memory.swap_free", $swap_free);
165 pjm2 1.12
166     # AJ requested total swap instead of swap_in_use, so here we go!
167     &print_pair(1, "packet.memory.swap_total", $swap_free + $swap_in_use);
168 tdb 1.2 }
169    
170 pjm2 1.5 # sub to get details of the machine's operating system.
171 tdb 1.2 sub include_osver() {
172    
173     # Find out details about the operating system
174 pjm2 1.5 # If these values remain undefined, then the print_pair
175     # function shall show the value to be the string "unknown".
176 tdb 1.13 my($os_name) = `$unamebin -s`;
177     my($os_release) = `$unamebin -r`;
178     my($os_platform) = `$unamebin -m`;
179     my($os_sysname) = `$unamebin -n`;
180     my($os_version) = `$unamebin -v`;
181 tdb 1.2
182 pjm2 1.8 &print_pair(0, "packet.os.name", $os_name);
183     &print_pair(0, "packet.os.release", $os_release);
184     &print_pair(0, "packet.os.platform", $os_platform);
185     &print_pair(0, "packet.os.sysname", $os_sysname);
186     &print_pair(0, "packet.os.version", $os_version);
187 tdb 1.2
188 pjm2 1.1 }