diff options
Diffstat (limited to 'usr/src/cmd/pginfo')
| -rw-r--r-- | usr/src/cmd/pginfo/Makefile | 45 | ||||
| -rw-r--r-- | usr/src/cmd/pginfo/pginfo.pl | 618 |
2 files changed, 663 insertions, 0 deletions
diff --git a/usr/src/cmd/pginfo/Makefile b/usr/src/cmd/pginfo/Makefile new file mode 100644 index 0000000000..c209c8f914 --- /dev/null +++ b/usr/src/cmd/pginfo/Makefile @@ -0,0 +1,45 @@ +# +# CDDL HEADER START +# +# The contents of this file are subject to the terms of the +# Common Development and Distribution License (the "License"). +# You may not use this file except in compliance with the License. +# +# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE +# or http://www.opensolaris.org/os/licensing. +# See the License for the specific language governing permissions +# and limitations under the License. +# +# When distributing Covered Code, include this CDDL HEADER in each +# file and include the License file at usr/src/OPENSOLARIS.LICENSE. +# If applicable, add the following below this CDDL HEADER, with the +# fields enclosed by brackets "[]" replaced with your own identifying +# information: Portions Copyright [yyyy] [name of copyright owner] +# +# CDDL HEADER END +# + +# +# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved. +# + +PROG= pginfo + +include ../Makefile.cmd + +TARGET= all + +.KEEP_STATE: + +all: $(PROG) + +install: all .WAIT $(ROOTPROG) + +clean: + +$(ROOTBINPROG): $(PROG) + $(INS.file) + +lint: + +include ../Makefile.targ diff --git a/usr/src/cmd/pginfo/pginfo.pl b/usr/src/cmd/pginfo/pginfo.pl new file mode 100644 index 0000000000..8a15b4adc9 --- /dev/null +++ b/usr/src/cmd/pginfo/pginfo.pl @@ -0,0 +1,618 @@ +#! /usr/perl5/bin/perl +# +# CDDL HEADER START +# +# The contents of this file are subject to the terms of the +# Common Development and Distribution License (the "License"). +# You may not use this file except in compliance with the License. +# +# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE +# or http://www.opensolaris.org/os/licensing. +# See the License for the specific language governing permissions +# and limitations under the License. +# +# When distributing Covered Code, include this CDDL HEADER in each +# file and include the License file at usr/src/OPENSOLARIS.LICENSE. +# If applicable, add the following below this CDDL HEADER, with the +# fields enclosed by brackets "[]" replaced with your own identifying +# information: Portions Copyright [yyyy] [name of copyright owner] +# +# CDDL HEADER END +# + +# +# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved. +# + +# +# pginfo - tool for displaying Processor Group information +# + +use warnings; +use strict; +use File::Basename; +use Errno; +use POSIX qw(locale_h); +use Getopt::Long qw(:config no_ignore_case bundling auto_version); +use List::Util qw(first max min); +use Sun::Solaris::Utils qw(textdomain gettext); +use Sun::Solaris::Pg; + +# +# Constants +# +# It is possible that wnen trying to parse PG information, PG generation changes +# which will cause PG new method to fail with errno set to EAGAIN In this case +# we retry open up to RETRY_COUNT times pausing RETRY_DELAY seconds between each +# retry. +# +# When printing PGs we print them as a little tree with each PG shifted by +# LEVEL_OFFSET from each parent. For example: +# +# PG RELATIONSHIP CPUs +# 0 System 0-7 +# 3 Socket 0 2 4 6 +# 2 Cache 0 2 4 6 +# + +use constant { + VERSION => 1.1, + LEVEL_OFFSET => 1, + RETRY_COUNT => 4, + RETRY_DELAY => 0.25, +}; + +# +# Return codes +# +# 0 Successful completion. +# +# 1 An error occurred. +# +# 2 Invalid command-line options were specified. +# +use constant { + E_SUCCESS => 0, + E_ERROR => 1, + E_USAGE => 2, +}; + + +# Set message locale +setlocale(LC_ALL, ""); +textdomain(TEXT_DOMAIN); + +# Get script name for error messages +our $cmdname = basename($0, ".pl"); + +# +# Process options +# +my $do_cpulist; # -C - Show CPU IDs +my $do_cpus; # -c - Treat args as CPU IDs +my $do_physical; # -p - Show physical relationships +my $do_sharing_only; # -S - Only show sharing relationships +my $do_tree; # -T - Show ASCII tree +my $do_usage; # -h - Show usage +my $do_version; # -V - Show version +my $script_mode; # -I - Only show IDs +my $verbose = 0; # -v - Verbose output +my @sharing_filter; # -r string,... +my @sharing_filter_neg; # -R string,... + +# Exit code +my $rc = E_SUCCESS; + +# Parse options from the command line +GetOptions("cpus|c" => \$do_cpus, + "idlist|I" => \$script_mode, + "cpulist|C" => \$do_cpulist, + "physical|p" => \$do_physical, + "help|h|?" => \$do_usage, + "sharing|s" => \$do_sharing_only, + "relationship|r=s" => \@sharing_filter, + "norelationship|R=s" => \@sharing_filter_neg, + "tree|topology|T" => \$do_tree, + "version|V" => \$do_version, + "verbose+" => \$verbose, + "v+" => \$verbose, +) || usage(E_USAGE); + +# Print usage message when -h is given +usage(E_SUCCESS) if $do_usage; + +if ($do_version) { + # + # Print version information and exit + # + printf gettext("%s version %s\n"), $cmdname, VERSION; + exit(E_SUCCESS); +} + +# +# Verify options compatibility +# +if ($script_mode && $do_cpulist) { + printf STDERR + gettext("%s: options -I and -C can not be used at the same time\n"), + $cmdname; + usage(E_USAGE); +} + +if (($script_mode || $do_cpulist) && + ($do_physical || $do_sharing_only || + $do_tree)) { + printf STDERR + gettext("%s: options -C and -I can not be used with -p -s or -T\n"), + $cmdname; + usage(E_USAGE); +} + +if ($do_physical && $do_sharing_only) { + printf STDERR + gettext("%s: option -p can not be used with -s\n"), $cmdname; + usage(E_USAGE); +} + +if ($do_tree && $do_sharing_only) { + printf STDERR + gettext("%s: option -T can not be used with -s\n"), + $cmdname; + usage(E_USAGE); +} + +if ($verbose && !($script_mode || $do_cpulist || $do_sharing_only)) { + $do_tree = 1; + $do_physical = 1; +} + +# +# Get PG information +# +my $p = Sun::Solaris::Pg->new(-tags => $do_physical, + -retry => RETRY_COUNT, + '-delay' => RETRY_DELAY); + +if (!$p) { + printf STDERR + gettext("%s: can not obtain Processor Group information: $!\n"), + $cmdname; + exit(E_ERROR); +} + +# +# Convert -[Rr] string1,string2,... into list (string1, string2, ...) +# +@sharing_filter = map { split /,/ } @sharing_filter; +@sharing_filter_neg = map { split /,/ } @sharing_filter_neg; + +# +# Get list of all PGs in the system +# +my @all_pgs = $p->all_depth_first(); + +if (scalar(@all_pgs) == 0) { + printf STDERR + gettext("%s: this system does not have any Processor groups\n"), + $cmdname; + exit(E_ERROR); +} + +# +# @pgs is the list of PGs we are going to work with after all the option +# processing +# +my @pgs = @all_pgs; + +# +# get list of all CPUs in the system by looking at the root PG cpus +# +my @all_cpus = $p->cpus($p->root()); + +# +# If there are arguments in the command line, treat them as either PG IDs or as +# CPUs that should be converted to PG IDs. +# Arguments can be specified as x-y x,y,z and use special keyword 'all' +# +if (scalar @ARGV) { + # + # Convert 'all' in arguments to all CPUs or all PGs + # + my @args; + my @all = $do_cpus ? @all_cpus : @all_pgs; + @args = map { $_ eq 'all' ? @all : $_ } @ARGV; + + # Expand any x-y,z ranges + @args = $p->expand(@args); + + if ($do_cpus) { + # @bad_cpus is a list of invalid CPU IDs + my @bad_cpus = $p->set_subtract(\@all_cpus, \@args); + if (scalar @bad_cpus) { + printf STDERR + gettext("%s: Invalid processor IDs %s\n"), + $cmdname, $p->id_collapse(@bad_cpus); + $rc = E_ERROR; + } + # + # List of PGs is the list of any PGs that contain specified CPUs + # + @pgs = grep { + my @cpus = $p->cpus($_); + scalar($p->intersect(\@cpus, \@args)); + } @all_pgs; + } else { + # @pgs is a list of valid CPUs in the arguments + @pgs = $p->intersect(\@all_pgs, \@args); + # @bad_pgs is a list of invalid PG IDs + my @bad_pgs = $p->set_subtract(\@all_pgs, \@args); + if (scalar @bad_pgs) { + printf STDERR + gettext("%s: Invalid PG IDs %s\n"), + $cmdname, $p->id_collapse(@bad_pgs); + $rc = E_ERROR; + } + } +} + +# +# Now we have list of PGs to work with. Now apply filtering. First list only +# those matching -R +# +@pgs = grep { list_match($p->sh_name($_), @sharing_filter) } @pgs if + scalar @sharing_filter; + +# Remove any that doesn't match -r +@pgs = grep { !list_match($p->sh_name($_), @sharing_filter_neg) } @pgs if + scalar @sharing_filter_neg; + +# Do we have any PGs left? +if (scalar(@pgs) == 0) { + printf STDERR + gettext("%s: no processor groups matching command line arguments %s\n"), + $cmdname, "@ARGV"; + exit(E_ERROR); +} + +# +# Global list of PGs that should be excluded from the output - it is only used +# when tree mode is specified. +# +my @exclude_pgs; +if ($do_tree) { + @exclude_pgs = grep { + list_match($p->sh_name($_), @sharing_filter_neg) + } @all_pgs; + + # + # In tree mode add PGs that are in the lineage of given PGs + # + @pgs = pg_lineage($p, @pgs) +} + +# +# -I is specified, print list of all PGs +# +if ($script_mode) { + if (scalar(@pgs)) { + @pgs = sort { $a <=> $b } @pgs; + print "@pgs\n"; + } else { + print "none\n"; + } + exit($rc); +} + +# +# -C is specified, print list of all CPUs belonging to PGs +# +if ($do_cpulist) { + my @cpu_list = $p->uniqsort(map { $p->cpus($_) } @pgs); + print "@cpu_list\n"; + exit($rc); +} + +# Mapping of relationships to list of PGs +my %pgs_by_relationship; + +# Maximum length of all sharing names +my $max_sharename_len = length('RELATIONSHIP'); + +# Maximum length of PG ID +my $max_pg_len = length(max(@pgs)) + 1; + +# +# For calculating proper offsets we need to know minimum and maximum level for +# all PGs +# +my @levels = map { $p->level($_) } @pgs; +my $maxlevel = max(@levels); +my $minlevel = min(@levels); + +# Calculate maximum string length that should be used to represent PGs +foreach my $pg (@pgs) { + my $name = $p->sh_name ($pg) || "unknown"; + my $level = $p->level($pg) || 0; + + if ($do_physical) { + my $tags = $p->tags($pg); + $name = "$name [$tags]" if $tags; + } + + my $length = length($name) + $level - $minlevel; + $max_sharename_len = $length if $length > $max_sharename_len; +} + +if ($do_sharing_only) { + # + # -s - only print sharing relationships + + # Get list of sharing relationships + my @relationships = $p->sharing_relationships(@pgs); + + if ($verbose) { + printf "%-${max_sharename_len}s %s\n", + 'RELATIONSHIP', 'PGs'; + foreach my $rel (@relationships) { + my @pg_rel = grep { $p->sh_name($_) eq $rel } + @pgs; + my $pg_rel = $p->id_collapse (@pg_rel); + $pgs_by_relationship{$rel} = \@pg_rel; + } + } + + foreach my $rel (@relationships) { + printf "%-${max_sharename_len}s", $rel; + if ($verbose) { + my @pgs = @{$pgs_by_relationship{$rel}}; + my $pgs = $p->id_collapse (@pgs); + print ' ', $pgs; + } + print "\n"; + } + + # we are done + exit($rc); +} + +# +# Print PGs either in list form or tree form +# +if (!$do_tree) { + my $header; + + $header = sprintf "%-${max_pg_len}s %-${max_sharename_len}s" . + " %s\n", + 'PG', 'RELATIONSHIP', 'CPUs'; + + print $header; + map { pg_print ($p, $_) } @pgs; +} else { + # + # Construct a tree from PG hierarchy and prune any PGs that are + # specified with -R option + # + my $pg_tree = pg_make_tree($p); + map { pg_remove_from_tree($pg_tree, $_) } @exclude_pgs; + + # Find top-level PGs + my @top_level = grep { + $pg_tree->{$_} && !defined($pg_tree->{$_}->{parent}) + } @pgs; + + # Print each top-level node as ASCII tree + foreach my $pg (@top_level) { + my $children = $pg_tree->{$pg}->{children}; + my @children = $children ? @{$children} : (); + @children = $p->intersect(\@children, \@pgs); + pg_print_tree($p, $pg_tree, $pg, '', '', scalar @children); + } +} + +# We are done! +exit($rc); + +###################################################################### +# Internal functions +# + +# +# pg_print(cookie, pg) +# print PG information in list mode +# +sub pg_print +{ + my $p = shift; + my $pg = shift; + my $sharing = $p->sh_name($pg); + if ($do_physical) { + my $tags = $p->tags($pg); + $sharing = "$sharing [$tags]" if $tags; + } + my $level = $p->level($pg) - $minlevel; + $sharing = (' ' x (LEVEL_OFFSET * $level)) . $sharing; + my $cpus = $p->cpus($pg); + printf "%-${max_pg_len}d %-${max_sharename_len}s", $pg, $sharing; + print " $cpus"; + print "\n"; +} + +# +# pg_showcpus(cookie, pg) +# Print CPUs in the current PG +# +sub pg_showcpus +{ + my $p = shift; + my $pg = shift; + + my @cpus = $p->cpus($pg); + my $ncpus = scalar @cpus; + return 0 unless $ncpus; + my $cpu_string = $p->cpus($pg); + return (($ncpus == 1) ? + "CPU: $cpu_string": + "CPUs: $cpu_string"); +} + +# +# pg_print_node(cookie, pg) +# print PG as ASCII tree node +# +sub pg_print_node +{ + my $p = shift; + my $pg = shift; + + my $sharing = $p->sh_name($pg); + if ($do_physical) { + my $tags = $p->tags($pg); + $sharing = "$sharing [$tags]" if $tags; + } + + print "$pg ($sharing)"; + my $cpus = pg_showcpus($p, $pg); + print " $cpus"; + print "\n"; +} + +# +# pg_print_tree(cookie, tree, pg, prefix, childprefix, npeers) +# print ASCII tree of PGs in the tree +# prefix should be used for the current node, childprefix for children nodes +# npeers is the number of peers of the current node +# +sub pg_print_tree +{ + my $p = shift; + my $pg_tree = shift; + my $pg = shift; + return unless defined ($pg); # done! + my $prefix = shift; + my $childprefix = shift; + my $npeers = shift; + + # Get list of my children + my $children = $pg_tree->{$pg}->{children}; + my @children = $children ? @{$children} : (); + @children = $p->intersect(\@children, \@pgs); + my $nchildren = scalar @children; + + my $printprefix = "$childprefix"; + my $printpostfix = $npeers ? "| " : " "; + + my $bar = $npeers ? "|" : "`"; + + print $childprefix ? $childprefix : ""; + print $prefix ? "$bar" . "-- " : ""; + pg_print_node ($p, $pg); + + my $new_prefix = $npeers ? $prefix : " "; + + # Print the subtree with a new offset, starting from each child + map { + pg_print_tree($p, $pg_tree, $_, "| ", + "$childprefix$new_prefix", --$nchildren) + } @children; +} + +# +# list_match(arg, list) +# Return arg if argument matches any of the elements on the list +# +sub list_match +{ + my $arg = shift; + + return first { $arg =~ m/$_/i } @_; +} + +# +# Make a version of PG parent-children relationships from cookie +# +sub pg_make_tree +{ + my $p = shift; + my $pg_tree = (); + + foreach my $pg ($p->all()) { + my @children = $p->children($pg); + $pg_tree->{$pg}->{parent} = $p->parent($pg); + $pg_tree->{$pg}->{children} = \@children; + } + + return ($pg_tree); +} + +# +# pg_remove_from_tree(tree, pg) +# Prune PG from the tree +# +sub pg_remove_from_tree +{ + my $pg_tree = shift; + my $pg = shift; + my $node = $pg_tree->{$pg}; + return unless $node; + + my @children = @{$node->{children}}; + my $parent = $node->{parent}; + my $parent_node; + + # + # Children have a new parent + # + map { $pg_tree->{$_}->{parent} = $parent } @children; + + # + # All children move to the parent (if there is one) + # + if (defined($parent) && ($parent_node = $pg_tree->{$parent})) { + # + # Merge children from parent and @children list + # + my @parent_children = @{$parent_node->{children}}; + # + # Remove myself from parent children + # + @parent_children = grep { $_ != $pg } @parent_children; + @parent_children = $p->nsort(@parent_children, @children); + $parent_node->{children} = \@parent_children; + } + + # Remove current node + delete $pg_tree->{$pg}; +} + +# +# For a given list of PGs return the full lineage +# +sub pg_lineage +{ + my $p = shift; + return unless scalar @_; + + my @parents = grep { defined($_) } map { $p->parent ($_) } @_; + + return ($p->uniq(@_, @parents, pg_lineage ($p, @parents))); +} + +# +# Print usage information and exit with the return code specified +# +sub usage +{ + my $rc = shift; + printf STDERR + gettext("Usage:\t%s [-T] [-p] [-v] [-r string] [-R string] [pg ... | -c processor_id ...]\n\n"), + $cmdname; + printf STDERR + gettext("\t%s -s [-v] [-r string] [-R string] [pg ... | -c processor_id ...]\n\n"), $cmdname; + printf STDERR gettext("\t%s -C | -I [-r string] [-R string] [pg ... | -c processor_id ...]\n\n"), + $cmdname; + printf STDERR gettext("\t%s -h\n\n"), $cmdname; + + exit($rc); +} + +__END__ |