#!/usr/bin/perl
#==============================================================================
# Copyright IBM Corp. 2005, 2006.
#
# zfcpdbf ($Revision: 1.2.2.2 $)
#
# Script to analyse trace data of ZFCP module logged in DBF.
#
# Author(s): Maxim Shchetynin <maxim@de.ibm.com>
#
# This file is part of s390-tools
#
# s390-tools is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# s390-tools is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with s390-tools; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#==============================================================================

@PARAM_HELP				= qw(-h --help);
@PARAM_DEVICE				= qw(-d --device);
@PARAM_PATH				= qw(-p --path);
@PARAM_DATES				= qw(-D --dates);
@PARAM_SINGLELINE			= qw(-s --singleline);
@PARAM_COLOR				= qw(-c --color);
$PARAM_DEBUG_CT				= 'ct';
$PARAM_DEBUG_ELS			= 'els';
$PARAM_DEBUG_BAD			= 'bad';
@PARAM_VERBOSE				= qw(-V --verbose);
@PARAM_VERSION				= qw(-v --version);
$OFF					= 'off';
$ON					= 'on';
$TRACE_HBA				= 'hba';
$TRACE_SAN				= 'san';
$TRACE_SCSI				= 'scsi';

$DBF_PATH_PROCFS			= '/proc/s390dbf';
$DBF_PATH_DEBUGFS			= '/sys/kernel/debug/s390dbf';
$DBF_PREFIX				= 'zfcp_';
$DBF_FILE				= 'structured';

$MIN_KERNEL_VERSION			= "2.4.21";

$TAG_SIZE				= 4;

$DEVICE					= 'device';
$TIMESTAMP				= 'timestamp';
$TAG					= 'tag';
$SUBTAG					= 'tag2';
$FSF_REQ_ID				= 'fsf_reqid';
$FSF_REQ_SEQNO				= 'fsf_seqno';
$ABORT_FSF_REQ_ID			= 'abort_fsf_reqid';
$ABORT_FSF_REQ_SEQNO			= 'abort_fsf_seqno';
$NEW_FSF_REQ_ID				= 'new_fsf_reqid';
$NEW_FSF_REQ_SEQNO			= 'new_fsf_seqno';
$FSF_COMMAND				= 'fsf_command';
$PROT_STATUS				= 'fsf_prot_status';
$PROT_STATUS_QUAL			= 'fsf_prot_status_qual';
$FSF_STATUS				= 'fsf_status';
$FSF_STATUS_QUAL			= 'fsf_status_qual';
$FSF_REQUEST_STATUS			= 'fsf_req_status';
$FIRST_SBAL				= 'sbal_first';
$CURRENT_SBAL				= 'sbal_curr';
$LAST_SBAL				= 'sbal_last';
$LS_CODE				= 'ls_code';
$S_ID					= 's_id';
$D_ID					= 'd_id';
$WWPN					= 'wwpn';
$FCP_LUN				= 'fcp_lun';
$PORT_HANDLE				= 'port_handle';
$LUN_HANDLE				= 'lun_handle';
$SCSI_COMMAND				= 'scsi_cmnd';
$SCSI_SERIAL				= 'scsi_serial';
$SCSI_ID				= 'scsi_id';
$SCSI_LUN				= 'scsi_lun';
$SCSI_OPCODE				= 'scsi_opcode';
$SCSI_RETRIES				= 'scsi_retries';
$SCSI_ALLOWED				= 'scsi_allowed';
$FCP_RSP_VALIDITY			= 'fcp_rsp_validity';
$FCP_RSP_SCSI_STATUS			= 'fcp_rsp_scsi_status';
$FCP_RSP_RESIDUAL			= 'fcp_rsp_resid';
$FCP_RSP_CODE				= 'fcp_rsp_code';
$FCP_SNS_INFO_LEN			= 'fcp_sns_info_len';
$FCP_SNS_INFO				= 'fcp_sns_info';
$FAILED					= 'failed';
$STATUS_TYPE				= 'status_type';
$STATUS_SUBTYPE				= 'status_subtype';
$QUEUE_DESIGNATOR			= 'queue_designator';
$PAYLOAD				= 'payload';
$UNKNOWN				= 'unknown';

$TAG_CT_REQUEST				= 'octc';
$TAG_CT_RESPONSE			= 'rctc';
$TAG_ELS_REQUEST			= 'oels';
$TAG_ELS_RESPONSE			= 'rels';
$TAG_INCOMING_ELS			= 'iels';
$TAG_UNSOLICITED_STATUS			= 'stat';
$TAG_STATUS_READ			= 'read';
$TAG_DISMISSED				= 'dism';
$TAG_FAILED				= 'fail';
$TAG_QDIO				= 'qdio';
$TAG_FSF_REQ_RESPONSE			= 'resp';
$TAG_PROT_STATUS_ERROR			= 'perr';
$TAG_FSF_STATUS_ERROR			= 'ferr';
$TAG_STATUS_QUAL_AVAILABLE		= 'qual';
$TAG_FSF_REQUEST_TRACE			= 'norm';
$TAG_SCSI_COMPLETION			= 'rslt';
$TAG_SCSI_ABORT				= 'abrt';
$TAG_SCSI_TARGET_RESET			= 'trst';
$TAG_SCSI_RESET				= 'lrst';

my(%fsf_req_status) = (
	0x00000000,			'',
	0x00000001,			'',
	0x00000002,			'task management',
	0x00000004,			'completed',
	0x00000008,			'error',
	0x00000010,			'cleanup',
	0x00000020,			'aborting',
	0x00000040,			'abort succeeded',
	0x00000080,			'abort not needed',
	0x00000100,			'aborted',
	0x00000200,			'tm func failed',
	0x00000400,			'tm func not supported',
	0x00000800,			'retry',
	0x00001000,			'dismissed',
);

