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