Blob Blame History Raw
#!/usr/bin/perl
#
# Copyright (c) 2008 Voltaire, Inc. All rights reserved.
# Copyright (c) 2006 The Regents of the University of California.
#
# Produced at Lawrence Livermore National Laboratory.
# Written by Ira Weiny <weiny2@llnl.gov>.
#
# This software is available to you under a choice of one of two
# licenses.  You may choose to be licensed under the terms of the GNU
# General Public License (GPL) Version 2, available from the file
# COPYING in the main directory of this source tree, or the
# OpenIB.org BSD license below:
#
#     Redistribution and use in source and binary forms, with or
#     without modification, are permitted provided that the following
#     conditions are met:
#
#      - Redistributions of source code must retain the above
#        copyright notice, this list of conditions and the following
#        disclaimer.
#
#      - Redistributions in binary form must reproduce the above
#        copyright notice, this list of conditions and the following
#        disclaimer in the documentation and/or other materials
#        provided with the distribution.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
# ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
#

use strict;

use Getopt::Std;
use IBswcountlimits;

my $sw_addr = "";
my $sw_port = "";
my $verbose = undef;

# =========================================================================
#
sub print_verbose
{
	if ($verbose) {
		print $_[0];
	}
}

# =========================================================================
#
sub print_all_counts
{
	if (!$verbose) { return; }

	print "   Counter\t\t\tNew ==> Old\n";
	foreach my $cnt (@IBswcountlimits::counters) {
		print
"   $cnt\t\t\t$IBswcountlimits::new_counts{$cnt} ==> $IBswcountlimits::cur_counts{$cnt}\n";
	}
}

# =========================================================================
#
sub usage_and_exit
{
	my $prog = $_[0];
	print
	  "Usage: $prog [-p <pause_time> -b -v -n <cycles> -G] <guid|lid> <port>\n";
	print "   Attempt to diagnose a problem on a port\n";
	print
"   Run this on a link while a job is running which utilizes that link.\n";
	print
"   -p <pause_time> define the ammount of time between counter polls (default $IBswcountlimits::pause_time)\n";
	print "   -v Be verbose\n";
	print "   -n <cycles> run n cycles then exit (default -1 == forever)\n";
	print "   -G Address provided is a GUID\n";
	print "   -b report bytes/second packets/second\n";
	exit 2;
}

# =========================================================================
#
sub clear_counters
{
	# clear the counters
	foreach my $count (@IBswcountlimits::counters) {
		$IBswcountlimits::cur_counts{$count} = 0;
		$IBswcountlimits::new_counts{$count} = 0;
	}
}

# =========================================================================
#
sub mv_counts
{
	foreach my $count (@IBswcountlimits::counters) {
		$IBswcountlimits::cur_counts{$count} =
		  $IBswcountlimits::new_counts{$count};
	}
}

# =========================================================================
# use perfquery to get the counters.
my $GUID = "";

sub get_new_counts
{
	my $addr = $_[0];
	my $port = $_[1];
	mv_counts;
	ensure_cache_dir;
	if (
		system(
"perfquery $GUID $addr $port > $IBswcountlimits::cache_dir/perfquery.out"
		)
	  )
	{
		die "perfquery failed : \"perfquery $GUID $addr $port\"\n";
	}
	open PERF_QUERY, "<$IBswcountlimits::cache_dir/perfquery.out"
	  or die "cannot read '$IBswcountlimits::cache_dir/perfquery.out': $!\n";
	while (my $line = <PERF_QUERY>) {
		foreach my $count (@IBswcountlimits::counters) {
			if ($line =~ /^$count:\.+(\d+)/) {
				$IBswcountlimits::new_counts{$count} = $1;
			}
		}
	}
	close PERF_QUERY;
}

my $cycle = -1;    # forever

my $bytes_per_second = undef;
my $argv0            = `basename $0`;
chomp $argv0;
if (!getopts("hbvp:n:G"))        { usage_and_exit $argv0; }
if (defined $Getopt::Std::opt_h) { usage_and_exit $argv0; }
if (defined $Getopt::Std::opt_p) {
	$IBswcountlimits::pause_time = $Getopt::Std::opt_p;
}
if (defined $Getopt::Std::opt_v) { $verbose          = $Getopt::Std::opt_v; }
if (defined $Getopt::Std::opt_n) { $cycle            = $Getopt::Std::opt_n; }
if (defined $Getopt::Std::opt_G) { $GUID             = "-G"; }
if (defined $Getopt::Std::opt_b) { $bytes_per_second = $Getopt::Std::opt_b; }

my $sw_addr = $ARGV[0];
my $sw_port = $ARGV[1];

sub main
{
	clear_counters;
	get_new_counts($sw_addr, $sw_port);
	while ($cycle != 0) {
		print "Checking counts...\n";
		sleep($IBswcountlimits::pause_time);
		get_new_counts($sw_addr, $sw_port);
		check_counter_rates;
		if ($bytes_per_second) {
			print_data_rates;
		}
		print_all_counts;
		if ($cycle != -1) { $cycle = $cycle - 1; }
	}
}
main;