ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/generic/statgrab.pl
Revision: 1.6
Committed: Mon Jan 22 10:03:30 2001 UTC (23 years, 10 months ago) by pjm2
Content type: text/plain
Branch: MAIN
Changes since 1.5: +10 -3 lines
Log Message:
Just minor changes.

File Contents

# Content
1 #!/usr/bin/perl -w
2
3 #-----------------------------------------------------------------
4 # Machine statistics grabber
5 # $Author: pjm2 $
6 # $Id: statgrab.pl,v 1.5 2001/01/22 09:59:09 pjm2 Exp $
7 #
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 # Run the following components: -
25 &print_ident();
26 &include_osver();
27 &include_users();
28 &include_top();
29 &include_disk();
30
31 # End the program normally.
32 exit(0);
33
34
35
36
37
38
39
40
41 # 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 print 'version statgrab.pl $Revision: 1.5 $';
46 print "\n";
47 }
48
49 # sub to print pairs of data, separated by a single space character.
50 # If the second argument is undefined, then the pair is still printed,
51 # however, the value shall be displayed as the string "unknown".
52 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 # sub to find out disk partition information, if it exists.
68 sub include_disk() {
69
70 # Run the df program.
71 my(@df) = `df -a`;
72
73 # Only look for these partitions at the moment.
74 my(@partition_list) = qw{ / /home /var /tmp };
75
76 # Go through each line of the program, looking for each thing we want.
77 my($scan_for) = '('.join('|', @partition_list).')';
78 my($partition_no) = 0;
79 for (my($i) = 0; $i < $#df; $i++) {
80 my($line) = $df[$i];
81 $line =~ /^$scan_for\s*\(([^\s]*)\s*\):\s*([0-9]*)\s*blocks\s*([0-9]*)\s*files/;
82 # $4 will not match unless everything before it does...
83 if (defined $4) {
84 my ($partition, $mounted, $blocks, $files) = ($1, $2, $3, $4);
85 &print_pair("packet.disk.p$partition_no.attributes.name", $partition);
86 &print_pair("packet.disk.p$partition_no.mounted", $mounted);
87 &print_pair("packet.disk.p$partition_no.blocks", $blocks);
88 &print_pair("packet.disk.p$partition_no.name", $files);
89 ++$partition_no;
90 }
91 }
92
93 }
94
95 # sub to find out the list of all (non-unique) usernames logged
96 # in to the machine and how many their are. (not
97 sub include_users() {
98
99 # Find out all users on this machine.
100 my($users) = `users`;
101 my(@users) = split(/\s+/, $users);
102
103 my($users_count) = $#users + 1;
104 my($users_list) = $users;
105
106 &print_pair("packet.users.count", $users_count);
107 &print_pair("packet.users.list", $users_list);
108 }
109
110
111 # sub to run a series of regexps on the output of 'top' to
112 # gather various machine statistics.
113 sub include_top() {
114
115 # Find out some numbers from top.
116 my(@top) = `top -d2 -s1 0`;
117 my($top) = join(" ", @top);
118 $top =~ s/\n//g;
119
120 &print_pair("packet.load.load1", $top =~ /load averages:\s*([^\s]+?),/);
121 &print_pair("packet.load.load5", $top =~ /load averages:\s*.+?,\s*([^\s]+?),/);
122 &print_pair("packet.load.load15", $top =~ /load averages:\s*.+?,\s*.+?,\s*([^\s]+?)\s*/);
123 &print_pair("packet.processes.total", $top =~ /([^\s]+?) processes:/);
124 &print_pair("packet.processes.sleeping", $top =~ / ([^\s]+?) sleeping/);
125 &print_pair("packet.processes.zombie", $top =~ / ([^\s]+?) zombie/);
126 &print_pair("packet.processes.stopped", $top =~ / ([^\s]+?) stopped/);
127 &print_pair("packet.processes.cpu", $top =~ /([^\s]+?)\s*on cpu/);
128 &print_pair("packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
129 &print_pair("packet.cpu.user", $top =~ /([^\s]+?)% user/);
130 &print_pair("packet.cpu.kernel", $top =~ /([^\s]+?)% kernel/);
131 &print_pair("packet.cpu.iowait", $top =~ /([^\s]+?)% iowait/);
132 &print_pair("packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
133 &print_pair("packet.memory.real", $top =~ /([^\s]+?)[MG] real/);
134 &print_pair("packet.memory.free", $top =~ /([^\s]+?)[MG] free/);
135 &print_pair("packet.memory.swap_in_use", $top =~ /([^\s]+?)[MG] swap in use/);
136 &print_pair("packet.memory.swap_free", $top =~ /([^\s]+?)[MG] swap free/);
137
138 }
139
140 # sub to get details of the machine's operating system.
141 sub include_osver() {
142
143 # Find out details about the operating system
144 # If these values remain undefined, then the print_pair
145 # function shall show the value to be the string "unknown".
146 my($os_name) = `uname -s`;
147 my($os_release) = `uname -r`;
148 my($os_platform) = `uname -m`;
149 my($os_sysname) = `uname -n`;
150 my($os_version) = `uname -v`;
151
152 &print_pair("packet.os.name", $os_name);
153 &print_pair("packet.os.release", $os_release);
154 &print_pair("packet.os.platform", $os_platform);
155 &print_pair("packet.os.sysname", $os_sysname);
156 &print_pair("packet.os.version", $os_version);
157
158 }