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;
45219820Sjeff
46219820Sjeffmy $regenerate_cache = 0;
47219820Sjeffmy $verbose          = 0;
48219820Sjeff
49219820Sjeffmy $switch_lid                            = undef;
50219820Sjeffmy $switch_guid                           = undef;
51219820Sjeffmy $switch_name                           = undef;
52219820Sjeffmy %switch_port_count                     = ();
53219820Sjeffmy @switch_maybe_directly_connected_hosts = ();
54219820Sjeffmy $host                                  = undef;
55219820Sjeffmy @host_ports                            = ();
56219820Sjeff
57219820Sjeffmy @lft_lines = ();
58219820Sjeffmy $lft_line;
59219820Sjeff
60219820Sjeffmy $lids_per_port;
61219820Sjeffmy $lids_per_port_calculated;
62219820Sjeff
63219820Sjeffmy $iblinkinfo_regenerate = 0;
64219820Sjeff
65219820Sjeffmy $cache_file;
66219820Sjeff
67219820Sjeffsub usage
68219820Sjeff{
69219820Sjeff	my $prog = `basename $0`;
70219820Sjeff
71219820Sjeff	chomp($prog);
72219820Sjeff	print "Usage: $prog [-R -v]\n";
73219820Sjeff	print "  -R recalculate all cached information\n";
74219820Sjeff	print "  -v verbose output\n";
75219820Sjeff	exit 2;
76219820Sjeff}
77219820Sjeff
78219820Sjeffsub is_port_up
79219820Sjeff{
80219820Sjeff	my $iblinkinfo_output = $_[0];
81219820Sjeff	my $port              = $_[1];
82219820Sjeff	my $decport;
83219820Sjeff	my @lines;
84219820Sjeff	my $line;
85219820Sjeff
86219820Sjeff	$port =~ /0+(.+)/;
87219820Sjeff	$decport = $1;
88219820Sjeff
89219820Sjeff	# Add a space if necessary
90219820Sjeff	if ($decport >= 1 && $decport <= 9) {
91219820Sjeff		$decport = " $decport";
92219820Sjeff	}
93219820Sjeff
94219820Sjeff	@lines = split("\n", $iblinkinfo_output);
95219820Sjeff	foreach $line (@lines) {
96219820Sjeff		if ($line =~ /$decport\[..\]  ==/) {
97219820Sjeff			if ($line =~ /Down/) {
98219820Sjeff				return 0;
99219820Sjeff			}
100219820Sjeff		}
101219820Sjeff	}
102219820Sjeff	return 1;
103219820Sjeff}
104219820Sjeff
105219820Sjeffsub is_directly_connected
106219820Sjeff{
107219820Sjeff	my $iblinkinfo_output = $_[0];
108219820Sjeff	my $port              = $_[1];
109219820Sjeff	my $decport;
110219820Sjeff	my $str;
111219820Sjeff	my $rv = 0;
112219820Sjeff	my $host_tmp;
113219820Sjeff	my @lines;
114219820Sjeff	my $line;
115219820Sjeff
116219820Sjeff	if (($switch_port_count{$port} != $lids_per_port)
117219820Sjeff		|| !(@switch_maybe_directly_connected_hosts))
118219820Sjeff	{
119219820Sjeff		return $rv;
120219820Sjeff	}
121219820Sjeff
122219820Sjeff	$port =~ /0+(.+)/;
123219820Sjeff	$decport = $1;
124219820Sjeff
125219820Sjeff	# Add a space if necessary
126219820Sjeff	if ($decport >= 1 && $decport <= 9) {
127219820Sjeff		$decport = " $decport";
128219820Sjeff	}
129219820Sjeff
130219820Sjeff	@lines = split("\n", $iblinkinfo_output);
131219820Sjeff	foreach $line (@lines) {
132219820Sjeff		if ($line =~ /$decport\[..\]  ==/) {
133219820Sjeff			$str = $line;
134219820Sjeff		}
135219820Sjeff	}
136219820Sjeff
137219820Sjeff	if ($str =~ "Active") {
138219820Sjeff		$str =~
139219820Sjeff/[\d]+[\s]+[\d]+\[.+\]  \=\=.+\=\=>[\s]+[\d]+[\s]+[\d]+\[.+\] \"(.+)\".+/;
140219820Sjeff		for $host_tmp (@switch_maybe_directly_connected_hosts) {
141219820Sjeff			if ($1 == $host_tmp) {
142219820Sjeff				$rv = 1;
143219820Sjeff				last;
144219820Sjeff			}
145219820Sjeff		}
146219820Sjeff	}
147219820Sjeff
148219820Sjeff	return $rv;
149219820Sjeff}
150219820Sjeff
151219820Sjeffsub output_switch_port_usage
152219820Sjeff{
153219820Sjeff	my $min_usage = 999999;
154219820Sjeff	my $max_usage = 0;
155219820Sjeff	my @ports     = (
156219820Sjeff		"001", "002", "003", "004", "005", "006", "007", "008",
157219820Sjeff		"009", "010", "011", "012", "013", "014", "015", "016",
158219820Sjeff		"017", "018", "019", "020", "021", "022", "023", "024"
159219820Sjeff	);
160219820Sjeff	my @output_ports = ();
161219820Sjeff	my $port;
162219820Sjeff	my $iblinkinfo_output;
163219820Sjeff	my $ret;
164219820Sjeff
165219820Sjeff	# Run command once to reduce number of calls to iblinkinfo.pl
166219820Sjeff        if ($regenerate_cache && !$iblinkinfo_regenerate) {
167219820Sjeff            $iblinkinfo_output = `iblinkinfo.pl -R -S $switch_guid`;
168219820Sjeff            $iblinkinfo_regenerate++;
169219820Sjeff        }
170219820Sjeff        else {
171219820Sjeff            $iblinkinfo_output = `iblinkinfo.pl -S $switch_guid`;
172219820Sjeff        }
173219820Sjeff
174219820Sjeff	for $port (@ports) {
175219820Sjeff		if (!defined($switch_port_count{$port})) {
176219820Sjeff			$switch_port_count{$port} = 0;
177219820Sjeff		}
178219820Sjeff
179219820Sjeff		if ($switch_port_count{$port} == 0) {
180219820Sjeff			# If port is down, don't use it in this calculation
181219820Sjeff			$ret = is_port_up($iblinkinfo_output, $port);
182219820Sjeff			if ($ret == 0) {
183219820Sjeff				next;
184219820Sjeff			}
185219820Sjeff		}
186219820Sjeff
187219820Sjeff		# If port is directly connected to a node, don't use
188219820Sjeff		# it in this calculation.
189219820Sjeff		if (is_directly_connected($iblinkinfo_output, $port) == 1) {
190219820Sjeff			next;
191219820Sjeff		}
192219820Sjeff
193219820Sjeff		# Save off ports that should be output later
194219820Sjeff		push(@output_ports, $port);
195219820Sjeff
196219820Sjeff		if ($switch_port_count{$port} < $min_usage) {
197219820Sjeff			$min_usage = $switch_port_count{$port};
198219820Sjeff		}
199219820Sjeff		if ($switch_port_count{$port} > $max_usage) {
200219820Sjeff			$max_usage = $switch_port_count{$port};
201219820Sjeff		}
202219820Sjeff	}
203219820Sjeff
204219820Sjeff	if ($verbose || ($max_usage > ($min_usage + 1))) {
205219820Sjeff		if ($max_usage > ($min_usage + 1)) {
206219820Sjeff			print "Unbalanced Switch Port Usage: ";
207219820Sjeff			print "$switch_name, $switch_guid, $switch_lid\n";
208219820Sjeff		} else {
209219820Sjeff			print
210219820Sjeff			  "Switch Port Usage: $switch_name, $switch_guid, $switch_lid\n";
211219820Sjeff		}
212219820Sjeff		for $port (@output_ports) {
213219820Sjeff			print "Port $port: $switch_port_count{$port}\n";
214219820Sjeff		}
215219820Sjeff	}
216219820Sjeff}
217219820Sjeff
218219820Sjeffsub process_host_ports
219219820Sjeff{
220219820Sjeff	my $test_port;
221219820Sjeff	my $tmp;
222219820Sjeff	my $flag = 0;
223219820Sjeff
224219820Sjeff	if (@host_ports == $lids_per_port) {
225219820Sjeff		# Are all the host ports identical?
226219820Sjeff		$test_port = $host_ports[0];
227219820Sjeff		for $tmp (@host_ports) {
228219820Sjeff			if ($tmp != $test_port) {
229219820Sjeff				$flag = 1;
230219820Sjeff				last;
231219820Sjeff			}
232219820Sjeff		}
233219820Sjeff		# If all host ports are identical, maybe its directly
234219820Sjeff		# connected to a host.
235219820Sjeff		if ($flag == 0) {
236219820Sjeff			push(@switch_maybe_directly_connected_hosts, $host);
237219820Sjeff		}
238219820Sjeff	}
239219820Sjeff}
240219820Sjeff
241219820Sjeffif (!getopts("hRv")) {
242219820Sjeff	usage();
243219820Sjeff}
244219820Sjeff
245219820Sjeffif (defined($main::opt_h)) {
246219820Sjeff	usage();
247219820Sjeff}
248219820Sjeff
249219820Sjeffif (defined($main::opt_R)) {
250219820Sjeff	$regenerate_cache = 1;
251219820Sjeff}
252219820Sjeff
253219820Sjeffif (defined($main::opt_v)) {
254219820Sjeff	$verbose = 1;
255219820Sjeff}
256219820Sjeff
257219820Sjeff$cache_file = "$IBswcountlimits::cache_dir/dump_lfts.out";
258219820Sjeffif ($regenerate_cache || !(-f $cache_file)) {
259219820Sjeff	`dump_lfts.sh > $cache_file`;
260219820Sjeff	if ($? != 0) {
261219820Sjeff		die "Execution of dump_lfts.sh failed with errors\n";
262219820Sjeff	}
263219820Sjeff}
264219820Sjeff
265219820Sjeffif (!open(FH, "< $cache_file")) {
266219820Sjeff	print STDERR ("Couldn't open cache file: $cache_file: $!\n");
267219820Sjeff}
268219820Sjeff
269219820Sjeff@lft_lines = <FH>;
270219820Sjeff
271219820Sjeffforeach $lft_line (@lft_lines) {
272219820Sjeff	chomp($lft_line);
273219820Sjeff	if ($lft_line =~ /Unicast/) {
274219820Sjeff		$lft_line =~ /Unicast lids .+ of switch Lid (.+) guid (.+) \((.+)\)/;
275219820Sjeff		if (@host_ports) {
276219820Sjeff			process_host_ports();
277219820Sjeff		}
278219820Sjeff		if (defined($switch_name)) {
279219820Sjeff			output_switch_port_usage();
280219820Sjeff		}
281219820Sjeff		$switch_lid                            = $1;
282219820Sjeff		$switch_guid                           = $2;
283219820Sjeff		$switch_name                           = $3;
284219820Sjeff		@switch_maybe_directly_connected_hosts = ();
285219820Sjeff		%switch_port_count                     = ();
286219820Sjeff		@host_ports                            = ();
287219820Sjeff		$lids_per_port                         = 0;
288219820Sjeff		$lids_per_port_calculated              = 0;
289219820Sjeff	} elsif ($lft_line =~ /Channel/ || $lft_line =~ /Router/) {
290219820Sjeff		$lft_line =~ /.+ (.+) : \(.+ portguid .+: '(.+)'\)/;
291219820Sjeff		$host = $2;
292219820Sjeff		$switch_port_count{$1}++;
293219820Sjeff		if (@host_ports) {
294219820Sjeff			process_host_ports();
295219820Sjeff		}
296219820Sjeff		@host_ports = ($1);
297219820Sjeff
298219820Sjeff		if ($lids_per_port == 0) {
299219820Sjeff			$lids_per_port++;
300219820Sjeff		} else {
301219820Sjeff			$lids_per_port_calculated++;
302219820Sjeff		}
303219820Sjeff	} elsif ($lft_line =~ /path/) {
304219820Sjeff		$lft_line =~ /.+ (.+) : \(path #. out of .: portguid .+\)/;
305219820Sjeff		$switch_port_count{$1}++;
306219820Sjeff		if ($lids_per_port_calculated == 0) {
307219820Sjeff			$lids_per_port++;
308219820Sjeff		}
309219820Sjeff		push(@host_ports, $1);
310219820Sjeff	} else {
311219820Sjeff		if ($lids_per_port) {
312219820Sjeff			$lids_per_port_calculated++;
313219820Sjeff		}
314219820Sjeff		next;
315219820Sjeff	}
316219820Sjeff}
317219820Sjeff
318219820Sjeffif (@host_ports) {
319219820Sjeff	process_host_ports();
320219820Sjeff}
321219820Sjeffoutput_switch_port_usage();
322