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;
45
46my $regenerate_cache = 0;
47my $verbose          = 0;
48
49my $switch_lid                            = undef;
50my $switch_guid                           = undef;
51my $switch_name                           = undef;
52my %switch_port_count                     = ();
53my @switch_maybe_directly_connected_hosts = ();
54my $host                                  = undef;
55my @host_ports                            = ();
56
57my @lft_lines = ();
58my $lft_line;
59
60my $lids_per_port;
61my $lids_per_port_calculated;
62
63my $iblinkinfo_regenerate = 0;
64
65my $cache_file;
66
67sub usage
68{
69	my $prog = `basename $0`;
70
71	chomp($prog);
72	print "Usage: $prog [-R -v]\n";
73	print "  -R recalculate all cached information\n";
74	print "  -v verbose output\n";
75	exit 2;
76}
77
78sub is_port_up
79{
80	my $iblinkinfo_output = $_[0];
81	my $port              = $_[1];
82	my $decport;
83	my @lines;
84	my $line;
85
86	$port =~ /0+(.+)/;
87	$decport = $1;
88
89	# Add a space if necessary
90	if ($decport >= 1 && $decport <= 9) {
91		$decport = " $decport";
92	}
93
94	@lines = split("\n", $iblinkinfo_output);
95	foreach $line (@lines) {
96		if ($line =~ /$decport\[..\]  ==/) {
97			if ($line =~ /Down/) {
98				return 0;
99			}
100		}
101	}
102	return 1;
103}
104
105sub is_directly_connected
106{
107	my $iblinkinfo_output = $_[0];
108	my $port              = $_[1];
109	my $decport;
110	my $str;
111	my $rv = 0;
112	my $host_tmp;
113	my @lines;
114	my $line;
115
116	if (($switch_port_count{$port} != $lids_per_port)
117		|| !(@switch_maybe_directly_connected_hosts))
118	{
119		return $rv;
120	}
121
122	$port =~ /0+(.+)/;
123	$decport = $1;
124
125	# Add a space if necessary
126	if ($decport >= 1 && $decport <= 9) {
127		$decport = " $decport";
128	}
129
130	@lines = split("\n", $iblinkinfo_output);
131	foreach $line (@lines) {
132		if ($line =~ /$decport\[..\]  ==/) {
133			$str = $line;
134		}
135	}
136
137	if ($str =~ "Active") {
138		$str =~
139/[\d]+[\s]+[\d]+\[.+\]  \=\=.+\=\=>[\s]+[\d]+[\s]+[\d]+\[.+\] \"(.+)\".+/;
140		for $host_tmp (@switch_maybe_directly_connected_hosts) {
141			if ($1 == $host_tmp) {
142				$rv = 1;
143				last;
144			}
145		}
146	}
147
148	return $rv;
149}
150
151sub output_switch_port_usage
152{
153	my $min_usage = 999999;
154	my $max_usage = 0;
155	my @ports     = (
156		"001", "002", "003", "004", "005", "006", "007", "008",
157		"009", "010", "011", "012", "013", "014", "015", "016",
158		"017", "018", "019", "020", "021", "022", "023", "024"
159	);
160	my @output_ports = ();
161	my $port;
162	my $iblinkinfo_output;
163	my $ret;
164
165	# Run command once to reduce number of calls to iblinkinfo.pl
166        if ($regenerate_cache && !$iblinkinfo_regenerate) {
167            $iblinkinfo_output = `iblinkinfo.pl -R -S $switch_guid`;
168            $iblinkinfo_regenerate++;
169        }
170        else {
171            $iblinkinfo_output = `iblinkinfo.pl -S $switch_guid`;
172        }
173
174	for $port (@ports) {
175		if (!defined($switch_port_count{$port})) {
176			$switch_port_count{$port} = 0;
177		}
178
179		if ($switch_port_count{$port} == 0) {
180			# If port is down, don't use it in this calculation
181			$ret = is_port_up($iblinkinfo_output, $port);
182			if ($ret == 0) {
183				next;
184			}
185		}
186
187		# If port is directly connected to a node, don't use
188		# it in this calculation.
189		if (is_directly_connected($iblinkinfo_output, $port) == 1) {
190			next;
191		}
192
193		# Save off ports that should be output later
194		push(@output_ports, $port);
195
196		if ($switch_port_count{$port} < $min_usage) {
197			$min_usage = $switch_port_count{$port};
198		}
199		if ($switch_port_count{$port} > $max_usage) {
200			$max_usage = $switch_port_count{$port};
201		}
202	}
203
204	if ($verbose || ($max_usage > ($min_usage + 1))) {
205		if ($max_usage > ($min_usage + 1)) {
206			print "Unbalanced Switch Port Usage: ";
207			print "$switch_name, $switch_guid, $switch_lid\n";
208		} else {
209			print
210			  "Switch Port Usage: $switch_name, $switch_guid, $switch_lid\n";
211		}
212		for $port (@output_ports) {
213			print "Port $port: $switch_port_count{$port}\n";
214		}
215	}
216}
217
218sub process_host_ports
219{
220	my $test_port;
221	my $tmp;
222	my $flag = 0;
223
224	if (@host_ports == $lids_per_port) {
225		# Are all the host ports identical?
226		$test_port = $host_ports[0];
227		for $tmp (@host_ports) {
228			if ($tmp != $test_port) {
229				$flag = 1;
230				last;
231			}
232		}
233		# If all host ports are identical, maybe its directly
234		# connected to a host.
235		if ($flag == 0) {
236			push(@switch_maybe_directly_connected_hosts, $host);
237		}
238	}
239}
240
241if (!getopts("hRv")) {
242	usage();
243}
244
245if (defined($main::opt_h)) {
246	usage();
247}
248
249if (defined($main::opt_R)) {
250	$regenerate_cache = 1;
251}
252
253if (defined($main::opt_v)) {
254	$verbose = 1;
255}
256
257$cache_file = "$IBswcountlimits::cache_dir/dump_lfts.out";
258if ($regenerate_cache || !(-f $cache_file)) {
259	`dump_lfts.sh > $cache_file`;
260	if ($? != 0) {
261		die "Execution of dump_lfts.sh failed with errors\n";
262	}
263}
264
265if (!open(FH, "< $cache_file")) {
266	print STDERR ("Couldn't open cache file: $cache_file: $!\n");
267}
268
269@lft_lines = <FH>;
270
271foreach $lft_line (@lft_lines) {
272	chomp($lft_line);
273	if ($lft_line =~ /Unicast/) {
274		$lft_line =~ /Unicast lids .+ of switch Lid (.+) guid (.+) \((.+)\)/;
275		if (@host_ports) {
276			process_host_ports();
277		}
278		if (defined($switch_name)) {
279			output_switch_port_usage();
280		}
281		$switch_lid                            = $1;
282		$switch_guid                           = $2;
283		$switch_name                           = $3;
284		@switch_maybe_directly_connected_hosts = ();
285		%switch_port_count                     = ();
286		@host_ports                            = ();
287		$lids_per_port                         = 0;
288		$lids_per_port_calculated              = 0;
289	} elsif ($lft_line =~ /Channel/ || $lft_line =~ /Router/) {
290		$lft_line =~ /.+ (.+) : \(.+ portguid .+: '(.+)'\)/;
291		$host = $2;
292		$switch_port_count{$1}++;
293		if (@host_ports) {
294			process_host_ports();
295		}
296		@host_ports = ($1);
297
298		if ($lids_per_port == 0) {
299			$lids_per_port++;
300		} else {
301			$lids_per_port_calculated++;
302		}
303	} elsif ($lft_line =~ /path/) {
304		$lft_line =~ /.+ (.+) : \(path #. out of .: portguid .+\)/;
305		$switch_port_count{$1}++;
306		if ($lids_per_port_calculated == 0) {
307			$lids_per_port++;
308		}
309		push(@host_ports, $1);
310	} else {
311		if ($lids_per_port) {
312			$lids_per_port_calculated++;
313		}
314		next;
315	}
316}
317
318if (@host_ports) {
319	process_host_ports();
320}
321output_switch_port_usage();
322