$QTCB_SEND_FCP_COMMAND			= 0x00000001;
$QTCB_ABORT_FCP_COMMAND			= 0x00000002;
$QTCB_OPEN_PORT				= 0x00000005;
$QTCB_OPEN_LUN				= 0x00000006;
$QTCB_CLOSE_LUN				= 0x00000007;
$QTCB_CLOSE_PORT			= 0x00000008;
$QTCB_CLOSE_PHYSICAL_PORT		= 0x00000009;
$QTCB_SEND_ELS				= 0x0000000B;
$QTCB_SEND_GENERIC			= 0x0000000C;
$QTCB_EXCHANGE_CONFIG_DATA		= 0x0000000D;
$QTCB_EXCHANGE_PORT_DATA		= 0x0000000E;
$QTCB_DOWNLOAD_CONTROL_FILE		= 0x00000012;
$QTCB_UPLOAD_CONTROL_FILE		= 0x00000013;

my(%fsf_command) = (
	$QTCB_SEND_FCP_COMMAND,		'send FCP command',
	$QTCB_ABORT_FCP_COMMAND,	'abort FCP command',
	$QTCB_OPEN_PORT,		'open port',
	$QTCB_OPEN_LUN,			'open unit',
	$QTCB_CLOSE_LUN,		'close unit',
	$QTCB_CLOSE_PORT,		'close port',
	$QTCB_CLOSE_PHYSICAL_PORT,	'close port physical',
	$QTCB_SEND_ELS,			'send ELS',
	$QTCB_SEND_GENERIC,		'send generic',
	$QTCB_EXCHANGE_CONFIG_DATA,	'exchange config data',
	$QTCB_EXCHANGE_PORT_DATA,	'exchange port data',
	$QTCB_DOWNLOAD_CONTROL_FILE,	'download control file',
	$QTCB_UPLOAD_CONTROL_FILE,	'upload control file'
);

$FSF_PROT_GOOD				= 0x00000001;
$FSF_PROT_QTCB_VERSION_ERROR		= 0x00000010;
$FSF_PROT_SEQ_NUMB_ERROR		= 0x00000020;
$FSF_PROT_UNSUPP_QTCB_TYPE		= 0x00000040;
$FSF_PROT_HOST_CONNECTION_INITIALIZING	= 0x00000080;
$FSF_PROT_FSF_STATUS_PRESENTED		= 0x00000100;
$FSF_PROT_DUPLICATE_REQUEST_ID		= 0x00000200;
$FSF_PROT_LINK_DOWN			= 0x00000400;
$FSF_PROT_REEST_QUEUE			= 0x00000800;
$FSF_PROT_ERROR_STATE			= 0x01000000;

my(%protocol_status) = (
	$FSF_PROT_GOOD,			'good',
	$FSF_PROT_QTCB_VERSION_ERROR,	'QTCB version error',
	$FSF_PROT_SEQ_NUMB_ERROR,	'sequence number error',
	$FSF_PROT_UNSUPP_QTCB_TYPE,	'unsupported QTCB type',
	$FSF_PROT_HOST_CONNECTION_INITIALIZING, 'host connection initializing',
	$FSF_PROT_FSF_STATUS_PRESENTED,	'FSF status presented',
	$FSF_PROT_DUPLICATE_REQUEST_ID,	'duplicate request ID',
	$FSF_PROT_LINK_DOWN,		'link down',
	$FSF_PROT_REEST_QUEUE,		'reestablished queue',
	$FSF_PROT_ERROR_STATE,		'error state'
);

$FSF_GOOD				= 0x00000000;
$FSF_PORT_ALREADY_OPEN			= 0x00000001;
$FSF_LUN_ALREADY_OPEN			= 0x00000002;
$FSF_PORT_HANDLE_NOT_VALID		= 0x00000003;
$FSF_LUN_HANDLE_NOT_VALID		= 0x00000004;
$FSF_HANDLE_MISMATCH			= 0x00000005;
$FSF_SERVICE_CLASS_NOT_SUPPORTED	= 0x00000006;
$FSF_FCPLUN_NOT_VALID			= 0x00000009;
$FSF_ACCESS_DENIED			= 0x00000010;
$FSF_ACCESS_TYPE_NOT_VALID		= 0x00000011;
$FSF_LUN_SHARING_VIOLATION		= 0x00000012;
$FSF_FCP_COMMAND_DOES_NOT_EXIST		= 0x00000022;
$FSF_DIRECTION_INDICATOR_NOT_VALID	= 0x00000030;
$FSF_CMND_LENGTH_NOT_VALID		= 0x00000033;
$FSF_MAXIMUM_NUMBER_OF_PORTS_EXCEEDED	= 0x00000040;
$FSF_MAXIMUM_NUMBER_OF_LUNS_EXCEEDED	= 0x00000041;
$FSF_ELS_COMMAND_REJECTED		= 0x00000050;
$FSF_GENERIC_COMMAND_REJECTED		= 0x00000051;
$FSF_OPERATION_PARTIALLY_SUCCESSFUL	= 0x00000052;
$FSF_AUTHORIZATION_FAILURE		= 0x00000053;
$FSF_ACT_ERROR_DETECTED			= 0x00000054;
$FSF_CONTROL_FILE_UPDATE_ERROR		= 0x00000055;
$FSF_CONTROL_FILE_TOO_LARGE		= 0x00000056;
$FSF_ACCESS_CONFLICT_DETECTED		= 0x00000057;
$FSF_CONFLICTS_OVERRULED		= 0x00000058;
$FSF_PORT_BOXED				= 0x00000059;
$FSF_LUN_BOXED				= 0x0000005A;
$FSF_EXCHANGE_CONFIG_DATA_INCOMPLETE	= 0x0000005B;
$FSF_PAYLOAD_SIZE_MISMATCH		= 0x00000060;
$FSF_REQUEST_SIZE_TOO_LARGE		= 0x00000061;
$FSF_RESPONSE_SIZE_TOO_LARGE		= 0x00000062;
$FSF_SBAL_MISMATCH			= 0x00000063;
$FSF_OPEN_PORT_WITHOUT_PRLI		= 0x00000064;
$FSF_ADAPTER_STATUS_AVAILABLE		= 0x000000AD;
$FSF_FCP_RSP_AVAILABLE			= 0x000000AF;
$FSF_UNKNOWN_COMMAND			= 0x000000E2;
$FSF_UNKNOWN_OP_SUBTYPE			= 0x000000E3;
$FSF_INVALID_COMMAND_OPTION		= 0x000000E5;

