ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/host/generic/statgrab.pl
(Generate patch)

Comparing projects/cms/source/host/generic/statgrab.pl (file contents):
Revision 1.3 by tdb, Sat Jan 20 20:04:46 2001 UTC vs.
Revision 1.11 by pjm2, Mon Jan 22 17:23:25 2001 UTC

# Line 21 | Line 21 | $| = 1;
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 '# statgrab.pl $Revision$';
45 >    print 'version statgrab.pl $Revision$';
46      print "\n";
47   }
48  
49   # sub to print pairs of data, separated by a single space character.
50 < sub print_pair($$) {
51 <    my($name, $value) = @_;
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 > # If $type is non-zero, then "0" is printed instead of "unknown".
53 > sub print_pair($$$) {
54 >    my($type, $name, $value) = @_;
55  
56      if (!defined $value) {
57 <        $value = "unknown";
57 >        if ($type) {
58 >            $value = "0.00";
59 >        }
60 >        else {
61 >            $value = "unknown";
62 >        }
63      }
64  
65      # Remove the trailing linefeed if we've not already done so.
# Line 54 | Line 70 | sub print_pair($$) {
70   }
71  
72  
73 + # sub to find out disk partition information, if it exists.
74 + sub include_disk() {
75 +    
76 +    # Run the df program.
77 +    my(@df) = `df -ak`;
78 +
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 +        $line =~ /^(\/[^\s]*)\s*([0-9]*)\s*([0-9]*)\s*([0-9]*)\s*[^\s]*\s*(\/[^\s]*)\s*/;
84 +        # $4 will not match unless everything before it does...
85 +        if (defined $5) {
86 +            my ($filesystem, $kbytes, $used, $avail, $mount) = ($1, $2, $3, $4, $5);
87 +            &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 +            ++$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   sub include_users() {
101  
102      # Find out all users on this machine.
# Line 63 | Line 106 | sub include_users() {
106      my($users_count) = $#users + 1;
107      my($users_list) = $users;
108  
109 <    &print_pair("packet.users.count", $users_count);
110 <    &print_pair("packet.users.list", $users_list);
109 >    &print_pair(1, "packet.users.count", $users_count);
110 >    &print_pair(0, "packet.users.list", $users_list);
111   }
112  
113  
114 + # sub to run a series of regexps on the output of 'top' to
115 + # gather various machine statistics.
116   sub include_top() {
117  
118      # Find out some numbers from top.
# Line 75 | Line 120 | sub include_top() {
120      my($top) = join(" ", @top);
121      $top =~ s/\n//g;
122  
123 <    &print_pair("packet.load.load1", $top =~ /load averages:\s*([^\s]+?),/);
124 <    &print_pair("packet.load.load5", $top =~ /load averages:\s*.+?,\s*([^\s]+?),/);
125 <    &print_pair("packet.load.load15", $top =~ /load averages:\s*.+?,\s*.+?,\s*([^\s]+?)\s*/);
126 <    &print_pair("packet.processes.total", $top =~ /([^\s]+?) processes:/);
127 <    &print_pair("packet.processes.sleeping", $top =~ / ([^\s]+?) sleeping/);
128 <    &print_pair("packet.processes.zombie", $top =~ / ([^\s]+?) zombie/);
129 <    &print_pair("packet.processes.stopped", $top =~ / ([^\s]+?) stopped/);
130 <    &print_pair("packet.processes.cpu", $top =~ /([^\s]+?)\s*on cpu/);
131 <    &print_pair("packet.cpu.idle", $top =~ /([^\s]+?)% idle/);
132 <    &print_pair("packet.cpu.user", $top =~ /([^\s]+?)% user/);
133 <    &print_pair("packet.cpu.kernel", $top =~ /([^\s]+?)% kernel/);
134 <    &print_pair("packet.cpu.iowait", $top =~ /([^\s]+?)% iowait/);
135 <    &print_pair("packet.cpu.swap", $top =~ /([^\s]+?)% swap/);
136 <    &print_pair("packet.memory.real", $top =~ /([^\s]+?)[MG] real/);
137 <    &print_pair("packet.memory.free", $top =~ /([^\s]+?)[MG] free/);
138 <    &print_pair("packet.memory.swap_in_use", $top =~ /([^\s]+?)[MG] swap in use/);
139 <    &print_pair("packet.memory.swap_free", $top =~ /([^\s]+?)[MG] swap free/);
140 <    
123 >    &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 >
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;
142 >    $real*=1024 if $2 eq "G";
143 >    &print_pair(1, "packet.memory.real", $real);
144 >
145 >    $top =~ /([^\s]+?)([MG]) free/;
146 >    my($free) = $1;
147 >    $free*=1024 if $2 eq "G";
148 >    &print_pair(1, "packet.memory.free", $free);
149 >
150 >    $top =~ /([^\s]+?)([MG]) swap in use/;
151 >    my($swap_in_use) = $1;
152 >    $swap_in_use*=1024 if $2 eq "G";
153 >    &print_pair(1, "packet.memory.swap_in_use", $swap_in_use);
154 >
155 >    $top =~ /([^\s]+?)([MG]) swap free/;
156 >    my($swap_free) = $1;
157 >    $swap_free*=1024 if $2 eq "G";
158 >    &print_pair(1, "packet.memory.swap_free", $swap_free);
159   }
160  
161 + # sub to get details of the machine's operating system.
162   sub include_osver() {
163  
164      # Find out details about the operating system
165 +    # If these values remain undefined, then the print_pair
166 +    # function shall show the value to be the string "unknown".
167      my($os_name) = `uname -s`;
168      my($os_release) = `uname -r`;
169      my($os_platform) = `uname -m`;
170      my($os_sysname) = `uname -n`;
171      my($os_version) = `uname -v`;
172  
173 <    &print_pair("packet.os.name", $os_name);
174 <    &print_pair("packet.os.release", $os_release);
175 <    &print_pair("packet.os.platform", $os_platform);
176 <    &print_pair("packet.os.sysname", $os_sysname);
177 <    &print_pair("packet.os.version", $os_version);
173 >    &print_pair(0, "packet.os.name", $os_name);
174 >    &print_pair(0, "packet.os.release", $os_release);
175 >    &print_pair(0, "packet.os.platform", $os_platform);
176 >    &print_pair(0, "packet.os.sysname", $os_sysname);
177 >    &print_pair(0, "packet.os.version", $os_version);
178  
179   }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines