ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/generic/statgrab.pl
Revision: 1.10
Committed: Mon Jan 22 17:17:48 2001 UTC (23 years, 9 months ago) by pjm2
Content type: text/plain
Branch: MAIN
Changes since 1.9: +21 -7 lines
Log Message:
Values in gigabytes are now reported in megabytes.

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