contrib/ofed/management/infiniband-diags/scripts/ibfindnodesusing.pl

   1 #!/usr/bin/perl
   2 #
   3 # Copyright (C) 2001-2003 The Regents of the University of California.
   4 # Copyright (c) 2006 The Regents of the University of California.
   5 # Copyright (c) 2007-2008 Voltaire, Inc. All rights reserved.
   6 #
   7 # Produced at Lawrence Livermore National Laboratory.
   8 # Written by Ira Weiny <weiny2@llnl.gov>
   9 #            Jim Garlick <garlick@llnl.gov>
  10 #            Albert Chu <chu11@llnl.gov>
  11 #
  12 # This software is available to you under a choice of one of two
  13 # licenses.  You may choose to be licensed under the terms of the GNU
  14 # General Public License (GPL) Version 2, available from the file
  15 # COPYING in the main directory of this source tree, or the
  16 # OpenIB.org BSD license below:
  17 #
  18 #     Redistribution and use in source and binary forms, with or
  19 #     without modification, are permitted provided that the following
  20 #     conditions are met:
  21 #
  22 #      - Redistributions of source code must retain the above
  23 #        copyright notice, this list of conditions and the following
  24 #        disclaimer.
  25 #
  26 #      - Redistributions in binary form must reproduce the above
  27 #        copyright notice, this list of conditions and the following
  28 #        disclaimer in the documentation and/or other materials
  29 #        provided with the distribution.
  30 #
  31 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  32 # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  33 # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  34 # NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
  35 # BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
  36 # ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
  37 # CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
  38 # SOFTWARE.
  39 #
  40
  41 use strict;
  42
  43 use Getopt::Std;
  44 use IBswcountlimits;
  45 my $ca_name = "";
  46 my $ca_port = "";
  47
  48 # =========================================================================
  49 #
  50 sub get_hosts_routed
  51 {
  52         my $sw_guid      = $_[0];
  53         my $sw_port      = $_[1];
  54         my @hosts        = undef;
  55         my $extra_params = get_ca_name_port_param_string($ca_name, $ca_port);
  56
  57         if ($sw_guid eq "") { return (@hosts); }
  58
  59         my $data = `ibroute $extra_params -G $sw_guid`;
  60         my @lines = split("\n", $data);
  61         foreach my $line (@lines) {
  62                 if ($line =~ /\w+\s+(\d+)\s+:\s+\(Channel Adapter.*:\s+'(.*)'\)/) {
  63                         if ($1 == $sw_port) {
  64                                 push @hosts, $2;
  65                         }
  66                 }
  67         }
  68
  69         return (@hosts);
  70 }
  71
  72 # =========================================================================
  73 #
  74 sub usage_and_exit
  75 {
  76         my $prog = $_[0];
  77         print
  78 "Usage: $prog [-R -C <ca_name> -P <ca_port>] <switch_guid|switch_name> <port>\n";
  79         print "   find a list of nodes which are routed through switch:port\n";
  80         print "   -R Recalculate ibnetdiscover information\n";
  81         print "   -C <ca_name> use selected Channel Adaptor name for queries\n";
  82         print "   -P <ca_port> use selected channel adaptor port for queries\n";
  83         exit 2;
  84 }
  85
  86 my $argv0          = `basename $0`;
  87 my $regenerate_map = undef;
  88 chomp $argv0;
  89 if (!getopts("hRC:P:"))          { usage_and_exit $argv0; }
  90 if (defined $Getopt::Std::opt_h) { usage_and_exit $argv0; }
  91 if (defined $Getopt::Std::opt_R) { $regenerate_map = $Getopt::Std::opt_R; }
  92 if (defined $Getopt::Std::opt_C) { $ca_name        = $Getopt::Std::opt_C; }
  93 if (defined $Getopt::Std::opt_P) { $ca_port        = $Getopt::Std::opt_P; }
  94
  95 my $target_switch = format_guid($ARGV[0]);
  96 my $target_port   = $ARGV[1];
  97
  98 get_link_ends($regenerate_map, $ca_name, $ca_port);
  99
 100 if ($target_switch eq "" || $target_port eq "") {
 101         usage_and_exit $argv0;
 102 }
 103
 104 # sortn:
 105 #
 106 # sort a group of alphanumeric strings by the last group of digits on
 107 # those strings, if such exists (good for numerically suffixed host lists)
 108 #
 109 sub sortn
 110 {
 111         map { $$_[0] }
 112           sort { ($$a[1] || 0) <=> ($$b[1] || 0) } map { [$_, /(\d*)$/] } @_;
 113 }
 114
 115 # comp2():
 116 #
 117 # takes a list of names and returns a hash of arrays, indexed by name prefix,
 118 # each containing a list of numerical ranges describing the initial list.
 119 #
 120 # e.g.: %hash = comp2(lx01,lx02,lx03,lx05,dev0,dev1,dev21)
 121 #       will return:
 122 #       $hash{"lx"}  = ["01-03", "05"]
 123 #       $hash{"dev"} = ["0-1", "21"]
 124 #
 125 sub comp2
 126 {
 127         my (%i) = ();
 128         my (%s) = ();
 129
 130         # turn off warnings here to avoid perl complaints about
 131         # uninitialized values for members of %i and %s
 132         local ($^W) = 0;
 133         push(
 134                 @{
 135                         $s{$$_[0]}[
 136                           (
 137                                   $s{$$_[0]}[$i{$$_[0]}][$#{$s{$$_[0]}[$i{$$_[0]}]}] ==
 138                                     ($$_[1] - 1)
 139                           ) ? $i{$$_[0]} : ++$i{$$_[0]}
 140                         ]
 141                   },
 142                 ($$_[1])
 143         ) for map { [/(.*?)(\d*)$/] } sortn(@_);
 144
 145         for my $key (keys %s) {
 146                 @{$s{$key}} =
 147                   map { $#$_ > 0 ? "$$_[0]-$$_[$#$_]" : @{$_} } @{$s{$key}};
 148         }
 149
 150         return %s;
 151 }
 152
 153 sub compress_hostlist
 154 {
 155         my %rng  = comp2(@_);
 156         my @list = ();
 157
 158         local $" = ",";
 159
 160         foreach my $k (keys %rng) {
 161                 @{$rng{$k}} = map { "$k$_" } @{$rng{$k}};
 162         }
 163         @list = map { @{$rng{$_}} } sort keys %rng;
 164         return "@list";
 165 }
 166
 167 # =========================================================================
 168 #
 169 sub main
 170 {
 171         my $found_switch = undef;
 172         my $cache_file = get_cache_file($ca_name, $ca_port);
 173         open IBNET_TOPO, "<$cache_file" or die "Failed to open ibnet topology\n";
 174         my $in_switch   = "no";
 175         my $switch_guid = "";
 176         my $desc        = undef;
 177         my %ports       = undef;
 178         while (my $line = <IBNET_TOPO>) {
 179
 180                 if ($line =~ /^Switch.*\"S-(.*)\"\s+# (.*) port.*/) {
 181                         $switch_guid = $1;
 182                         $desc        = $2;
 183                         if ("0x$switch_guid" eq $target_switch
 184                                 || $desc =~ /.*$target_switch\s+.*/)
 185                         {
 186                                 $found_switch = "yes";
 187                                 goto FOUND;
 188                         }
 189                 }
 190                 if ($line =~ /^Ca.*/ || $line =~ /^Rt.*/) { $in_switch = "no"; }
 191
 192                 if ($line =~ /^\[(\d+)\].*/ && $in_switch eq "yes") {
 193                         $ports{$1} = $line;
 194                 }
 195
 196         }
 197
 198         FOUND:
 199         close IBNET_TOPO;
 200         if (!$found_switch) {
 201                 print "Switch \"$target_switch\" not found\n";
 202                 print "   Try running with the \"-R\" or \"-P\" option.\n";
 203                 exit 1;
 204         }
 205
 206         $switch_guid = "0x$switch_guid";
 207
 208         my $hr          = $IBswcountlimits::link_ends{$switch_guid}{$target_port};
 209         my $rem_sw_guid = $hr->{rem_guid};
 210         my $rem_sw_port = $hr->{rem_port};
 211         my $rem_sw_desc = $hr->{rem_desc};
 212
 213         my @hosts = undef;
 214         @hosts = get_hosts_routed($switch_guid, $target_port);
 215
 216         my $hosts = compress_hostlist(@hosts);
 217         @hosts = split ",", $hosts;
 218         print
 219 "$switch_guid $target_port ($desc)  ==>>  $rem_sw_guid $rem_sw_port ($rem_sw_desc)\n";
 220         print "@hosts\n\n";
 221
 222         @hosts = get_hosts_routed($rem_sw_guid, $rem_sw_port);
 223
 224         $hosts = compress_hostlist(@hosts);
 225         @hosts = split ",", $hosts;
 226         print
 227 "$switch_guid $target_port ($desc)  <<==  $rem_sw_guid $rem_sw_port ($rem_sw_desc)\n";
 228         print "@hosts\n";
 229 }
 230 main
 231