ibfindnodesusing.pl revision 296373
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 41use strict; 42 43use Getopt::Std; 44use IBswcountlimits; 45my $ca_name = ""; 46my $ca_port = ""; 47 48# ========================================================================= 49# 50sub 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# 74sub 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 86my $argv0 = `basename $0`; 87my $regenerate_map = undef; 88chomp $argv0; 89if (!getopts("hRC:P:")) { usage_and_exit $argv0; } 90if (defined $Getopt::Std::opt_h) { usage_and_exit $argv0; } 91if (defined $Getopt::Std::opt_R) { $regenerate_map = $Getopt::Std::opt_R; } 92if (defined $Getopt::Std::opt_C) { $ca_name = $Getopt::Std::opt_C; } 93if (defined $Getopt::Std::opt_P) { $ca_port = $Getopt::Std::opt_P; } 94 95my $target_switch = format_guid($ARGV[0]); 96my $target_port = $ARGV[1]; 97 98get_link_ends($regenerate_map, $ca_name, $ca_port); 99 100if ($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# 109sub 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# 125sub 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 153sub 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# 169sub 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} 230main 231 232