my(%fsf_status) = (
	$FSF_GOOD,
			'good',
	$FSF_PORT_ALREADY_OPEN,
			'port already open',
	$FSF_LUN_ALREADY_OPEN,
			'unit already open',
	$FSF_PORT_HANDLE_NOT_VALID,
			'port handle not valid',
	$FSF_LUN_HANDLE_NOT_VALID,
			'unit handle not valid',
	$FSF_HANDLE_MISMATCH,
			'handle mismatch',
	$FSF_SERVICE_CLASS_NOT_SUPPORTED,
			'service class not supported',
	$FSF_FCPLUN_NOT_VALID,
			'FCP LUN not valid',
	$FSF_ACCESS_DENIED,
			'access denied',
	$FSF_ACCESS_TYPE_NOT_VALID,
			'access type not valid',
	$FSF_LUN_SHARING_VIOLATION,
			'LUN sharing violation',
	$FSF_FCP_COMMAND_DOES_NOT_EXIST,
			'command does not exist',
	$FSF_DIRECTION_INDICATOR_NOT_VALID,
			'direction indicator not valid',
	$FSF_CMND_LENGTH_NOT_VALID,
			'command length not valid',
	$FSF_MAXIMUM_NUMBER_OF_PORTS_EXCEEDED,
			'max number of ports exceeded',
	$FSF_MAXIMUM_NUMBER_OF_LUNS_EXCEEDED,
			'max number of units exceeded',
	$FSF_ELS_COMMAND_REJECTED,
			'ELS rejected',
	$FSF_GENERIC_COMMAND_REJECTED,
			'generic command rejected',
	$FSF_OPERATION_PARTIALLY_SUCCESSFUL,
			'partially successful',
	$FSF_AUTHORIZATION_FAILURE,
			'authorization failure',
	$FSF_ACT_ERROR_DETECTED,
			'ACT error detected',
	$FSF_CONTROL_FILE_UPDATE_ERROR,
			'control file update error',
	$FSF_CONTROL_FILE_TOO_LARGE,
			'control file too large',
	$FSF_ACCESS_CONFLICT_DETECTED,
			'access conflict detected',
	$FSF_CONFLICTS_OVERRULED,
			'conflicts overruled',
	$FSF_PORT_BOXED,
			'port boxed',
	$FSF_LUN_BOXED,
			'unit boxed',
	$FSF_EXCHANGE_CONFIG_DATA_INCOMPLETE,
			'exchange config/port data incomplete',
	$FSF_PAYLOAD_SIZE_MISMATCH,
			'payload size mismatch',
	$FSF_REQUEST_SIZE_TOO_LARGE,
			'request too large',
	$FSF_RESPONSE_SIZE_TOO_LARGE,
			'response too large',
	$FSF_SBAL_MISMATCH,
			'SBAL mismatch',
	$FSF_OPEN_PORT_WITHOUT_PRLI,
			'open port without PRLI',
	$FSF_ADAPTER_STATUS_AVAILABLE,
			'adapter status available',
	$FSF_FCP_RSP_AVAILABLE,
			'FCP RSP available',
	$FSF_UNKNOWN_COMMAND,
			'unknown command',
	$FSF_UNKNOWN_OP_SUBTYPE,
			'unknown op subtype',
	$FSF_INVALID_COMMAND_OPTION,
			'invalid command option'
);

my(%unsolicited_status) = (
	0x00000001,			'port closed',
	0x00000002,			'incoming ELS',
	0x00000003,			'sense data available',
	0x00000004,			'bit error threshold',
	0x00000005,			'link down',
	0x00000006,			'link up',
	0x00000009,			'notification lost',
	0x0000000A,			'ACT updated',
	0x0000000B,			'ACT hardened'
);

my(%els) = (
	0x01,				'RJT',
	0x02,				'ACC',
	0x03,				'PLOGI',
	0x05,				'LOGO',
	0x0E,				'RTV',
	0x0F,				'RLS',
	0x50,				'PDISC',
	0x52,				'ADISC',
	0x61,				'RSCN',
	0x78,				'RNID',
	0x7A,				'RLIR'
);

$COLOR_DEFAULT				= "\033[m\017";
$COLOR_GREEN				= "\033[32m";
$COLOR_RED				= "\033[31m";

my(%color);

$NOTABOOL	= -1;
$FALSE		= 0;
$TRUE		= 1;

my($path, $device, $trace) =
	('', '*', '');
