1 #!/usr/perl5/bin/perl
2 #
3 # CDDL HEADER START
4 #
5 # The contents of this file are subject to the terms of the
6 # Common Development and Distribution License (the "License").
7 # You may not use this file except in compliance with the License.
8 #
9 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10 # or http://www.opensolaris.org/os/licensing.
11 # See the License for the specific language governing permissions
12 # and limitations under the License.
13 #
14 # When distributing Covered Code, include this CDDL HEADER in each
15 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16 # If applicable, add the following below this CDDL HEADER, with the
17 # fields enclosed by brackets "[]" replaced with your own identifying
18 # information: Portions Copyright [yyyy] [name of copyright owner]
19 #
20 # CDDL HEADER END
21 #
22 #
23 #
24 # Copyright 2009 Sun Microsystems, Inc. All rights reserved.
25 # Use is subject to license terms.
26 #
27
28 require 5.8.4;
29 use strict;
30 use warnings;
31 use locale;
32 use Getopt::Std;
33 use POSIX qw(locale_h strftime);
34 use I18N::Langinfo qw(langinfo D_T_FMT);
35 use File::Basename;
36 use Sun::Solaris::Utils qw(textdomain gettext gmatch);
37 use Sun::Solaris::Kstat;
38
39 #
40 # Print an usage message and exit
41 #
42
43 sub usage(@)
44 {
45 my (@msg) = @_;
46 print STDERR basename($0), ": @msg\n" if (@msg);
47 print STDERR gettext(
48 "Usage:\n" .
49 "kstat [ -qlp ] [ -T d|u ] [ -c class ]\n" .
50 " [ -m module ] [ -i instance ] [ -n name ] [ -s statistic ]\n" .
51 " [ interval [ count ] ]\n" .
52 "kstat [ -qlp ] [ -T d|u ] [ -c class ]\n" .
53 " [ module:instance:name:statistic ... ]\n" .
54 " [ interval [ count ] ]\n"
55 );
56 exit(2);
57 }
58
59 #
60 # Print a fatal error message and exit
61 #
62
63 sub error(@)
64 {
65 my (@msg) = @_;
66 print STDERR basename($0), ": @msg\n" if (@msg);
67 exit(1);
68 }
69
70 #
71 # Generate an anonymous sub that can be used to filter the kstats we will
72 # display. The generated sub will take one parameter, the string to match
73 # against. There are three types of input catered for:
74 # 1) Empty string. The returned sub will match anything
75 # 2) String surrounded by '/' characters. This will be interpreted as a
76 # perl RE. If the RE is syntactically incorrect, an error will be
77 # reported.
78 # 3) Any other string. The returned sub will use gmatch(3GEN) to match
79 # against the passed string
80 #
81
82 sub gen_sub($)
83 {
84 my ($pat) = @_;
85
86 # Anything undefined or empty will always match
87 if (! defined($pat) || $pat eq '') {
88 return (sub { 1; });
89
90 # Anything surrounded by '/' is a perl RE
91 } elsif ($pat =~ m!^/[^/]*/$!) {
92 my $sub;
93 if (! ($sub = eval "sub { return(\$_[0] =~ $pat); }" )) {
94 $@ =~ s/\s+at\s+.*\n$//;
95 usage($@);
96 }
97 return ($sub);
98
99 # Otherwise default to gmatch
100 } else {
101 return (sub { return(gmatch($_[0], $pat)); });
102 }
103 }
104
105 #
106 # Main routine of the script
107 #
108
109 # Set message locale
110 setlocale(LC_ALL, "");
111 textdomain(TEXT_DOMAIN);
112
113 # Process command options
114 my (%opt, @matcher);
115 getopts('?qlpT:m:i:n:s:c:', \%opt) || usage();
116 usage() if exists($opt{'?'});
117
118 # Validate -q and -l flags
119 my $quiet = exists($opt{q}) ? 1 : 0;
120 my $list = exists($opt{l}) ? 1 : 0;
121 my $parseable = exists($opt{'p'}) || $list ? 1 : 0;
122 usage(gettext("-q and -l are mutually exclusive")) if ($quiet && $list);
123
124 # Get interval & count if specified
125 my ($interval, $count) = (0, 1);
126 if (@ARGV >= 2 && $ARGV[-2] =~ /^\d+$/ && $ARGV[-1] =~ /^\d+$/) {
127 $count = pop(@ARGV);
128 $interval = pop(@ARGV);
129 usage(gettext("Interval must be an integer >= 1")) if ($interval < 1);
130 usage(gettext("Count must be an integer >= 1")) if ($count < 1);
131 } elsif (@ARGV >= 1 && $ARGV[-1] =~ /^\d+$/) {
132 $interval = pop(@ARGV);
133 $count = -1;
134 usage(gettext("Interval must be an integer >= 1")) if ($interval < 1);
135 }
136
137 # Get timestamp flag
138 my $timestamp;
139 my $timefmt;
140 if ($timestamp = $opt{T}) {
141 if ($timestamp eq "d") {
142 $timefmt = langinfo(D_T_FMT) . "\n";
143 $timestamp = sub { print(strftime($timefmt, localtime())); };
144 } elsif ($timestamp eq "u") {
145 $timestamp = sub { print(time(), "\n"); };
146 } else {
147 usage(gettext("Invalid timestamp specifier"), $timestamp);
148 }
149 }
150
151 # Deal with -[mins] flags
152 if (grep(/[mins]/, keys(%opt))) {
153 usage(gettext("module:instance:name:statistic and " .
154 "-m -i -n -s are mutually exclusive")) if (@ARGV);
155 push(@ARGV, join(":", map(exists($opt{$_}) ? $opt{$_} : "",
156 qw(m i n s))));
157 }
158
159 # Deal with class, if specified
160 my $class = gen_sub(exists($opt{c}) ? $opt{c} : '');
161
162 # If no selectors have been defined, add a dummy one to match everything
163 push(@ARGV, ":::") if (! @ARGV);
164
165 # Convert each remaining option into four anonymous subs
166 foreach my $p (@ARGV) {
167 push(@matcher, [ map(gen_sub($_), (split(/:/, $p, 4))[0..3]) ]);
168 }
169
170 # Loop, printing the selected kstats as many times and as often as required
171 my $ks = Sun::Solaris::Kstat->new(strip_strings => 1);
172 my $matched = 0;
173
174 # Format strings for displaying data
175 my $fmt1 = "module: %-30.30s instance: %-6d\n";
176 my $fmt2 = "name: %-30.30s class: %-.30s\n";
177 my $fmt3 = "\t%-30s %s\n";
178
179 while ($count == -1 || $count-- > 0) {
180 &$timestamp() if ($timestamp);
181
182 foreach my $m (@matcher) {
183 my ($module, $instance, $name, $statistic) = @$m;
184
185 foreach my $m (sort(grep(&$module($_), keys(%$ks)))) {
186 my $mh = $ks->{$m};
187
188 foreach my $i (sort({ $a <=> $b }
189 grep(&$instance($_), keys(%$mh)))) {
190 my $ih = $mh->{$i};
191
192 foreach my $n (sort(grep(&$name($_),
193 keys(%$ih)))) {
194 my $nh = $ih->{$n};
195
196 # Prune any not in the required class
197 next if (! &$class($nh->{class}));
198
199 if ($quiet) {
200 $matched = grep(&$statistic($_),
201 keys(%$nh)) ? 1 : 0;
202
203 } elsif ($parseable) {
204 foreach my $s
205 (sort(grep(&$statistic($_),
206 keys(%$nh)))) {
207 print("$m:$i:$n:$s");
208 print("\t$nh->{$s}")
209 if (! $list);
210 print("\n");
211 $matched = 1;
212 }
213
214 # human-readable
215 } else {
216 if (my @stats =
217 sort(grep(&$statistic($_),
218 keys(%$nh)))) {
219 printf($fmt1, $m, $i);
220 printf($fmt2, $n,
221 $nh->{class});
222 foreach my $s
223 (grep($_ ne "class",
224 @stats)) {
225 printf($fmt3,
226 $s, $nh->{$s});
227 }
228 print("\n");
229 $matched = 1;
230 }
231 }
232 }
233 }
234 }
235 }
236 # Toggle line buffering off/on to flush output
237 $| = 1; $| = 0;
238
239 if ($interval && $count) {
240 sleep($interval);
241 $ks->update();
242 print("\n");
243 }
244 }
245 exit($matched ? 0 : 1);