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