my($dates, $single_line, $color, $verbose) =
	($TRUE, $FALSE, $FALSE, $FALSE);
my($debug_ct, $debug_els, $debug_bad, $debug_unsol) =
	($TRUE, $FALSE, $TRUE, $TRUE);
my($from_year, $from_mon, $from_mday, $from_hour, $from_min, $from_sec) =
	(-1, -1, -1, -1, -1, -1);
my($to_year, $to_mon, $to_mday, $to_hour, $to_min, $to_sec) =
	(-1, -1, -1, -1, -1, -1);

my(@dbf_files, $single_device, %event_list, @filter);

sub fetch_parameters
{
	my($linux_release) = &kernel_version(`uname --release`);

	if ($linux_release < &kernel_version($MIN_KERNEL_VERSION)) {
		printf "zfcpdbf works only with kernel version %s or higher\n",
				$MIN_KERNEL_VERSION;
		exit;
	}

	for (my $index = 0; $index <= $#ARGV; $index++) {
		my($parameter, $value);
		if ((index $ARGV[$index], '=') != -1) {
			($parameter, $value) = split /\=/, $ARGV[$index];
		} elsif ($index < $#ARGV) {
			($parameter, $value) = ($ARGV[$index], $ARGV[$index + 1]);
		} else {
			($parameter, $value) = ($ARGV[$index], $TRUE);
		}

		my($switch);
		if ((($value cmp $OFF) == 0) || (($value cmp '0') == 0)) {
			$switch = $FALSE;
		} elsif ((($value cmp $ON) == 0) || (($value cmp '1') == 0)) {
			$switch = $TRUE;
		} else {
			$switch = $NOTABOOL;
		}

		if (($parameter cmp $PARAM_HELP[0]) == 0 ||
		         ($parameter cmp $PARAM_HELP[1]) == 0) {
			&print_help();
		} elsif (($parameter cmp $PARAM_VERSION[0]) == 0 ||
		         ($parameter cmp $PARAM_VERSION[1]) == 0) {
			&print_version();
		} elsif (($parameter cmp $PARAM_DEVICE[0]) == 0 ||
		         ($parameter cmp $PARAM_DEVICE[1]) == 0) {
			$device = $value;
		} elsif (($parameter cmp $PARAM_PATH[0]) == 0 ||
		         ($parameter cmp $PARAM_PATH[1]) == 0) {
			$path = $value;
		} elsif (($parameter cmp $TRACE_HBA) == 0 ||
		         ($parameter cmp $TRACE_SAN) == 0 ||
		         ($parameter cmp $TRACE_SCSI) == 0) {
			&print_help() unless length($trace) == 0;
			$trace = $parameter;
		} elsif (($parameter cmp $PARAM_DATES[0]) == 0 ||
		         ($parameter cmp $PARAM_DATES[1]) == 0) {
			&print_help() if $switch == $NOTABOOL;
			$dates = $switch;
		} elsif (($parameter cmp $PARAM_SINGLELINE[0]) == 0 ||
		         ($parameter cmp $PARAM_SINGLELINE[1]) == 0) {
			$single_line = $TRUE;
		} elsif (($parameter cmp $PARAM_COLOR[0]) == 0 ||
		         ($parameter cmp $PARAM_COLOR[1]) == 0) {
			$color = $TRUE;
		} elsif (($parameter cmp $PARAM_DEBUG_CT) == 0) {
			&print_help() if $switch == $NOTABOOL;
			$debug_ct = $switch;
		} elsif (($parameter cmp $PARAM_DEBUG_ELS) == 0) {
			&print_help() if $switch == $NOTABOOL;
			$debug_els = $switch;
		} elsif (($parameter cmp $PARAM_DEBUG_BAD) == 0) {
			&print_help() if $switch == $NOTABOOL;
			$debug_bad = $switch;
		} elsif (($parameter cmp $PARAM_VERBOSE[0]) == 0 ||
		         ($parameter cmp $PARAM_VERBOSE[1]) == 0) {
			$verbose = $TRUE;
		} else {
			push @filter, $parameter . '=' . $value;
		}
	}

	$trace = $TRACE_SAN if length($trace) == 0;

	if (length($path) > 0) {
		while (((substr $path, length($path) - 1, 1) cmp '/') == 0) {
			substr ($path, length($path) - 1, 1) = '';
		}
	} else {
		if ( -d $DBF_PATH_PROCFS) {
			$path = $DBF_PATH_PROCFS;
		} elsif ( -d $DBF_PATH_DEBUGFS) {
			$path = $DBF_PATH_DEBUGFS;
		}
	}

	if (($device cmp '*') != 0) {
		while (length($device) < 4) {
			$device = '0' . $device;
		}
	}

	if ( ! -d glob sprintf "%s/%s%s_*", $path, $DBF_PREFIX, $device) {
		if (($device cmp '*') != 0) {
			printf "No DBF files found for FCP adapter %s\n",
					$device;
		} else {
			print "No DBF files found\n";
		}
		exit;
	}

#	push @dbf_files, glob(sprintf "%s/%s%s_erp/%s",
#			$path, $DBF_PREFIX, $device, $DBF_FILE);
	push @dbf_files, glob(sprintf "%s/%s%s_hba/%s",
			$path, $DBF_PREFIX, $device, $DBF_FILE);
	push @dbf_files, glob(sprintf "%s/%s%s_san/%s",
			$path, $DBF_PREFIX, $device, $DBF_FILE);
	push @dbf_files, glob(sprintf "%s/%s%s_scsi/%s",
			$path, $DBF_PREFIX, $device, $DBF_FILE);

	if ($#dbf_files < 0) {
		print "No DBF files found\n";
		exit;
	}

	$single_device = $#dbf_files == 2;

	$from_year += 1900 if ($from_year != -1) && ($from_year < 100);
	$to_year   += 1900 if ($to_year   != -1) && ($to_year   < 100);
}

