ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/generic/statgrab.pl
Revision: 1.4
Committed: Mon Jan 22 04:09:41 2001 UTC (23 years, 8 months ago) by tdb
Content type: text/plain
Branch: MAIN
Changes since 1.3: +2 -2 lines
Log Message:
Just changed the format of the version tag, so it's the same as the data.

File Contents

# User Rev Content
1 pjm2 1.1 #!/usr/bin/perl -w
2    
3     #-----------------------------------------------------------------
4     # Machine statistics grabber
5 tdb 1.3 # $Author: tdb1 $
6 tdb 1.4 # $Id: statgrab.pl,v 1.3 2001/01/20 20:04:46 tdb1 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.3 &print_ident();
25 tdb 1.2 &include_osver();
26 pjm2 1.1 &include_users();
27     &include_top();
28    
29     exit(0);
30    
31    
32    
33 tdb 1.3 # prints out an identifier for this version of statgrab.pl
34     # the host should check this when reading data
35     # means the host must be checked and updated to work with newer versions.
36     sub print_ident() {
37 tdb 1.4 print 'version statgrab.pl $Revision: 1.3 $';
38 tdb 1.3 print "\n";
39     }
40 pjm2 1.1
41     # sub to print pairs of data, separated by a single space character.
42     sub print_pair($$) {
43     my($name, $value) = @_;
44    
45     if (!defined $value) {
46     $value = "unknown";
47     }
48    
49     # Remove the trailing linefeed if we've not already done so.
50     chomp($value);
51    
52     # print the pair of data with a space inbetween.
53     print "$name $value\n";
54     }
55    
56    
57     sub include_users() {
58    
59     # Find out all users on this machine.
60     my($users) = `users`;
61     my(@users) = split(/\s+/, $users);
62    
63     my($users_count) = $#users + 1;
64     my($users_list) = $users;
65    
66     &print_pair("packet.users.count", $users_count);
67     &print_pair("packet.users.list", $users_list);
68     }
69    
70    
71     sub include_top() {
72    
73     # Find out some numbers from top.
74     my(@top) = `top -d2 -s1 0`;
75     my($top) = join(" ", @top);
76     $top =~ s/\n//g;
77    
78     &print_pair("packet.load.load1", $top =~ /load averages:\s*([^\s]+?),/);
79     &print_pair("packet.load.load5", $top =~ /load averages:\s*.+?,\s*([^\s]+?),/);
80     &print_pair("packet.load.load15", $top =~ /load averages:\s*.+?,\s*.+?,\s*([^\s]+?)\s*/);
81     &print_pair("packet.processes.total", $top =~ /([^\s]+?) processes:/);
82     &print_pair("packet.processes.sleeping", $top =~ / ([^\s]+?) sleeping/);
83     &print_pair("packet.processes.zombie", $top =~ / ([^\s]+?) zombie/);
84     &print_pair("packet.processes.stopped", $top =~ / ([^\s]+?) stopped/);
85     &print_pair("packet.processes.cpu", $top =~ /([^\s]+?)\s*on cpu/);
86     &print_pair("packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
87     &print_pair("packet.cpu.user", $top =~ /([^\s]+?)% user/);
88     &print_pair("packet.cpu.kernel", $top =~ /([^\s]+?)% kernel/);
89     &print_pair("packet.cpu.iowait", $top =~ /([^\s]+?)% iowait/);
90     &print_pair("packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
91     &print_pair("packet.memory.real", $top =~ /([^\s]+?)[MG] real/);
92     &print_pair("packet.memory.free", $top =~ /([^\s]+?)[MG] free/);
93     &print_pair("packet.memory.swap_in_use", $top =~ /([^\s]+?)[MG] swap in use/);
94     &print_pair("packet.memory.swap_free", $top =~ /([^\s]+?)[MG] swap free/);
95    
96 tdb 1.2 }
97    
98     sub include_osver() {
99    
100     # Find out details about the operating system
101     my($os_name) = `uname -s`;
102     my($os_release) = `uname -r`;
103     my($os_platform) = `uname -m`;
104     my($os_sysname) = `uname -n`;
105     my($os_version) = `uname -v`;
106    
107     &print_pair("packet.os.name", $os_name);
108     &print_pair("packet.os.release", $os_release);
109     &print_pair("packet.os.platform", $os_platform);
110     &print_pair("packet.os.sysname", $os_sysname);
111     &print_pair("packet.os.version", $os_version);
112    
113 pjm2 1.1 }