1219820Sjeff#!/usr/bin/perl 2219820Sjeff# 3219820Sjeff# Copyright (C) 2001-2003 The Regents of the University of California. 4219820Sjeff# Copyright (c) 2006 The Regents of the University of California. 5219820Sjeff# Copyright (c) 2007-2008 Voltaire, Inc. All rights reserved. 6219820Sjeff# 7219820Sjeff# Produced at Lawrence Livermore National Laboratory. 8219820Sjeff# Written by Ira Weiny <weiny2@llnl.gov> 9219820Sjeff# Jim Garlick <garlick@llnl.gov> 10219820Sjeff# Albert Chu <chu11@llnl.gov> 11219820Sjeff# 12219820Sjeff# This software is available to you under a choice of one of two 13219820Sjeff# licenses. You may choose to be licensed under the terms of the GNU 14219820Sjeff# General Public License (GPL) Version 2, available from the file 15219820Sjeff# COPYING in the main directory of this source tree, or the 16219820Sjeff# OpenIB.org BSD license below: 17219820Sjeff# 18219820Sjeff# Redistribution and use in source and binary forms, with or 19219820Sjeff# without modification, are permitted provided that the following 20219820Sjeff# conditions are met: 21219820Sjeff# 22219820Sjeff# - Redistributions of source code must retain the above 23219820Sjeff# copyright notice, this list of conditions and the following 24219820Sjeff# disclaimer. 25219820Sjeff# 26219820Sjeff# - Redistributions in binary form must reproduce the above 27219820Sjeff# copyright notice, this list of conditions and the following 28219820Sjeff# disclaimer in the documentation and/or other materials 29219820Sjeff# provided with the distribution. 30219820Sjeff# 31219820Sjeff# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 32219820Sjeff# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 33219820Sjeff# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 34219820Sjeff# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS 35219820Sjeff# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN 36219820Sjeff# ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 37219820Sjeff# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 38219820Sjeff# SOFTWARE. 39219820Sjeff# 40219820Sjeff 41219820Sjeffuse strict; 42219820Sjeff 43219820Sjeffuse Getopt::Std; 44219820Sjeffuse IBswcountlimits; 45219820Sjeffmy $ca_name = ""; 46219820Sjeffmy $ca_port = ""; 47219820Sjeff 48219820Sjeff# ========================================================================= 49219820Sjeff# 50219820Sjeffsub get_hosts_routed 51219820Sjeff{ 52219820Sjeff my $sw_guid = $_[0]; 53219820Sjeff my $sw_port = $_[1]; 54219820Sjeff my @hosts = undef; 55219820Sjeff my $extra_params = get_ca_name_port_param_string($ca_name, $ca_port); 56219820Sjeff 57219820Sjeff if ($sw_guid eq "") { return (@hosts); } 58219820Sjeff 59219820Sjeff my $data = `ibroute $extra_params -G $sw_guid`; 60219820Sjeff my @lines = split("\n", $data); 61219820Sjeff foreach my $line (@lines) { 62219820Sjeff if ($line =~ /\w+\s+(\d+)\s+:\s+\(Channel Adapter.*:\s+'(.*)'\)/) { 63219820Sjeff if ($1 == $sw_port) { 64219820Sjeff push @hosts, $2; 65219820Sjeff } 66219820Sjeff } 67219820Sjeff } 68219820Sjeff 69219820Sjeff return (@hosts); 70219820Sjeff} 71219820Sjeff 72219820Sjeff# ========================================================================= 73219820Sjeff# 74219820Sjeffsub usage_and_exit 75219820Sjeff{ 76219820Sjeff my $prog = $_[0]; 77219820Sjeff print 78219820Sjeff"Usage: $prog [-R -C <ca_name> -P <ca_port>] <switch_guid|switch_name> <port>\n"; 79219820Sjeff print " find a list of nodes which are routed through switch:port\n"; 80219820Sjeff print " -R Recalculate ibnetdiscover information\n"; 81219820Sjeff print " -C <ca_name> use selected Channel Adaptor name for queries\n"; 82219820Sjeff print " -P <ca_port> use selected channel adaptor port for queries\n"; 83219820Sjeff exit 2; 84219820Sjeff} 85219820Sjeff 86219820Sjeffmy $argv0 = `basename $0`; 87219820Sjeffmy $regenerate_map = undef; 88219820Sjeffchomp $argv0; 89219820Sjeffif (!getopts("hRC:P:")) { usage_and_exit $argv0; } 90219820Sjeffif (defined $Getopt::Std::opt_h) { usage_and_exit $argv0; } 91219820Sjeffif (defined $Getopt::Std::opt_R) { $regenerate_map = $Getopt::Std::opt_R; } 92219820Sjeffif (defined $Getopt::Std::opt_C) { $ca_name = $Getopt::Std::opt_C; } 93219820Sjeffif (defined $Getopt::Std::opt_P) { $ca_port = $Getopt::Std::opt_P; } 94219820Sjeff 95219820Sjeffmy $target_switch = format_guid($ARGV[0]); 96219820Sjeffmy $target_port = $ARGV[1]; 97219820Sjeff 98219820Sjeffget_link_ends($regenerate_map, $ca_name, $ca_port); 99219820Sjeff 100219820Sjeffif ($target_switch eq "" || $target_port eq "") { 101219820Sjeff usage_and_exit $argv0; 102219820Sjeff} 103219820Sjeff 104219820Sjeff# sortn: 105219820Sjeff# 106219820Sjeff# sort a group of alphanumeric strings by the last group of digits on 107219820Sjeff# those strings, if such exists (good for numerically suffixed host lists) 108219820Sjeff# 109219820Sjeffsub sortn 110219820Sjeff{ 111219820Sjeff map { $$_[0] } 112219820Sjeff sort { ($$a[1] || 0) <=> ($$b[1] || 0) } map { [$_, /(\d*)$/] } @_; 113219820Sjeff} 114219820Sjeff 115219820Sjeff# comp2(): 116219820Sjeff# 117219820Sjeff# takes a list of names and returns a hash of arrays, indexed by name prefix, 118219820Sjeff# each containing a list of numerical ranges describing the initial list. 119219820Sjeff# 120219820Sjeff# e.g.: %hash = comp2(lx01,lx02,lx03,lx05,dev0,dev1,dev21) 121219820Sjeff# will return: 122219820Sjeff# $hash{"lx"} = ["01-03", "05"] 123219820Sjeff# $hash{"dev"} = ["0-1", "21"] 124219820Sjeff# 125219820Sjeffsub comp2 126219820Sjeff{ 127219820Sjeff my (%i) = (); 128219820Sjeff my (%s) = (); 129219820Sjeff 130219820Sjeff # turn off warnings here to avoid perl complaints about 131219820Sjeff # uninitialized values for members of %i and %s 132219820Sjeff local ($^W) = 0; 133219820Sjeff push( 134219820Sjeff @{ 135219820Sjeff $s{$$_[0]}[ 136219820Sjeff ( 137219820Sjeff $s{$$_[0]}[$i{$$_[0]}][$#{$s{$$_[0]}[$i{$$_[0]}]}] == 138219820Sjeff ($$_[1] - 1) 139219820Sjeff ) ? $i{$$_[0]} : ++$i{$$_[0]} 140219820Sjeff ] 141219820Sjeff }, 142219820Sjeff ($$_[1]) 143219820Sjeff ) for map { [/(.*?)(\d*)$/] } sortn(@_); 144219820Sjeff 145219820Sjeff for my $key (keys %s) { 146219820Sjeff @{$s{$key}} = 147219820Sjeff map { $#$_ > 0 ? "$$_[0]-$$_[$#$_]" : @{$_} } @{$s{$key}}; 148219820Sjeff } 149219820Sjeff 150219820Sjeff return %s; 151219820Sjeff} 152219820Sjeff 153219820Sjeffsub compress_hostlist 154219820Sjeff{ 155219820Sjeff my %rng = comp2(@_); 156219820Sjeff my @list = (); 157219820Sjeff 158219820Sjeff local $" = ","; 159219820Sjeff 160219820Sjeff foreach my $k (keys %rng) { 161219820Sjeff @{$rng{$k}} = map { "$k$_" } @{$rng{$k}}; 162219820Sjeff } 163219820Sjeff @list = map { @{$rng{$_}} } sort keys %rng; 164219820Sjeff return "@list"; 165219820Sjeff} 166219820Sjeff 167219820Sjeff# ========================================================================= 168219820Sjeff# 169219820Sjeffsub main 170219820Sjeff{ 171219820Sjeff my $found_switch = undef; 172219820Sjeff my $cache_file = get_cache_file($ca_name, $ca_port); 173219820Sjeff open IBNET_TOPO, "<$cache_file" or die "Failed to open ibnet topology\n"; 174219820Sjeff my $in_switch = "no"; 175219820Sjeff my $switch_guid = ""; 176219820Sjeff my $desc = undef; 177219820Sjeff my %ports = undef; 178219820Sjeff while (my $line = <IBNET_TOPO>) { 179219820Sjeff 180219820Sjeff if ($line =~ /^Switch.*\"S-(.*)\"\s+# (.*) port.*/) { 181219820Sjeff $switch_guid = $1; 182219820Sjeff $desc = $2; 183219820Sjeff if ("0x$switch_guid" eq $target_switch 184219820Sjeff || $desc =~ /.*$target_switch\s+.*/) 185219820Sjeff { 186219820Sjeff $found_switch = "yes"; 187219820Sjeff goto FOUND; 188219820Sjeff } 189219820Sjeff } 190219820Sjeff if ($line =~ /^Ca.*/ || $line =~ /^Rt.*/) { $in_switch = "no"; } 191219820Sjeff 192219820Sjeff if ($line =~ /^\[(\d+)\].*/ && $in_switch eq "yes") { 193219820Sjeff $ports{$1} = $line; 194219820Sjeff } 195219820Sjeff 196219820Sjeff } 197219820Sjeff 198219820Sjeff FOUND: 199219820Sjeff close IBNET_TOPO; 200219820Sjeff if (!$found_switch) { 201219820Sjeff print "Switch \"$target_switch\" not found\n"; 202219820Sjeff print " Try running with the \"-R\" or \"-P\" option.\n"; 203219820Sjeff exit 1; 204219820Sjeff } 205219820Sjeff 206219820Sjeff $switch_guid = "0x$switch_guid"; 207219820Sjeff 208219820Sjeff my $hr = $IBswcountlimits::link_ends{$switch_guid}{$target_port}; 209219820Sjeff my $rem_sw_guid = $hr->{rem_guid}; 210219820Sjeff my $rem_sw_port = $hr->{rem_port}; 211219820Sjeff my $rem_sw_desc = $hr->{rem_desc}; 212219820Sjeff 213219820Sjeff my @hosts = undef; 214219820Sjeff @hosts = get_hosts_routed($switch_guid, $target_port); 215219820Sjeff 216219820Sjeff my $hosts = compress_hostlist(@hosts); 217219820Sjeff @hosts = split ",", $hosts; 218219820Sjeff print 219219820Sjeff"$switch_guid $target_port ($desc) ==>> $rem_sw_guid $rem_sw_port ($rem_sw_desc)\n"; 220219820Sjeff print "@hosts\n\n"; 221219820Sjeff 222219820Sjeff @hosts = get_hosts_routed($rem_sw_guid, $rem_sw_port); 223219820Sjeff 224219820Sjeff $hosts = compress_hostlist(@hosts); 225219820Sjeff @hosts = split ",", $hosts; 226219820Sjeff print 227219820Sjeff"$switch_guid $target_port ($desc) <<== $rem_sw_guid $rem_sw_port ($rem_sw_desc)\n"; 228219820Sjeff print "@hosts\n"; 229219820Sjeff} 230219820Sjeffmain 231219820Sjeff 232