sub print_help
{
	printf "\n" .
"Usage: zfcpdbf [COMMAND] [OPTIONS]\n" .
"\n" .
"Sort debug data of all active or specified FCP adapter(s).\n" .
"  -h, --help                display this help and exit\n" .
"  -v, --version             display version information and exit\n" .
"commands:\n" .
"  hba                       trace all FSF requests\n" .
"  san                       trace SAN activity (default)\n" .
"  scsi                      trace SCSI- and corresponding FCP-commands\n" .
"options:\n" .
"  -d, --device=<device>     FCP adapter device number\n" .
"  -p, --path=<path>         specifiy path to DBF files\n" .
"  -D, --dates={off|on}      show date as well as time (default: %s)\n" .
#"  --ct={off|on}             trace send CT commands (default: %s)\n" .
#"  --els={off|on}            trace ELS commands and incoming ELS (default: %s)\n" .
#"  --baf={off|on}            trace all FSF commands with bad response (default: %s)\n" .
"  -s, --singleline          output in one line per event\n" .
"  -c, --color               colored output\n" .
"  -V, --verbose             verbose output\n" .
$dates; # $debug_ct, $debug_unsol, $debug_bad;
	exit;
}

sub print_version
{
	my($s390tools_version) = '%S390_TOOLS_VERSION%';
	printf "zfcpdbf: version %s.\n", $s390tools_version;
	printf "Copyright IBM Corp. 2005, 2006.\n";
	exit;
}

sub init
{
	&fetch_parameters();

	if ($color) {
		$color{'default'}   = $COLOR_DEFAULT;
		$color{'timestamp'} = $COLOR_GREEN;
		$color{'error'}     = $COLOR_RED;
	}
}

sub load
{
	foreach my $dbf_file (@dbf_files) {
		&die("Cannot open a DBF file $dbf_file!\n")
			unless open DBF, $dbf_file;
		while (<DBF>) {
			chomp;
			my($label, $timestamp) = split;
			my($tm, $ms) = split /\:/, $timestamp;
			my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) =
				gmtime($tm);
			$year += 1900;

			next if (($from_year != -1) && ($from_year > $year)) ||
			        (($to_year   != -1) && ($to_year   < $year));
			next if (($from_mon  != -1) && ($from_mon  > $mon )) ||
			        (($to_mon    != -1) && ($to_mon    < $mon ));
			next if (($from_mday != -1) && ($from_mday > $mday)) ||
			        (($to_mday   != -1) && ($to_mday   < $mday));
			next if (($from_hour != -1) && ($from_hour > $hour)) ||
			        (($to_hour   != -1) && ($to_hour   < $hour));
			next if (($from_min  != -1) && ($from_min  > $min )) ||
			        (($to_min    != -1) && ($to_min    < $min ));
			next if (($from_sec  != -1) && ($from_sec  > $sec )) ||
			        (($to_sec    != -1) && ($to_sec    < $sec ));

			my($event);
			if (!$single_device) {
				my($offset, $length);
				$offset  = length($path) + 1;
				$offset += index(substr($dbf_file, $offset), '_');
				$offset++;
				$length  = index(substr($dbf_file, $offset), '_');
				$event = $DEVICE . '=' . substr
						$dbf_file, $offset, $length;
			}

			my($tag_label) = $TAG;
			while (<DBF>) {
				chomp;
				my($string) = $_;
				last if length($string) == 0;

				my($label, $value);
				my($pos) = 0;
				$pos++ while (((substr $string, $pos, 1) cmp ' ') == 0);
				$label = substr($string, $pos, index(substr($string, $pos), ' '));
				$pos += length $label;
				$pos++ while (((substr $string, $pos, 1) cmp ' ') == 0);
				$value = substr($string, $pos);
				if (($label cmp $TAG) == 0) {
					$label = $tag_label;
					$tag_label = $SUBTAG;
				}
				$event .= ';' unless length $event == 0;
				$event .= $label . '=' . $value;
			}

			$event_list{$timestamp} = $event;
		}
	}
}

sub main
{
	if (($trace cmp $TRACE_HBA) == 0) {
		&trace_hba();
	} elsif (($trace cmp $TRACE_SAN) == 0) {
		&trace_san();
	} elsif (($trace cmp $TRACE_SCSI) == 0) {
		&trace_scsi();
	}
}

sub done
{
}

sub die
{
	printf "%s%s%s", $color{'error'}, @_, $color{'default'};
	exit -1;
}

sub print_label
{
	my($timestamp) = @_;

	if ($single_device) {
		return sprintf "%s%s%s",
				$color{'timestamp'},
				&print_time($timestamp),
				$color{'default'};
	} else {
		return sprintf "%s%s %s%s",
				$color{'timestamp'},
				&grep($event_list{$timestamp}, $DEVICE),
				&print_time($timestamp),
				$color{'default'};
	}
}

sub print_time
{
	my($timestamp) = @_;
	my($tm, $ms) = split /\:/, $timestamp;
	my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($tm);

	if ($dates) {
		$year += 1900;
		$mon += 1;
		return sprintf "%4d-%02d-%02d %02d:%02d:%02d.%09d",
				$year, $mon, $mday, $hour, $min, $sec, $ms;
	} else {
		return sprintf "%02d:%02d:%02d.%09d",
				$hour, $min, $sec, $ms;
	}
}


