host/generic/statgrab.pl

#!/usr/bin/perl -w

#-----------------------------------------------------------------
# Machine statistics grabber
#     $Author: pjm2 $
#     $Id: statgrab.pl,v 1.11 2001/01/22 17:23:25 pjm2 Exp $
#
# A Perl script to return various information about a host machine
# by examining the output of some common Unix/Linux commands.
# This is a stopgap to act as a generic way of collecting the
# data.  It is perhaps more reliable than the current Java host
# at doing this and it can obviously be used by a C++ program as
# well until the C++ host is ready to find the information out
# itself.
#-----------------------------------------------------------------


$| = 1;


# You'd be silly not to use this ;)
use strict;

# Run the following components: -
&print_ident();
&include_osver();
&include_users();
&include_top();
&include_disk();

# End the program normally.
exit(0);


# prints out an identifier for this version of statgrab.pl
# the host should check this when reading data
# means the host must be checked and updated to work with newer versions.
sub print_ident() {
    print 'version statgrab.pl $Revision: 1.11 $';
    print "\n";
}

# sub to print pairs of data, separated by a single space character.
# If the second argument is undefined, then the pair is still printed,
# however, the value shall be displayed as the string "unknown".
# If $type is non-zero, then "0" is printed instead of "unknown".
sub print_pair($$$) {
    my($type, $name, $value) = @_;

    if (!defined $value) {
        if ($type) {
            $value = "0.00";
        }
        else {
            $value = "unknown";
        }
    }

    # Remove the trailing linefeed if we've not already done so.
    chomp($value);

    # print the pair of data with a space inbetween.
    print "$name $value\n";
}


# sub to find out disk partition information, if it exists.
sub include_disk() {
    
    # Run the df program.
    my(@df) = `df -ak`;

    # Go through each line of the program, looking for each thing we want.
    my($partition_no) = 0;
    for (my($i) = 0; $i < $#df; $i++) {
        my($line) = $df[$i];
        $line =~ /^(\/[^\s]*)\s*([0-9]*)\s*([0-9]*)\s*([0-9]*)\s*[^\s]*\s*(\/[^\s]*)\s*/;
        # $4 will not match unless everything before it does...
        if (defined $5) {
            my ($filesystem, $kbytes, $used, $avail, $mount) = ($1, $2, $3, $4, $5);
            &print_pair(0, "packet.disk.p$partition_no.attributes.name", $filesystem);
            &print_pair(1, "packet.disk.p$partition_no.attributes.kbytes", $kbytes);
            &print_pair(1, "packet.disk.p$partition_no.attributes.used", $used);
            &print_pair(1, "packet.disk.p$partition_no.attributes.avail", $avail);
            &print_pair(0, "packet.disk.p$partition_no.attributes.mount", $mount);
            ++$partition_no;
        }
    }
    
}

# sub to find out the list of all (non-unique) usernames logged
# in to the machine and how many their are. (not 
sub include_users() {

    # Find out all users on this machine.
    my($users) = `users`;
    my(@users) = split(/\s+/, $users);

    my($users_count) = $#users + 1;
    my($users_list) = $users;

    &print_pair(1, "packet.users.count", $users_count);
    &print_pair(0, "packet.users.list", $users_list);
}


