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