sub dbfprintf
{
	my(@argv) = @_;

	if ($single_line) {
		my($index);
		while (($index = index($argv[0], "\t")) != -1) {
			substr($argv[0], $index, 1) = "";
		}
		while (($index = index($argv[0], "\n")) != -1) {
			substr($argv[0], $index, 1) = "; ";
		}
		while (($index = index($argv[0], ",")) != -1) {
			substr($argv[0], $index, 1) = ";";
		}
	}

	printf @argv;
}


sub dbfprintcr
{
	print "\n" if $single_line;
}

sub trace_hba
{
	foreach my $timestamp (sort keys %event_list) {
		my($event) = $event_list{$timestamp};
		my($tag) = &tag($event);

		if (($debug_unsol) &&
		    ($tag cmp $TAG_UNSOLICITED_STATUS) == 0) {
			&dbfprintf("%s ", &print_label($timestamp));

			my($subtag) = &subtag($event);
			if (($subtag cmp $TAG_STATUS_READ) == 0) {
				my($status_type, $status_subtype) = (
					hex &grep($event, $STATUS_TYPE),
					hex &grep($event, $STATUS_SUBTYPE)
				);
				my($queue_designator) =
					&grep($event, $QUEUE_DESIGNATOR);

				&dbfprintf("unsolicited status '%s'",
						$unsolicited_status{$status_type});
				&dbfprintf(" subtype=0x%08X",
						$status_subtype)
					unless !$verbose && $status_subtype == 0;

				&dbfprintf("\n\tqueue designator='%s'",
						$queue_designator)
					unless !$verbose && &zarro($queue_designator);
			} elsif (($subtag cmp $TAG_DISMISSED) == 0) {
				&dbfprintf("status read request dismissed");
			} elsif (($subtag cmp $TAG_FAILED) == 0) {
				&dbfprintf("status read request failed");
				&dbfprintf("\n\t%d status read requests " .
						"failed on adapter",
						hex &grep($event, $FAILED));
			}

			my($payload) = &grep($event, $PAYLOAD);
			&dbfprintf("\n\tpayload='%s'",
					$payload)
				unless !$verbose && &zarro($payload);

			&dbfprintf("\n");
			&dbfprintcr;
			next;
		} elsif (($debug_bad) && (
		         (($tag cmp $TAG_PROT_STATUS_ERROR) == 0) ||
		         (($tag cmp $TAG_FSF_STATUS_ERROR) == 0) ||
		         (($tag cmp $TAG_STATUS_QUAL_AVAILABLE) == 0))) {
			my($fsf_command) = hex &grep($event, $FSF_COMMAND);
			my($prot_status, $prot_status_qual) = (
				hex &grep($event, $PROT_STATUS),
				    &grep($event, $PROT_STATUS_QUAL)
			);
			my($fsf_status, $fsf_status_qual) = (
				hex &grep($event, $FSF_STATUS),
				    &grep($event, $FSF_STATUS_QUAL)
			);

			&dbfprintf("%s response to '%s'\n",
					&print_label($timestamp),
					$fsf_command{$fsf_command});

			&dbfprintf("\tprotocol status='%s' FSF status='%s'\n",
					$protocol_status{$prot_status},
					$fsf_status{$fsf_status})
				unless !$verbose &&
				       $prot_status == $FSF_PROT_GOOD &&
				       $fsf_status == $FSF_GOOD;

			&dbfprintf("\tprotocol status qualifier='%s'\n",
					$prot_status_qual)
				unless !$verbose && &zarro($prot_status_qual);

			&dbfprintf("\tfsf status qualifier='%s'\n",
					$fsf_status_qual)
				unless !$verbose && &zarro($fsf_status_qual);

			&dbfprintcr;
			next;
		} elsif (($tag cmp $TAG_FSF_REQ_RESPONSE) != 0) {
			next;
		}

		my($fsf_req_id, $fsf_req_seqno, $fsf_command, $fsf_req_status) = (
			hex &grep($event, $FSF_REQ_ID),
			hex &grep($event, $FSF_REQ_SEQNO),
			hex &grep($event, $FSF_COMMAND),
			hex &grep($event, $FSF_REQUEST_STATUS)
		);
		my($prot_status, $prot_status_qual) = (
			hex &grep($event, $PROT_STATUS),
			    &grep($event, $PROT_STATUS_QUAL)
		);
		my($fsf_status, $fsf_status_qual) = (
			hex &grep($event, $FSF_STATUS),
			    &grep($event, $FSF_STATUS_QUAL)
		);
		my(@sbals) = (
			hex &grep($event, $FIRST_SBAL),
			hex &grep($event, $CURRENT_SBAL),
			hex &grep($event, $LAST_SBAL)
		);

		&dbfprintf("%s %s\n",
				&print_label($timestamp),
				$fsf_command{$fsf_command});

		&dbfprintf("\tprotocol status='%s' FSF status='%s'\n",
				$protocol_status{$prot_status},
				$fsf_status{$fsf_status})
			unless !$verbose &&
			       $prot_status == $FSF_PROT_GOOD &&
			       $fsf_status == $FSF_GOOD;

		&dbfprintf("\tprotocol status qualifier='%s'\n",
				$prot_status_qual)
			unless !$verbose && &zarro($prot_status_qual);

		&dbfprintf("\tFSF status qualifier='%s'\n",
				$fsf_status_qual)
			unless !$verbose && &zarro($fsf_status_qual);

		if ($verbose && $fsf_req_status != 0) {
			&dbfprintf("\tFSF request status");
			for (my($bit) = 1 << 31; $bit > 0; $bit >>= 1) {
				my($value) = $fsf_req_status & $bit;
				&dbfprintf(" '%s'", $fsf_req_status{$value})
					unless $value == 0;
			}
			&dbfprintf("\n");
		}
		&dbfprintf("\tSBAL=%d/%d/%d (first/current/last)\n",
				$sbals[0], $sbals[1], $sbals[2])
			unless !$verbose;

		if ($fsf_command == $QTCB_ABORT_FCP_COMMAND) {
			&dbfprintf("\tabort FSF request ID=%s seqno=%d\n",
					&grep($event, $ABORT_FSF_REQ_ID),
					hex &grep($event, $ABORT_FSF_REQ_SEQNO));
		} elsif (($fsf_command == $QTCB_OPEN_PORT) ||
		         ($fsf_command == $QTCB_CLOSE_PORT) ||
		         ($fsf_command == $QTCB_CLOSE_PHYSICAL_PORT)) {
			&dbfprintf("\tWWPN=%s D_ID=%s\n",
					&grep($event, $WWPN),
					&grep($event, $D_ID));
			&dbfprintf("\tport handle=%s\n",
					&grep($event, $PORT_HANDLE));
		} elsif (($fsf_command == $QTCB_OPEN_LUN) ||
		         ($fsf_command == $QTCB_CLOSE_LUN)) {
			&dbfprintf("\tWWPN=%s LUN=%s\n",
					&grep($event, $WWPN),
					&grep($event, $FCP_LUN));
			&dbfprintf("\tport handle=%s LUN handle=%s\n",
					&grep($event, $PORT_HANDLE),
					&grep($event, $LUN_HANDLE));
		} elsif ($fsf_command == $QTCB_SEND_ELS) {
			&dbfprintf("\tD_ID=%s LS code=%s\n",
					&grep($event, $D_ID),
					&grep($event, $PORT_HANDLE));
		}

		&dbfprintcr;
	}
}

