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);