# sub to run a series of regexps on the output of 'top' to
# gather various machine statistics.
sub include_top() {

    # Find out some numbers from top.
    my(@top) = `top -d2 -s1 0`;
    my($top) = join(" ", @top);
    $top =~ s/\n//g;

    &print_pair(1, "packet.load.load1", $top =~ /load averages:\s*([^\s]+?),/);
    &print_pair(1, "packet.load.load5", $top =~ /load averages:\s*.+?,\s*([^\s]+?),/);
    &print_pair(1, "packet.load.load15", $top =~ /load averages:\s*.+?,\s*.+?,\s*([^\s]+?)\s*/);
    &print_pair(1, "packet.processes.total", $top =~ /([^\s]+?) processes:/);
    &print_pair(1, "packet.processes.sleeping", $top =~ / ([^\s]+?) sleeping/);
    &print_pair(1, "packet.processes.zombie", $top =~ / ([^\s]+?) zombie/);
    &print_pair(1, "packet.processes.stopped", $top =~ / ([^\s]+?) stopped/);
    &print_pair(1, "packet.processes.cpu", $top =~ /([^\s]+?)\s*on cpu/);
    &print_pair(1, "packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
    &print_pair(1, "packet.cpu.user", $top =~ /([^\s]+?)% user/);
    &print_pair(1, "packet.cpu.kernel", $top =~ /([^\s]+?)% kernel/);
    &print_pair(1, "packet.cpu.iowait", $top =~ /([^\s]+?)% iowait/);
    &print_pair(1, "packet.cpu.swap", $top =~ /([^\s]+?)% swap/);

    # The following need to be specified in megabytes.
    # If they are preceeded by a G, then multiply by 1024.   

    $top =~ /([^\s]+?)([MG]) real/;
    my($real) = $1;
    $real*=1024 if $2 eq "G";
    &print_pair(1, "packet.memory.real", $real);

    $top =~ /([^\s]+?)([MG]) free/;
    my($free) = $1;
    $free*=1024 if $2 eq "G";
    &print_pair(1, "packet.memory.free", $free);

    $top =~ /([^\s]+?)([MG]) swap in use/;
    my($swap_in_use) = $1;
    $swap_in_use*=1024 if $2 eq "G";
    # DO NOT print this one out... save it for in a moment...

    $top =~ /([^\s]+?)([MG]) swap free/;
    my($swap_free) = $1;
    $swap_free*=1024 if $2 eq "G";
    &print_pair(1, "packet.memory.swap_free", $swap_free);

    # AJ requested total swap instead of swap_in_use, so here we go!
    &print_pair(1, "packet.memory.swap_total", $swap_free + $swap_in_use);
}

# sub to get details of the machine's operating system.
sub include_osver() {

    # Find out details about the operating system
    # If these values remain undefined, then the print_pair
    # function shall show the value to be the string "unknown".
    my($os_name) = `uname -s`;
    my($os_release) = `uname -r`;
    my($os_platform) = `uname -m`;
    my($os_sysname) = `uname -n`;
    my($os_version) = `uname -v`;

    &print_pair(0, "packet.os.name", $os_name);
    &print_pair(0, "packet.os.release", $os_release);
    &print_pair(0, "packet.os.platform", $os_platform);
    &print_pair(0, "packet.os.sysname", $os_sysname);
    &print_pair(0, "packet.os.version", $os_version);

}
Revision:	1.12
Committed:	Mon Jan 22 17:29:28 2001 UTC (23 years, 8 months ago) by pjm2
Content type:	text/plain
Branch:	MAIN
Changes since 1.11:	+6 -3 lines
Log Message:	For assisting AJ with his client, this version now reports the total swap rather than the swap in use.
#	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.12	# $Id: statgrab.pl,v 1.11 2001/01/22 17:23:25 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.12	print 'version statgrab.pl $Revision: 1.11 $';
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	pjm2	1.11	my($real) = $1;
142			$real*=1024 if $2 eq "G";
143	pjm2	1.10	&print_pair(1, "packet.memory.real", $real);
144
145			$top =~ /([^\s]+?)([MG]) free/;
146	pjm2	1.11	my($free) = $1;
147			$free*=1024 if $2 eq "G";
148	pjm2	1.10	&print_pair(1, "packet.memory.free", $free);
149
150			$top =~ /([^\s]+?)([MG]) swap in use/;
151	pjm2	1.11	my($swap_in_use) = $1;
152			$swap_in_use*=1024 if $2 eq "G";
153	pjm2	1.12	# DO NOT print this one out... save it for in a moment...
154	pjm2	1.10
155			$top =~ /([^\s]+?)([MG]) swap free/;
156	pjm2	1.11	my($swap_free) = $1;
157			$swap_free*=1024 if $2 eq "G";
158	pjm2	1.10	&print_pair(1, "packet.memory.swap_free", $swap_free);
159	pjm2	1.12
160			# AJ requested total swap instead of swap_in_use, so here we go!
161			&print_pair(1, "packet.memory.swap_total", $swap_free + $swap_in_use);
162	tdb	1.2	}
163
164	pjm2	1.5	# sub to get details of the machine's operating system.
165	tdb	1.2	sub include_osver() {
166
167			# Find out details about the operating system
168	pjm2	1.5	# If these values remain undefined, then the print_pair
169			# function shall show the value to be the string "unknown".
170	tdb	1.2	my($os_name) = `uname -s`;
171			my($os_release) = `uname -r`;
172			my($os_platform) = `uname -m`;
173			my($os_sysname) = `uname -n`;
174			my($os_version) = `uname -v`;
175
176	pjm2	1.8	&print_pair(0, "packet.os.name", $os_name);
177			&print_pair(0, "packet.os.release", $os_release);
178			&print_pair(0, "packet.os.platform", $os_platform);
179			&print_pair(0, "packet.os.sysname", $os_sysname);
180			&print_pair(0, "packet.os.version", $os_version);
181	tdb	1.2
182	pjm2	1.1	}