sub trace_san
{
	foreach my $timestamp (sort keys %event_list) {
		my($event) = $event_list{$timestamp};
		my($tag) = &tag($event);

		if (($debug_ct) && (
		    (($tag cmp $TAG_CT_REQUEST) == 0) ||
		    (($tag cmp $TAG_CT_RESPONSE) == 0))) {
			my($s_id, $d_id) = (
				&grep($event, $S_ID),
				&grep($event, $D_ID)
			);

			&dbfprintf("%s %s -> %s CT %s\n",
					&print_label($timestamp),
					$s_id, $d_id,
					($tag cmp $TAG_CT_REQUEST) == 0 ?
					"request" : "response");

			&dbfprintf("\tFSF request=0x%x, seqno=%d\n",
					hex &grep($event, $FSF_REQ_ID),
					hex &grep($event, $FSF_REQ_SEQNO))
						if $verbose;
			&dbfprintcr;
		} elsif (($debug_els) && (
		         (($tag cmp $TAG_ELS_REQUEST) == 0) ||
		         (($tag cmp $TAG_ELS_RESPONSE) == 0))) {
			my($s_id, $d_id, $ls_code) = (
				    &grep($event, $S_ID),
				    &grep($event, $D_ID),
				hex &grep($event, $LS_CODE)
			);

			&dbfprintf("%s %s -> %s %s %s\n",
					&print_label($timestamp),
					$s_id, $d_id, $els{$ls_code},
					($tag cmp $TAG_ELS_REQUEST) == 0 ?
					"request" : "response");
			&dbfprintcr;
		} elsif (($debug_els) && (
		         ($tag cmp $TAG_INCOMING_ELS) == 0)) {
			my($s_id, $d_id, $ls_code) = (
				    &grep($event, $S_ID),
				    &grep($event, $D_ID),
				hex &grep($event, $LS_CODE)
			);

			&dbfprintf("%s %s -> %s incoming %s\n",
					&print_label($timestamp),
					$s_id, $d_id, $els{$ls_code});
			&dbfprintcr;
		}
	}
}

