ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/generic/statgrab.pl
Revision: 1.7
Committed: Mon Jan 22 16:28:57 2001 UTC (23 years, 10 months ago) by pjm2
Content type: text/plain
Branch: MAIN
Changes since 1.6: +11 -14 lines
Log Message:
Now using df -ak for obtaining disk information.  This provides a few more
details and the formatting seems to be a lot more consistent across
various *nix platforms/versions of df.x

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.7 # $Id: statgrab.pl,v 1.6 2001/01/22 10:03:30 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.7 print 'version statgrab.pl $Revision: 1.6 $';
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.1 sub print_pair($$) {
53     my($name, $value) = @_;
54    
55     if (!defined $value) {
56     $value = "unknown";
57     }
58    
59     # Remove the trailing linefeed if we've not already done so.
60     chomp($value);
61    
62     # print the pair of data with a space inbetween.
63     print "$name $value\n";
64     }
65    
66    
67 pjm2 1.5 # sub to find out disk partition information, if it exists.
68     sub include_disk() {
69    
70     # Run the df program.
71 pjm2 1.7 my(@df) = `df -ak`;
72 pjm2 1.5
73     # Go through each line of the program, looking for each thing we want.
74     my($partition_no) = 0;
75     for (my($i) = 0; $i < $#df; $i++) {
76     my($line) = $df[$i];
77 pjm2 1.7 $line =~ /^(\/[^\s]*)\s*([0-9]*)\s*([0-9]*)\s*([0-9]*)\s*[^\s]*\s*(\/[^\s]*)\s*/;
78 pjm2 1.5 # $4 will not match unless everything before it does...
79 pjm2 1.7 if (defined $5) {
80     my ($filesystem, $kbytes, $used, $avail, $mount) = ($1, $2, $3, $4, $5);
81     &print_pair("packet.disk.p$partition_no.attributes.name", $filesystem);
82     &print_pair("packet.disk.p$partition_no.attributes.kbytes", $kbytes);
83     &print_pair("packet.disk.p$partition_no.attributes.used", $used);
84     &print_pair("packet.disk.p$partition_no.attributes.avail", $avail);
85     &print_pair("packet.disk.p$partition_no.attributes.mount", $mount);
86 pjm2 1.5 ++$partition_no;
87     }
88     }
89    
90     }
91    
92     # sub to find out the list of all (non-unique) usernames logged
93     # in to the machine and how many their are. (not
94 pjm2 1.1 sub include_users() {
95    
96     # Find out all users on this machine.
97     my($users) = `users`;
98     my(@users) = split(/\s+/, $users);
99    
100     my($users_count) = $#users + 1;
101     my($users_list) = $users;
102    
103     &print_pair("packet.users.count", $users_count);
104     &print_pair("packet.users.list", $users_list);
105     }
106    
107    
108 pjm2 1.5 # sub to run a series of regexps on the output of 'top' to
109     # gather various machine statistics.
110 pjm2 1.1 sub include_top() {
111    
112     # Find out some numbers from top.
113     my(@top) = `top -d2 -s1 0`;
114     my($top) = join(" ", @top);
115     $top =~ s/\n//g;
116    
117     &print_pair("packet.load.load1", $top =~ /load averages:\s*([^\s]+?),/);
118     &print_pair("packet.load.load5", $top =~ /load averages:\s*.+?,\s*([^\s]+?),/);
119     &print_pair("packet.load.load15", $top =~ /load averages:\s*.+?,\s*.+?,\s*([^\s]+?)\s*/);
120     &print_pair("packet.processes.total", $top =~ /([^\s]+?) processes:/);
121     &print_pair("packet.processes.sleeping", $top =~ / ([^\s]+?) sleeping/);
122     &print_pair("packet.processes.zombie", $top =~ / ([^\s]+?) zombie/);
123     &print_pair("packet.processes.stopped", $top =~ / ([^\s]+?) stopped/);
124     &print_pair("packet.processes.cpu", $top =~ /([^\s]+?)\s*on cpu/);
125     &print_pair("packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
126     &print_pair("packet.cpu.user", $top =~ /([^\s]+?)% user/);
127     &print_pair("packet.cpu.kernel", $top =~ /([^\s]+?)% kernel/);
128     &print_pair("packet.cpu.iowait", $top =~ /([^\s]+?)% iowait/);
129     &print_pair("packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
130     &print_pair("packet.memory.real", $top =~ /([^\s]+?)[MG] real/);
131     &print_pair("packet.memory.free", $top =~ /([^\s]+?)[MG] free/);
132     &print_pair("packet.memory.swap_in_use", $top =~ /([^\s]+?)[MG] swap in use/);
133     &print_pair("packet.memory.swap_free", $top =~ /([^\s]+?)[MG] swap free/);
134    
135 tdb 1.2 }
136    
137 pjm2 1.5 # sub to get details of the machine's operating system.
138 tdb 1.2 sub include_osver() {
139    
140     # Find out details about the operating system
141 pjm2 1.5 # If these values remain undefined, then the print_pair
142     # function shall show the value to be the string "unknown".
143 tdb 1.2 my($os_name) = `uname -s`;
144     my($os_release) = `uname -r`;
145     my($os_platform) = `uname -m`;
146     my($os_sysname) = `uname -n`;
147     my($os_version) = `uname -v`;
148    
149     &print_pair("packet.os.name", $os_name);
150     &print_pair("packet.os.release", $os_release);
151     &print_pair("packet.os.platform", $os_platform);
152     &print_pair("packet.os.sysname", $os_sysname);
153     &print_pair("packet.os.version", $os_version);
154    
155 pjm2 1.1 }