sub trace_scsi
{
	foreach my $scsi_timestamp (sort keys %event_list) {
		my($scsi_event, $fsf_event) =
			($event_list{$scsi_timestamp}, "");

		my($tag) = &grep($scsi_event, $TAG);
		next unless ($tag cmp $TAG_SCSI_COMPLETION) == 0 ||
		            ($tag cmp $TAG_SCSI_ABORT) == 0 ||
		            ($tag cmp $TAG_SCSI_TARGET_RESET) == 0 ||
		            ($tag cmp $TAG_SCSI_RESET) == 0;

		my($fsf_req_id, $fsf_req_seqno) = (
			hex &grep($scsi_event, $FSF_REQ_ID),
			hex &grep($scsi_event, $FSF_REQ_SEQNO)
		);

		foreach my $fsf_timestamp (sort keys %event_list) {
			my($sub_event) = $event_list{$fsf_timestamp};
			my($sub_fsf_req_id, $sub_fsf_req_seqno) = (
				hex &grep($sub_event, $FSF_REQ_ID),
				hex &grep($sub_event, $FSF_REQ_SEQNO)
			);
			if (($sub_fsf_req_id == $fsf_req_id) &&
		            ($sub_fsf_req_seqno == $fsf_req_seqno)) {
				$fsf_event = $sub_event;
				last;
			}
		}

		my($scsi_command, $scsi_serial, $scsi_id, $scsi_lun) = (
			hex &grep($scsi_event, $SCSI_COMMAND),
			hex &grep($scsi_event, $SCSI_SERIAL),
			hex &grep($scsi_event, $SCSI_ID),
			hex &grep($scsi_event, $SCSI_LUN)
		);
		my($scsi_retries, $scsi_allowed) = (
			hex &grep($scsi_event, $SCSI_RETRIES),
			hex &grep($scsi_event, $SCSI_ALLOWED)
		);
		my($rsp_validity, $rsp_scsi_status, $rsp_reidual, $rsp_code) = (
			hex &grep($scsi_event, $FCP_RSP_VALIDITY),
			hex &grep($scsi_event, $FCP_RSP_SCSI_STATUS),
			hex &grep($scsi_event, $FCP_RSP_RESIDUAL),
			hex &grep($scsi_event, $FCP_RSP_CODE)
		);
		my($sns_info, $sns_info_len) = (
			hex &grep($scsi_event, $FCP_SNS_INFO),
			hex &grep($scsi_event, $FCP_SNS_INFO_LEN)
		);
		my($fsf_command, $fsf_req_status) = (
			hex &grep($fsf_event, $FSF_COMMAND),
			hex &grep($fsf_event, $FSF_REQUEST_STATUS)
		);
		my($prot_status, $prot_status_qual) = (
			hex &grep($fsf_event, $PROT_STATUS),
			    &grep($fsf_event, $PROT_STATUS_QUAL)
		);
		my($fsf_status, $fsf_status_qual) = (
			hex &grep($fsf_event, $FSF_STATUS),
			    &grep($fsf_event, $FSF_STATUS_QUAL)
		);
		my(@sbals) = (
			hex &grep($fsf_event, $FIRST_SBAL),
			hex &grep($fsf_event, $CURRENT_SBAL),
			hex &grep($fsf_event, $LAST_SBAL)
		);

		&dbfprintf("%s SCSI serial=%d id=%d lun=%d command=0x%lx",
				&print_label($scsi_timestamp),
				$scsi_serial,
				$scsi_id,
				$scsi_lun,
				$scsi_command);
		&dbfprintf(" retry %d from %d",
				$scsi_retries,
				$scsi_allowed)
			unless !$verbose && $scsi_retries == 0;
		&dbfprintf("\n");


		if ($rsp_validity != 0) {
			&dbfprintf("\tFCP_RSP validity=0x%02X",
					$rsp_validity);
			&dbfprintf(" scsi_status=0x%02X",
					$rsp_scsi_status)
				unless !$verbose && $rsp_scsi_status == 0;
			&dbfprintf(" residual=%d",
					$rsp_reidual)
				unless !$verbose && $rsp_reidual == 0;
			&dbfprintf(" code=0x%08X",
					$rsp_code)
				unless !$verbose && $rsp_code == 0;
			&dbfprintf("\n");
		}

		&dbfprintf("\tFCP_SNS info=%s\n",
				$sns_info)
			unless !$verbose && $sns_info_len == 0;

		&dbfprintf("\tprotocol status='%s' FSF status='%s'\n",
				$protocol_status{$prot_status},
				$fsf_status{$fsf_status})
			unless !$verbose &&
			       $prot_status == $FSF_PROT_GOOD &&
			       $fsf_status == $FSF_GOOD;

		&dbfprintf("\tprotocol status qualifier='%s'\n",
				$prot_status_qual)
			unless !$verbose && &zarro($prot_status_qual);

		&dbfprintf("\tfsf status qualifier='%s'\n",
				$fsf_status_qual)
			unless !$verbose && &zarro($fsf_status_qual);

		if ($verbose && $fsf_req_status != 0) {
			&dbfprintf("\tfsf request status");
			for (my($bit) = 1 << 31; $bit > 0; $bit >>= 1) {
				my($value) = $fsf_req_status & $bit;
				&dbfprintf(" '%s'", $fsf_req_status{$value})
					unless $value == 0;
			}
			&dbfprintf("\n");
		}

		&dbfprintf("\tSBAL=%d/%d/%d (first/current/last)\n",
				$sbals[0], $sbals[1], $sbals[2])
					if $verbose;

		if ($fsf_command == $QTCB_ABORT_FCP_COMMAND) {
			&dbfprintf("\tabort fsf request id=%s seqno=%d\n",
					&grep($event, $ABORT_FSF_REQ_ID),
					hex &grep($event, $ABORT_FSF_REQ_SEQNO));
		}

		&dbfprintcr;
	}
}

sub tag
{
	my($event) = @_;
	return &grep($event, $TAG);
}

sub subtag
{
	my($event) = @_;
	return &grep($event, $SUBTAG);
}

sub is
{
	my($event, $field_name) = @_;
	my(@field_list) = split /\;/, $event;
	my($label, $value);

	foreach my $field (@field_list) {
		($label, $value) = split /\=/, $field;
		return 1 if ($label cmp $field_name) == 0;
	}
	return 0;
}

sub grep
{
	my($event, $field_name) = @_;
	my(@field_list) = split /\;/, $event;
	my($label, $value);

	foreach my $field (@field_list) {
		($label, $value) = split /\=/, $field;
		last if ($label cmp $field_name) == 0;
	}
	return (($label cmp $field_name) == 0) ? $value : $UNKNOWN;
}

sub zarro
{
	my($field) = @_;

	for (my $index = 0; $index < length($field); $index++) {
		my($char) = substr($field, $index, 1);
		return $FALSE if (($char != '0') && ($char != ' '));
	}
	return $TRUE;
}

sub kernel_version
{
	my($release) = @_;
	my($version, $patchlevel, $sublevel) = split /\./, $release;
	return (int $version << 16) + (int $patchlevel << 8) + (int $sublevel);
}

&init;
&load;
&main;
&done;
