#!/usr/bin/perl -w
# SPDX-License-Identifier: GPL-2.0-only
# Copyright (C) 2022-2023, Advanced Micro Devices, Inc.
# Copyright (C) 2019-2022, Xilinx, Inc.
# Copyright (C) 2007-2019, Solarflare Communications.

# Reporting tool for AMD Solarflare under linux

# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License version 2 as published
# by the Free Software Foundation, incorporated herein by reference.

use strict;

use File::Basename;
use FileHandle;
use POSIX;
use Socket;
use Getopt::Long;


# AMD Solarflare device/driver identifiers.
use constant driver_name_re => 'sfc\w*|onload|xilinx_efct';
use constant rpm_name_prefixes =>
    'kernel-module-sfc-', 'kmod-solarflare-sfc-', 'sfc-dkms', 'sfutils', 'onload', 'openonload', 'enterpriseonload', 'solar_capture', 'sfptp',
    'kernel-module-xilinx-efct', 'tcpdirect';
use constant deb_name_prefixes => 'sfc-modules-', 'xilinx-efct', 'onload', 'enterpriseonload', 'tcpdirect', 'sfptp';
use constant EFX_VENDID_SFC => 0x1924;
use constant EFX_VENDID_XILINX => 0x10ee;

# General formatting.
use constant format_text => 0;
use constant format_html => 1;
use constant format_minimal => 2;

# Table formatting.
use constant gutter_width => 2;
use constant orient_horiz => 0;
use constant orient_vert => 1;
use constant values_format_default => 0;
use constant values_format_pre => 1;

# Interest types.
use constant interest_error => 0;  # probable serious error
use constant interest_warn => 1;   # general warning
use constant interest_perf => 2;   # performance problem
use constant interest_badpkt => 3; # bad packet received

# CSS classes and text labels for interesting values.
my @interest_css_classes = ("error", "warn", "perf", "badpkt");
my @interest_labels = ("Error", "Warning", "Performance Warning",
		       "Bad Packet Warning");

my $VERSION = "4.17.1";
my $USER = "ROOT USER";
my $DATE = localtime();
my $UPTIME = '';

# Rules for what's interesting.
# Keys are pseudo-type names.  Values are arrays of pseudo-tuples of
# conditions and interest types.  Conditions are strings of the form
# attribute-name comparison-operator attribute-name or
# attribute-name comparison-operator integer.
my %interest_rules =
    (net_stats_sfc => [['rx_lt64 != 0', interest_badpkt],
		       ['rx_gtjumbo != 0', interest_badpkt],
		       ['rx_bad_gtjumbo != 0', interest_badpkt],
		       ['rx_bad_lt64 != 0', interest_badpkt],
		       ['rx_bad != 0', interest_badpkt],
		       ['rx_align_error != 0', interest_badpkt],
		       ['rx_symbol_error != 0', interest_badpkt],
		       ['rx_internal_error != 0', interest_error],
		       ['rx_length_error != 0', interest_badpkt],
		       ['tx_lt64 != 0', interest_error],
		       ['tx_gtjumbo != 0', interest_error],
		       ['tx_non_tcpudp != 0', interest_error],
		       ['tx_mac_src_error != 0', interest_error],
		       ['tx_ip_src_error != 0', interest_error],
		       # The following may be reported via ethtool
		       # or only through debugfs/procfs, depending
		       # on the driver version.
		       ['rx_nodesc_drop_cnt != 0', interest_perf],
 		       ['rx_nodesc_drops != 0', interest_perf],
		       ['rx_reset != 0', interest_warn],
		       ['rx_frm_trunc != 0', interest_perf],
		       ['rx_ip_hdr_chksum_err != 0', interest_badpkt],
		       ['rx_tcp_udp_chksum_err != 0', interest_badpkt],
		       ['rx_char_error_lane0 != 0', interest_error],
		       ['rx_char_error_lane1 != 0', interest_error],
		       ['rx_char_error_lane2 != 0', interest_error],
		       ['rx_char_error_lane3 != 0', interest_error],
		       ['rx_disp_error_lane0 != 0', interest_error],
		       ['rx_disp_error_lane1 != 0', interest_error],
		       ['rx_disp_error_lane2 != 0', interest_error],
		       ['rx_disp_error_lane3 != 0', interest_error],
		       ['rx_pm_trunc_bb_overflow != 0', interest_error],
		       ['rx_pm_discard_bb_overflow != 0', interest_error],
		       ['rx_pm_trunc_vfifo_full != 0', interest_perf],
		       ['rx_pm_discard_vfifo_full != 0', interest_perf],
		       ['rx_pm_trunc_qbb != 0', interest_error],
		       ['rx_pm_discard_qbb != 0', interest_error],
		       ['rx_pm_discard_mapping != 0', interest_warn],
		       ['rx_dp_q_disabled_packets != 0', interest_warn]],
     sfc_nic => [['n_rx_nodesc_drop_cnt != 0', interest_perf]],
     sfc_errors => [['rx_reset != 0', interest_warn]],
     sfc_eventqueue => [['n_rx_frm_trunc != 0', interest_perf],
			['n_rx_ip_hdr_chksum_err != 0', interest_badpkt],
			['n_rx_tcp_udp_chksum_err != 0', interest_badpkt],
            ['n_rx_overlength != 0', interest_badpkt]],
     interesting_devices => [['device_id eq "10ee:5086"', interest_warn],
            ['device_id eq "10ee:5074"', interest_warn]],
     pci_errors => [['aer_dev_correctable_TOTAL_ERR_COR != 0', interest_warn],
            ['aer_dev_fatal_TOTAL_ERR_FATAL != 0', interest_error],
            ['aer_dev_nonfatal_TOTAL_ERR_NONFATAL != 0', interest_error],
            ['aer_rootport_total_err_cor != 0', interest_warn],
            ['aer_rootport_total_err_fatal != 0', interest_error],
            ['aer_rootport_total_err_nonfatal != 0', interest_error]]);

# Extend $interest_rules{'net_stats_sfc'} to have port_ variants
my @orig_net_stats_sfc = @{$interest_rules{'net_stats_sfc'}};
foreach(@orig_net_stats_sfc) {
    my $port_rule = [ "port_" . $_->[0], $_->[1] ];
    push @{$interest_rules{'net_stats_sfc'}}, $port_rule;
}

my ($os_type, $hostname, $os_release, $os_version, $arch) = POSIX::uname();
my $arch_is_x86 = ($arch =~ /^(?:i[x3456]86|(?:x86[-_]|amd)64)$/);
my $arch_is_powerpc = ($arch =~ /^p(?:ower)?pc(?:64)?$/);

# Structure is a base class for wrapping C structures.

package Structure;

use overload '""' => \&_pack;

sub new {
    my $class = shift;
    my $data = ($#_ == 0) ? shift : '';
    my $self = bless({_data => pack('a' . $class->_structure_len, $data)},
		     $class);
    while ($#_ > 0) {
	my $name = shift;
	my $value = shift;
	_set($self, $name, $value);
    }
    return $self;
}

sub _pack {
    my $self = shift;
    return $self->{_data};
}

sub _get {
    my ($self, $name) = @_;
    my $class = ref($self);
    my $field_def = $self->_structure_fields->{$name};
    if (defined($field_def)) {
	my ($offset, $format) = @$field_def;
	return unpack($format, substr($self->{_data}, $offset));
    }
}

sub _set {
    my ($self, $name, $value) = @_;
    my $class = ref($self);
    my $field_def = $self->_structure_fields->{$name};
    if (defined($field_def)) {
	my ($offset, $format) = @$field_def;
	my $packed_value = pack($format, ($format =~ /^P/) ? $$value : $value);
	substr($self->{_data}, $offset, length($packed_value)) = $packed_value;
    }
}

sub AUTOLOAD {
    my $self = shift;
    my $class = ref($self);
    my $name = $Structure::AUTOLOAD;
    $name =~ s/^\w+:://;
    if ($#_ < 0) {
	return _get($self, $name);
    } else {
	return _set($self, $name, @_);
    }
}

package Ifreq;

use base qw(Structure);
use constant _structure_fields => {ifr_name => [0, 'Z16'],
				   ifr_hwaddr => [16, 'SC14'],
				   ifr_addr => [16, 'SC14'],
				   ifr_dstaddr => [16, 'SC14'],
				   ifr_broadaddr => [16, 'SC14'],
				   ifr_netmask => [16, 'SC14'],
				   ifr_flags => [16, 's'],
				   ifr_mtu => [16, 'i!'],
				   ifr_map => [16, 'L!L!SCCC'],
				   ifr_slave => [16, 'Z16'],
				   ifr_data => [16, 'P44'],
				   ifr_ifindex => [16, 'i!'],
				   ifr_bandwidth => [16, 'i!'],
				   ifr_qlen => [16, 'i!'],
				   ifr_newname => [16, 'Z16']};
use constant _structure_len => 32;

my $socket;
sub get_socket {
    use Socket;
    if (!defined($socket)) {
	$socket = new FileHandle;
	socket($socket, PF_INET, SOCK_STREAM, 0) or die "socket: $!";
    }
    return $socket;
}

package EthtoolDrvinfo;
use base qw(Structure);
use constant _structure_fields => {cmd => [0, 'L'],
				   driver => [4, 'Z32'],
				   version => [36, 'Z32'],
				   fw_version => [68, 'Z32'],
				   bus_info => [100, 'Z32'],
				   n_priv_flags => [176, 'L'],
				   n_stats => [180, 'L'],
				   testinfo_len => [184, 'L'],
				   eedump_len => [188, 'L'],
				   regdump_len => [192, 'L']};
use constant _structure_len => 196;

package Ethtool;

use constant SIOCETHTOOL => 0x8946;
use constant ETHTOOL_GDRVINFO => 0x00000003;
# ... to be continued

sub do_cmd {
    my ($if_name, $ecmd) = @_;
    my $ecmd_blob = "$ecmd";
    my $ifreq = new Ifreq(ifr_name => $if_name, ifr_data => \$ecmd_blob);
    return undef unless ioctl(Ifreq::get_socket(), SIOCETHTOOL, $ifreq);
    # Construct a new wrapper of the same type
    return ref($ecmd)->new($ecmd_blob);
}

package EfxSockIoctl;
use base qw(Structure);
use constant _structure_fields => {cmd => [0, 'S'],
				   u => [4, 'a1000']};
use constant _structure_len => 1004; # this is quite arbitrary

use constant SIOCEFX => 0x89f3;
use constant EFX_GET_TS_CONFIG => 0xef25;
# ... to be continued

package HwtstampConfig;
use base qw(Structure);
use constant _structure_fields => {flags => [0, 'i'],
				   tx_type => [4, 'i'],
				   rx_filter => [8, 'i']};
use constant _structure_len => 12;

use constant SIOCGHWTSTAMP => 0x89b1;

package main;

# Some utility functions we need.

# Tell whether the given string starts with the given prefix string.
sub startswith {
    my ($s, $prefix) = @_;
    return substr($s, 0, length($prefix)) eq $prefix;
}

sub max {
    my $result;
    for (@_) {
	if (!defined($result) || $_ > $result) {
	    $result = $_;
	}
    }
    $result;
}

# Return sum of a sequence of numbers.
sub sum {
    my $result = 0;
    for (@_) {
	$result += $_;
    }
    $result;
}

sub first_defined {
    for (@_) {
	return $_ if defined($_);
    }
}

sub pairs {
    use integer;
    my @result;
    for my $i (0 .. $#_ / 2) {
	push @result, [$_[2 * $i], $_[2 * $i + 1]];
    }
    return @result;
}

sub html_encode {
    my $result = shift;
    $result =~ s/([\&<\'\"])/'&#'.ord($1).';'/eg;
    return $result;
}

my $out_file;
my $out_format = format_text;
my @interesting_stuff = ();

# Print a table of values and apply interest rules to them.
# title       title string to show above the table
# type_name   (pseudo-)type name of values (may be undef)
# attributes  ref to array of names for the attributes to show in columns
# values      ref to array of values to show in rows;
#             each value is a ref to an array with values in the same
#             order as the given names
# orientation if orient_horiz, values are in rows;
#             if orient_vert, values are in columns
# values_fmt  if values_format_pre, values are preformatted text
#             if values_format_default, use default formatting
# id          heading id
# hidden      if the heading should be hidden by default
sub tabulate {
    my ($title, $type_name, $attributes, $values, $orientation, $values_fmt, $id, $hidden) = @_;
    my @col_widths;
    my @cell_texts;
    my @cell_interest;

    $orientation = orient_horiz unless defined($orientation);
    $orientation == orient_horiz or $orientation == orient_vert or die;
    $values_fmt = values_format_default unless defined($values_fmt);
    $values_fmt == values_format_default
      or $values_fmt == values_format_pre
      or die;

    for my $j (0..$#$attributes) {
	my $cell_text = $attributes->[$j];
	my ($x, $y);
	if ($orientation == orient_horiz) {
	    ($x, $y) = ($j, 0);
	} else {
	    ($x, $y) = (0, $j);
	}
	$cell_texts[$y]->[$x] = $cell_text;
	$col_widths[$x] = max($col_widths[$x] || 0, length($cell_text));
    }
    for my $i (0..$#$values) {
	my $value = $values->[$i];
    my $context;
    if (ref($value) eq 'HASH') {
        $context = $value->{$attributes->[0]};
    } elsif (ref($value) eq 'ARRAY') {
        $context = $value->[0];
    }
	my $value_interest = apply_interest_rules($type_name, $value, $context);
	for my $j (0..$#$attributes) {
	    my $attr_value;
	    if (ref($value) eq 'HASH') {
		$attr_value = $value->{$attributes->[$j]};
	    } elsif (ref($value) eq 'ARRAY') {
		$attr_value = $value->[$j];
	    }
	    my $cell_text = defined($attr_value) ? $attr_value : "<N/A>";
	    my ($x, $y);
	    if ($orientation == orient_horiz) {
		($x, $y) = ($j, 1 + $i);
	    } else {
		($x, $y) = (1 + $i, $j);
	    }
	    $cell_texts[$y]->[$x] = $cell_text;
	    if (exists($value_interest->{$attributes->[$j]})) {
		$cell_interest[$y]->[$x] =
		    $value_interest->{$attributes->[$j]};
	    }
	    $col_widths[$x] = max($col_widths[$x] || 0, length($cell_text));
	}
    }

    print_heading($title, $id, $hidden);

    if ($out_format == format_html) {
	$out_file->print("    <table class="
			 .($orientation == orient_horiz ? 'horiz' : 'vert')
			 .">\n");
	for my $y (0..$#cell_texts) {
	    $out_file->print("      <tr>\n");
	    for my $x (0..$#{$cell_texts[$y]}) {
		my $head_cell = ($orientation == orient_horiz ? $y : $x) == 0;
		my $elem_name = $head_cell ? 'th' : 'td';
		my $cell_text = $cell_texts[$y]->[$x];
		$out_file->print("        <$elem_name");
		# If this cell is interesting, style it accordingly
		# and define an identifier so the summary can link to
		# it.
		if (defined($cell_interest[$y]->[$x])) {
		    $out_file->print(" class="
				     . ($interest_css_classes
					[$cell_interest[$y]->[$x]->[0]])
				     . " id=match" .
				     $cell_interest[$y]->[$x]->[1]);
		}
		$out_file->print(">");
		if (!$head_cell && $values_fmt == values_format_pre) {
			print_preformatted($cell_text);
		} else {
			$out_file->print(html_encode($cell_text));
		}
		$out_file->print("</$elem_name>\n");
	    }
	    if ($orientation == orient_vert && $#$values == -1 && $y == 0) {
		$out_file->print("        <td rowspan=".($#$attributes + 1).">"
				 ."<em>none found</em></td>\n");
	    }
	    $out_file->print("      </tr>\n");
	}
	if ($orientation == orient_horiz && $#$values == -1
	    && $#$attributes >= 0) {
	    $out_file->print("      <tr>\n"
			     ."       <td colspan=".($#$attributes + 1).">"
			     ."<em>none found</em></td>\n"
			     ."     </tr>\n");
	} elsif ($#$values == -1 && $#$attributes == -1) {
	    $out_file->print("      <tr><td><em>none found</em></td></tr>\n");
	}
	$out_file->print("    </table>\n");
    } else {
	for my $y (0..$#cell_texts) {
	    my $row = '';
	    for my $x (0..$#{$cell_texts[$y]}) {
		my $cell_text = $cell_texts[$y]->[$x];
		my $pad = $col_widths[$x] - length($cell_text);
		$row .= $cell_text . (' ' x ($pad + gutter_width));
		if ($orientation == orient_vert && $x == 0) {
		    $row = substr($row, 0, -1) . '| ';
		}
	    }
	    if ($orientation == orient_vert && $#$values == -1 && $y == 0) {
		$row .= ' ' x gutter_width . 'none found';
	    }
	    $out_file->print("$row\n");
	    if ($orientation == orient_horiz && $y == 0
		&& $#$attributes >= 0) {
		my $table_width = (sum(@col_widths)
				   + gutter_width * $#$attributes);
		$out_file->print('=' x $table_width . "\n");
	    }
	}
	if (($orientation == orient_horiz || $#$attributes == -1)
	    && $#$values == -1) {
	    $out_file->print("none found\n");
	}
	$out_file->print("\n");
    }
    
  if ( $id ) {
    print_footer( $id );
  }
}

sub print_text {
    my $text = shift;
    $out_file->print($out_format == format_html ? html_encode($text) : $text);
}

sub print_heading {
    my $text = shift;
    my $id = shift;
    my $hide = shift;
    my $display = 'block';
    my $link = ' Hide...';
    if ( $hide ) {
      $display = 'none';
      $link = ' ...Show';
    }
    if ($out_format == format_html) {
      if ( $id ) {
        $out_file->print("<table rows=1 cols=2 style='border:none;'><tr style='border:none;'><td style='border:none;'>");
        $out_file->print("<a name='$id'><h2>".html_encode($text)."</h2></name></td>");
        $out_file->print("<td style='border:none;'><a id='$id\_l' href='\#$id' onclick='toggle(\"$id\"); return false;'>$link</a></td></tr></table>\n");
        $out_file->print("<div style='display:$display' id='$id\_c'>\n");
      } else {
        $out_file->print("    <h2>".html_encode($text)."</h2>\n");
      }
    } else {
      $out_file->print("$text\n\n");
    }
}

sub print_footer {
  my $id = shift;
  if ($out_format == format_html) {
    if ( $id ) {
      $out_file->print("<a href='\#$id' onclick='toggle(\"$id\");'>Hide $id</a><br>\n");
    }
    $out_file->print("</div>\n");
  }
}

sub print_reference {
    my $text = shift;
    my $id = shift;
    if ($out_format == format_html) {
        $out_file->print("<a href='#$id'>$text</a>");
        $out_file->print("</div>\n");
    }
}

sub print_bold {
    my $text = shift;
        if ($out_format == format_html) {
            $out_file->print("    <h4>".html_encode($text)."</h4>\n");
    } else {
        $out_file->print("$text\n\n");
    }

}

sub print_warning {
    my $text = shift;
    if ($out_format == format_html) {
	$out_file->print("    <p><em>".html_encode($text)."</em></p>\n");
    } else {
	$out_file->print("$text\n\n");
    }
}

sub begin_preformatted {
    my $use_delimiters = shift;
    if ($out_format == format_html) {
	$out_file->print("    <pre>");
    } elsif ($use_delimiters) {
	$out_file->print("--- BEGIN ---\n");
    }
}

sub end_preformatted {
    my $use_delimiters = shift;
    if ($out_format == format_html) {
	$out_file->print("</pre>\n");
    } elsif ($use_delimiters) {
	$out_file->print("--- END ---\n\n");
    } else {
	$out_file->print("\n");
    }
}

sub print_preformatted {
    my ($text, $use_delimiters) = @_;
    begin_preformatted($use_delimiters);
    print_text($text);
    end_preformatted($use_delimiters);
}

# Return the entire contents of a binary file as a string.
# Return undef on failure.
sub read_file {
    my ($path, $offset) = @_;
    my $result;
    my $fd = POSIX::open($path, &POSIX::O_RDONLY);
    if (defined($fd)) {
	if (defined($offset)) {
	    POSIX::lseek($fd, $offset, 0);
	}
	$result = '';
	my ($buf, $length);
	$! = 0;
	while (($length = POSIX::read($fd, $buf, 65536))
	       && $length != 0) {
	    $result .= substr($buf, 0, $length);
	}
	my $saved_errno = $!;
	POSIX::close($fd);
	if ($! = $saved_errno) {
	    $result = undef;
	}
    }
    return $result;
}

# Return a reference to an array of the names in a directory.
# Return undef on failure.
sub list_dir {
    my ($path) = @_;
    my $result;
    if (my $dir = POSIX::opendir($path)) {
	$! = 0;
	my @result = grep(!/^\.\.?$/, readdir($dir));
	@result = reverse(@result);
	my $saved_errno = $!;
	POSIX::closedir($dir);
	$! = $saved_errno;
	$result = $! ? undef : \@result;
    }
    return $result;
}

# Return a reference to an array of file names and contents found in
# a directory.  The optional name_filter parameter is used to check
# whether a file of the given name should be included.  The optional
# value_map is used to modify the value.
sub read_dir_files {
    my ($dir_path, $name_filter, $value_map) = @_;
    my $result;
    if (my $list = list_dir($dir_path)) {
	$result = [];
	for (@$list) {
	    my $file_path = "$dir_path/$_";
	    if (-f $file_path
		&& (!defined($name_filter) || &$name_filter())) {
		my $name = $_;
		local $_ = read_file($file_path);
		&$value_map() if defined($value_map) && defined($_);
		push @$result, [$name, $_];
	    }
	}
    }
    return $result;
}

sub find_sfc_debug_dir {
    my @sfc_paths = ();
    for my $path ('/proc/driver', '/debug', '/sys/kernel/debug') {
	for my $driver ('sfc', 'sfc_ef100') {
	    push @sfc_paths, "$path/$driver" if -d "$path/$driver";
	}
    }
    return @sfc_paths;
}

sub find_x3_debug_dir {
	my @xlnx_paths = ();
	for my $path ('/proc/driver', '/debug', '/sys/kernel/debug') {
	for my $driver ('xilinx_efct') {
		push @xlnx_paths, "$path/$driver" if -d "$path/$driver";
	}
	}
	return @xlnx_paths;
}

sub get_sfc_drvinfo {
    my %sfc_drvinfo;
    my $sfc_present = 0;
    if (my $list = list_dir('/sys/class/net')) {
	for my $iface_name (@$list) {
	    my $drvinfo = Ethtool::do_cmd(
		$iface_name,
		new EthtoolDrvinfo(cmd => Ethtool::ETHTOOL_GDRVINFO));
		next unless defined($drvinfo);
		if ($drvinfo->driver eq 'sfc' || $drvinfo->driver eq 'sfc_ef100' || $drvinfo->driver eq 'xilinx_efct') {
		$sfc_drvinfo{$iface_name} = $drvinfo;
	    }
        if ($drvinfo->driver eq 'sfc' && !(my $test = new FileHandle("sfupdate 2>&1 |")) && !($sfc_present)) {
            STDERR->print("INFO: Unable to run sfutils (sfkey, sfboot) commands while sfc driver is loaded. "
                        ."X2xxx and 8xxx series NIC configuration and licensing information are unavailable.\n");
            $sfc_present = 1;
	    }
	}
    }
    return \%sfc_drvinfo;
}

sub get_hwtstamp_config {
    my $iface_name = shift;
    my $config = new HwtstampConfig;
    my $config_blob = "$config";
    my $ifreq = new Ifreq(ifr_name => $iface_name);

    # Standard ioctl
    $ifreq->ifr_data(\$config_blob);
    if (ioctl(Ifreq::get_socket(), HwtstampConfig::SIOCGHWTSTAMP, "$ifreq")) {
	return new HwtstampConfig($config_blob);
    }

    # Private ioctl
    my $efxsi = new EfxSockIoctl(cmd => EfxSockIoctl::EFX_GET_TS_CONFIG);
    my $efxsi_blob = "$efxsi";
    $ifreq->ifr_data(\$efxsi_blob);
    if (ioctl(Ifreq::get_socket(), EfxSockIoctl::SIOCEFX, "$ifreq")) {
	$efxsi = new EfxSockIoctl($efxsi_blob);
	return new HwtstampConfig($efxsi->u);
    }

    return undef;
}

sub get_iface_bus_addr {
    my $iface_name = shift;
    if (my $device_path = readlink("/sys/class/net/$iface_name/device")) {
	return File::Basename::basename($device_path);
    } else {
	return undef;
    }
}

sub get_iface_mac_addr {
    my $iface_name = shift;
    if (my $dev_addr = read_file("/sys/class/net/$iface_name/address")) {
        $dev_addr =~ s/\n//s;
        return $dev_addr;
    } else {
        return undef;
    }
}

sub get_onload_version {
    my $onload_ver;
    if (my $module_ver = read_file("/sys/module/onload/version")) {
        $module_ver =~ s/\n//s;
	$onload_ver = $module_ver;
    } else {
        $onload_ver = 'N/A';
    }
    return $onload_ver;
}

sub get_xilinx_efct_version {
    my $efct_ver;
    if (my $module_ver = read_file("/sys/module/xilinx_efct/version")) {
        $module_ver =~ s/\n//s;
	$efct_ver = $module_ver;
    } else {
        $efct_ver = 'N/A';
    }
    return $efct_ver;
}

sub get_linux_cpuinfo {
    my @log_procs;
    my $log_id;
    my $cpus_dir = '/sys/devices/system/cpu';
    my $nodes_dir = '/sys/devices/system/node';
    my %x86_cpuinfo_map = (
	'cpu family'	=> 'family',
	'model'		=> 'model',
	'cpu variation'	=> 'variation',
	'stepping'	=> 'stepping',
	'vendor_id'	=> 'vendor',
	'model name'	=> 'full_name',
	'cpu MHz'	=> 'clock_mhz',
	'core id'	=> 'core_id',
	'physical id'	=> 'physical_id'
	);
    my %powerpc_cpuinfo_map = (
	'cpu'		=> 'family',
	'clock'		=> 'clock_mhz'
	);
    my $cpuinfo_map;
    if ($arch_is_x86) {
	$cpuinfo_map = \%x86_cpuinfo_map;
    } elsif ($arch_is_powerpc) {
	$cpuinfo_map = \%powerpc_cpuinfo_map;
    }

    # Try to read generic cputopology
    if (my $cpu_list = list_dir($cpus_dir)) {
	my $have_phys_id;
	for my $name (@$cpu_list) {
	    next unless $name =~ /^cpu(\d+)$/;
	    $log_id = $1;
	    my $topo_dir = "$cpus_dir/$name/topology";
	    next unless -d $topo_dir;
	    my $proc = {};
	    $proc->{core_id} = read_file("$topo_dir/core_id");
	    my $phys_id = read_file("$topo_dir/physical_package_id");
	    if ($phys_id >= 0) {
		$have_phys_id = 1;
		$proc->{physical_id} = $phys_id;
	    }
	    $log_procs[$log_id] = $proc;
	}
	if (!$have_phys_id) {
	    # Assume NUMA nodes are physical packages
	    if (my $node_list = list_dir($nodes_dir)) {
		for my $name (@$node_list) {
		    next unless $name =~ /^node(\d+)$/;
		    my $node_id = $1;
		    my $cpu_list = list_dir("$nodes_dir/$name");
		    next unless $cpu_list;
		    for my $name (@$cpu_list) {
			next unless $name =~ /^cpu(\d+)$/;
			$log_procs[$1]->{physical_id} = $node_id;
		    }
		}
	    }
	}
    }

    # Parse /proc/cpuinfo into per-logical-processor hashes.
    if (defined($cpuinfo_map) &&
	(my $file = new FileHandle('/proc/cpuinfo', 'r'))) {
	while (<$file>) {
	    if (/^([^:]*?)[ \t]*:[ \t]*(.*)\n$/) {
		my ($key, $value) = ($1, $2);
		if ($key eq 'processor') {
		    $log_id = $value;
		    $log_procs[$log_id] ||= {};
		} elsif (defined($key = $cpuinfo_map->{$key})) {
		    if ($key eq 'clock_mhz') {
			$value =~ s/(?:\.0+)? *MHz$//;
		    }
		    $log_procs[$log_id]->{$key} = $value;
		}
	    }
	}
	$file->close();
    }

    return undef unless @log_procs;

    # Group processors into physical processors and count logical
    # processors.
    my @phys_procs = ();
    my @phys_proc_cores = ();
    for $log_id (0..$#log_procs) {
	my $proc = $log_procs[$log_id];
	next unless defined($proc); # there may be gaps in numbering
	my $phys_id = first_defined($proc->{'physical_id'}, $log_id);
	if (defined($phys_procs[$phys_id])) {
	    ++$phys_procs[$phys_id]->{n_log_procs};
	} else {
	    $phys_procs[$phys_id] = {%$proc};
	    $phys_procs[$phys_id]->{n_log_procs} = 1;
	    $phys_procs[$phys_id]->{n_cores} = 1;
	    $phys_proc_cores[$phys_id] = {};
	}
	my $core_id = $proc->{core_id};
	if (defined($core_id)) {
	    $phys_proc_cores[$phys_id]->{$core_id} = 1;
	    $phys_procs[$phys_id]->{n_cores} =
		scalar(keys(%{$phys_proc_cores[$phys_id]}));
	}
    }
    return \@phys_procs;
}

# Produce a system summary along the lines of msinfo32 output.
sub print_system_summary {
    my $smbios = shift;
    my @attributes = ('OS Name', 'Version', 'Architecture');
    my @value = ($os_type, "$os_release $os_version", $arch);
    if ($os_type eq 'Linux') {
	$_ = read_file('/proc/cmdline');
	chomp;
	push @attributes, 'Kernel Command Line';
	push @value, $_;
	# Newer distributions implement LSB release information so
	# look for that first.  If that fails look in /etc/*-release
	# (RPM-based distributions use these) and /etc/debian_version.
	my $distribution;
	$_ = `lsb_release -d 2>/dev/null`;
	if ($? == 0 && /^Description:[ \t]*(.*)\n$/) {
	    $distribution = $1;
	} else {
	    my @release_files = glob('/etc/*-release');
	    if ($#release_files >= 0) {
		$distribution = read_file($release_files[0]);
	    } elsif (-f '/etc/debian_version') {
		$distribution = 'Debian ' . read_file('/etc/debian_version');
	    }
	}
	$distribution =~ s/\n.*//s if defined($distribution);
	push @attributes, 'Distribution';
	push @value, $distribution;
    }
    push @attributes, 'System Name';
    push @value, $hostname;
    push @attributes, 'System Manufacturer';
    push @value, $smbios->get_single_string(1, 4);
    push @attributes, 'System Model';
    push @value, $smbios->get_single_string(1, 5);
    if ($os_type eq 'Linux') {
	if (my $phys_procs = get_linux_cpuinfo()) {
	    for my $proc (@$phys_procs) {
		next unless defined($proc); # there may be gaps in numbering
		my $proc_desc = '';
		for (['family',      '',   'Family ',     '',
		      'unknown'],
		     ['model',       ' ',  ' Model ',     ''],
		     ['variation',   ' ',  ' Variation ', ''],
		     ['stepping',    ' ',  ' Stepping ',  ''],
		     ['vendor',      ' ',  ' Vendor ',    ''],
		     ['full_name',   ', ', undef,         ''],
		     ['clock_mhz',   undef, ', ',         ' MHz'],
		     ['n_cores',     undef, ', ',         ' Core(s)'],
		     ['n_log_procs', undef, ', ',
		      ' Logical Processor(s)', '']) {
		    my ($key, $prefix, $num_prefix, $suffix, $default) = @$_;
		    my $value = $proc->{$key};
		    if (!defined($value)) {
			$proc_desc .= $default if defined($default);
		    } elsif ($value =~ /^[\d.]+$/) {
			$proc_desc .= "$num_prefix$value$suffix";
		    } else {
			$proc_desc .= "$prefix$value$suffix";
		    }
		}
		push @attributes, 'Processor';
		push @value, $proc_desc;
	    }
	}
    }
    if ($smbios->expected) {
	push @attributes, 'BIOS Version/Date';
	my $bios_id = $smbios->get_single_string(0, 4); # vendor
	if (defined($bios_id)) {
	    my $bios_version = $smbios->get_single_string(0, 5);
	    if (defined($bios_version)) {
		$bios_id .= ' ' . $bios_version;
		my $bios_date = $smbios->get_single_string(0, 8);
		if (defined($bios_date)) {
		    $bios_id .= ', ' . $bios_date;
		}
	    }
	}
	push @value, $bios_id;
    }
    if ($os_type eq 'Linux') {
	push @attributes, 'SELinux';
	my $selinux_status = 'Disabled';
	my $selinux_enforce = read_file("/sys/fs/selinux/enforce");
	if (defined($selinux_enforce)) {
        	$selinux_status = $selinux_enforce == '1' ? 'Enforcing' : 'Permissive';
	}
	push @value, $selinux_status;
	if (my $meminfo_file = new FileHandle('/proc/meminfo', 'r')) {
	    my %meminfo = ();
	    while (<$meminfo_file>) {
		if (/^([^ ]+):[ \t]*(\d+) kB\n$/) {
		    $meminfo{$1} = $2;
		}
	    }
      
	    $meminfo_file->close();
	    push @attributes, ('Total Physical Memory',
			       'Free Physical Memory',
			       'Available Physical Memory',
			       'Total Virtual Memory',
			       'Available Virtual Memory',
			       'Page File Space');
	    push @value, map(sprintf('%d MB', $_ / 1024),
			     $meminfo{MemTotal},
			     $meminfo{MemFree},
			     $meminfo{MemAvailable},
			     # Count all physical memory and swap
			     # minus kernel allocations as virtual
			     # memory.  Assume kernel code and static
			     # data is excluded from MemTotal.
			     $meminfo{MemTotal} + $meminfo{SwapTotal}
			     - $meminfo{Slab} - $meminfo{PageTables},
			     # Count all free physical memory and
			     # swap, plus all buffers and cache, as
			     # 'available' (even though the cache
			     # includes all user code!).
			     $meminfo{MemFree} + $meminfo{SwapFree}
			     + $meminfo{Buffers} + $meminfo{Cached}
			     + $meminfo{SwapCached},
			     $meminfo{SwapTotal});
	}
    }

    tabulate('System Summary', undef, \@attributes, [\@value], orient_vert);
} # print_system_summary

sub print_physical_memory {
    my $smbios = shift;
    my @mem_arrays = $smbios->get_by_type(16);
    my @mem_devices = $smbios->get_by_type(17);
    my @values = ();

    if (@mem_arrays && @mem_devices) {
	my %mem_arrays;
	for (@mem_arrays) {
	    my ($handle, $loc, $use, $slots) = unpack('x2vCCx7v', $_->[0]);
	    # Only count slots on the motherboard for system memory
	    $mem_arrays{$handle} = 1 if $loc == 3 && $use == 3;
	}
	my (%mem_sets, %mem_sets_pop);
	for (@mem_devices) {
	    my ($header, $strings) = @$_;
	    my ($array, $size_code, $slot_str_i, $bank_str_i) =
		unpack('x4vx6vx2CC', $header);
	    if ($mem_arrays{$array}) {
		my $size;
		if ($size_code != 0 && $size_code != 0xffff) {
		    $size = (($size_code & 0x7fff) *
			     (($size_code & 0x8000) ? 1 : 1024));
		}
		push @values, [SmbiosInfo::get_string($strings, $slot_str_i),
			       SmbiosInfo::get_string($strings, $bank_str_i),
			       ($size_code == 0) ? 0 : 1,
			       $size];
	    }
	}
    }

    print_heading('Hardware', 'hw');

    tabulate('Physical memory slots',
	     undef,
	     [qw(slot_id bank_id filled size_kbytes)],
	     \@values,
	     orient_vert);
} # print physical_memory

# SmbiosInfo is a reimplementation of some of dmidecode, which we can't
# rely on being installed.

package SmbiosInfo;

sub new {
    use PerlIO;

    my $self = bless({
	expected => ($arch_is_x86 || $arch eq 'ia64'),
	handle_index => {},
	type_index => {}
    });

    return $self unless $self->{expected};

    my $mem_file = new FileHandle('/dev/mem', 'r') or return $self;
    my $read_error;

    # Find SMBIOS entry point
    my $entry;
    if (my $systab_file = new FileHandle('/sys/firmware/efi/systab', 'r')) {
	# EFI should tell us exactly where it is
	while (<$systab_file>) {
	    if (/^SMBIOS=(.*)/) {
		my $addr = POSIX::strtoul($1, 0);
		$! = 0;
		if (seek($mem_file, $addr + 0x10, &POSIX::SEEK_SET) &&
		    read($mem_file, $entry, 0x10)) {
		    _check_entry($entry) or $entry = undef;
		} else {
		   $read_error = $!; 
		   $entry = undef;
		}
		last;
	    }
	}
	$systab_file->close();
    }

    # Otherwise scan through the BIOS (0xf0000-0x100000)
    if (!defined($entry) && $arch_is_x86) {
	# Reopen the file handler in case there was a failed read before
        $mem_file->close();
	$mem_file = new FileHandle('/dev/mem', 'r') or return $self;
	my $buf;
	$! = 0;
	if (seek($mem_file, 0xf0000, &POSIX::SEEK_SET) &&
	    read($mem_file, $buf, 0x10000)) {
	    for (my $off = 0; $off < length($buf); $off += 0x10) {
		if (_check_entry(substr($buf, $off))) {
		    $entry = substr($buf, $off, 0x10);
		    last;
		}
	    }
	} else {
	    $read_error = $!;
	    $entry = undef;
	}
    }

    # Decode the entry and read the table
    my ($table, $num);
    if (defined($entry)) {
	my ($len, $base);
	($len, $base, $num) = unpack('x6vVv', $entry);
	unless (seek($mem_file, $base, &POSIX::SEEK_SET) &&
		read($mem_file, $table, $len)) {
	    $read_error = $!;
	    $table = undef;
	}
    }

    $mem_file->close();

    if (defined($table)) {
	my ($i, $pos) = (0, 0);
	while ($i < $num && $pos + 4 <= length($table)) {
	    my ($type, $header_len, $handle) =
		unpack('CCv', substr($table, $pos));
	    last if $header_len < 4;  # invalid structure; table is broken
	    my $next = index($table, "\0\0", $pos + $header_len);
	    $next = ($next < 0) ? length($table) : $next + 2;
	    _add($self, $type, $handle,
		 substr($table, $pos, $header_len),
		 substr($table, $pos + $header_len,
			$next - $pos - $header_len));
	    ++$i;
	    $pos = $next;
	}
    }
    # We might get EFAULT when trying to read an SMBIOS table at a
    # high address on a 32-bit system.  For some reason Linux applies
    # a lower address limit to read() than to mmap() on /dev/mem.
    # Perl won't let us mmap() a character device, so fall back to
    # dmidecode if available because it does use mmap().
    elsif (defined($read_error)) {
	if (my $dmidecode_file =
	    new FileHandle('dmidecode --dump 2>/dev/null |')) {
	    my ($type, $handle, $header, $strings);
	    while (<$dmidecode_file>) {
		# Parse dmidecode dump back into binary form
		if (/^Handle 0x([\dA-F]{4}), DMI type (\d+)/) {
		    $type = $2;
		    ($handle, undef) = POSIX::strtoul($1, 16);
		    $header = '';
		} elsif (/^\tStrings:/) {
		    $strings = '';
		} elsif (/^\t\t(?!\")/) {
		    s/\s//g;
		    (defined($strings) ? $strings : $header) .= pack('H*', $_);
		} elsif (/^\n$/ && defined($type)) {
		    _add($self, $type, $handle,
			 $header,
			 defined($strings) ? ($strings . "\0") : "\0\0");
		    ($type, $handle, $header, $strings) = ();
		}
	    }
	}
    }

    return $self;
}

sub _check_entry {
    my $entry = shift;
    return 0 if substr($entry, 0, 5) ne '_DMI_';
    my $sum = 0;
    for (0..0xe) {
	$sum += ord(substr($entry, $_, 1));
    }
    return ($sum & 0xff) == 0;
}

sub _add {
    my ($self, $type, $handle, $header, $strings) = @_;
    my $structure = [$header, $strings];
    push @{$self->{type_index}{$type}}, $structure;
    $self->{handle_index}{$handle} = $structure;
}

sub get_by_handle {
    my ($self, $handle) = @_;
    my $structure = $self->{handle_index}{$handle};
    return $structure ? @$structure : ();
}

sub get_by_type {
    my ($self, $type) = @_;
    my $structures = $self->{type_index}{$type};
    return $structures ? @$structures : ();
}

sub get_single_string {
    my ($self, $type, $offset) = @_;

    # Take first structure of given type
    my @structures = get_by_type($self, $type);
    return undef unless @structures;
    my ($header, $strings) = @{$structures[0]};

    # Get string index
    return undef unless length($header) > $offset;
    my $target_i = ord(substr($header, $offset, 1));

    return get_string($strings, $target_i);
}

sub get_string {
    my ($strings, $target_i) = @_;

    # String indices are 1-based, with 0 indicating no string present
    return undef if $target_i == 0;

    my ($i, $pos) = (1, 0);
    while ($pos < length($strings)) {
	my $end = index($strings, "\0", $pos);
	return undef if $end == $pos; # end of strings
	if ($i == $target_i) {
	    return substr($strings, $pos, $end - $pos);
	}
	++$i;
	$pos = $end + 1;
    }

    return undef;
}

sub expected {
    my ($self) = @_;
    return $self->{expected};
}

# PciFunction class represents individual PCI functions and abstracts
# config register reading in a general way.

package PciFunction;

my %config_regs = (VENDOR_ID =>            [0x00, 2],
		   DEVICE_ID =>            [0x02, 2],
		   STATUS =>               [0x06, 2],
		   REVISION =>             [0x08, 1],
		   CLASS_DEVICE =>         [0x0a, 2],
		   SECONDARY_BUS =>        [0x19, 1],
		   SUBORDINATE_BUS =>      [0x1a, 1],
		   SUBSYSTEM_VENDOR_ID =>  [0x2c, 2],
		   SUBSYSTEM_ID =>         [0x2e, 2],
		   CAPABILITIES_POINTER => [0x34, 1]);
my %pcie_regs = (MAX_PAYLOAD_SIZE_SUPPORTED => [4,  4, 0,  2],
		 MAX_PAYLOAD_SIZE =>           [8,  2, 5,  7],
		 MAX_READ_REQUEST_SIZE =>      [8,  2, 12, 14],
		 MAXIMUM_LINK_WIDTH =>         [12, 4, 4,  9],
		 NEGOTIATED_LINK_WIDTH =>      [18, 2, 4,  9]);
my %config_regs_per_cap = (16 => \%pcie_regs);

sub new {
    my ($class, $address, $config) = @_;
    my %registers = %config_regs;
    my $self = bless({
	_address => $address,
	_config => $config,
	_registers => \%registers
    });
    # Add registers on the capabilities list.
    if ($self->STATUS & 0x10) { # test CAPABILITIES_LIST flag
	# Protect against loops.
	my %seen = ();
	my $cap_ptr = $self->CAPABILITIES_POINTER;
	while (($cap_ptr &= 0xFC) && $cap_ptr + 2 <= length($config)
	       && !$seen{$cap_ptr}) {
	    $seen{$cap_ptr} = 1;
	    my ($cap_id, $cap_next) =
		unpack('CC', substr($config, $cap_ptr, 2));
	    if (my $cap_regs = $config_regs_per_cap{$cap_id}) {
		for my $name (keys(%$cap_regs)) {
		    # Add the register definition with the capability
		    # offset applied.
		    my @reg = @{$cap_regs->{$name}};
		    $reg[0] += $cap_ptr;
		    $registers{$name} = \@reg;
		}
	    }
	    $cap_ptr = $cap_next;
	}
    }
    return $self;
}

sub address {
    my $self = shift;
    return $self->{_address};
}

sub read {
    my ($self, $offset, $length) = @_;
    return $offset < length($self->{_config})
	? substr($self->{_config}, $offset, $length)
	: undef;
}

sub _read_register {
    my ($self, $name) = @_;
    my ($offset, $length, $lsb, $msb) = @{$self->{_registers}->{$name}};
    my ($value) = unpack(substr('_Cv_V', $length, 1),
			 substr($self->{_config}, $offset, $length));
    if (defined($lsb)) {
	# Return a bitfield, not the whole register.
	# Shift before masking because construction of a mask with bit
	# 31 set may result in overflow.
	return ($value >> $lsb) & ((1 << 1 + $msb - $lsb) - 1);
    } else {
	return $value;
    }
}

sub AUTOLOAD {
    my $self = shift;
    my $name = $PciFunction::AUTOLOAD;
    if ($name =~ s/^PciFunction::// && exists($self->{_registers}->{$name})) {
	return _read_register($self, $name);
    } else {
	return undef;
    }
}
    
package main;

sub get_pci_devices {
    my %devices;
    if (my $device_list = list_dir('/sys/bus/pci/devices')) {
	for my $address (@$device_list) {
	    next unless $address =~ /^([0-9a-f]{4}:)/;
	    my $device_dir = "/sys/bus/pci/devices/$address";
	    $devices{$address} =
		new PciFunction($address, read_file("$device_dir/config"));
	}
    }
    return \%devices;
}

sub get_file_attributes {
    my $path = $_;
    if (my @status = stat($path)) {
	my $md5sum = `md5sum '$path' 2>/dev/null`;
	$md5sum =~ s/^([0-9a-f]{32})\s.*\n/$1/ or $md5sum = undef;
	my $version = `modinfo -F version '$path' 2>/dev/null`;
	chomp $version;
	return [$path,
		$version ne '' ? $version : undef,
		$status[7],
		strftime('%Y-%m-%d %H:%M:%S', gmtime($status[9])),
		$md5sum];
    } else {
	# TODO: Provide a more explicit indication that the file is
	# missing or otherwise inaccessible.
	return [$path,
		undef,
		undef,
		undef,
		undef];
    }
}

sub get_device_drivers {
    # Scan sysfs to find PCI devices' driver names.
    my %device_drivers = ();
    if (my $driver_list = list_dir('/sys/bus/pci/drivers')) {
        for my $driver_name (@$driver_list) {
            if (my $device_list =
                list_dir("/sys/bus/pci/drivers/$driver_name")) {
                for my $address (@$device_list) {
                    $device_drivers{$address} = $driver_name
                        if $address =~ /^[0-9a-f]{4}:/;
                }
            }
        }
    }
    return %device_drivers;
}

sub get_sfc_devices {
    my $devices = shift;
    my %sfc_devices = ();

    for my $address (keys(%$devices)) {
        my $device = $devices->{$address};
        if ($device->VENDOR_ID == EFX_VENDID_SFC) {
            $sfc_devices{$address} = $device;
        } elsif ($device->VENDOR_ID == EFX_VENDID_XILINX && $device->CLASS_DEVICE == 0x200) {
            $sfc_devices{$address} = $device;
        }
    }

    return %sfc_devices;
}

sub get_sfc_vpd {
    my $sfc_drvinfo = shift;
    my @attributes = shift;
    my %vpd = ();
    my %return_values = ();

    for my $name (keys(%$sfc_drvinfo)) {
        my $vpd = read_file("/sys/class/net/$name/device/vpd");
        $vpd{$name} = $vpd if defined($vpd);
    }

    for my $name (keys(%vpd)) {
        my $vpd = $vpd{$name};
        my %values = ();

        # Iterate over VPD resources.
        my $res_addr = 0;
        my $res_len;
        while ($res_addr + 1 <= length($vpd)) {
            my $tag = ord(substr($vpd, $res_addr, 1));
            if ($tag & 0x80) {
                # Large resource; length is in next 2 bytes.
                last unless $res_addr + 3 <= length($vpd);
                $res_len = unpack('v', substr($vpd, $res_addr + 1, 2));
                $res_addr += 3;
            } else {
                # Small resource; length is in lowest 3 bits.
                $res_len = $tag & 7;
                $res_addr += 1;
            }
            # Check for end marker; check length is valid.
            last if $res_len == 0;
            last unless $res_addr + $res_len <= length($vpd);

            if ($tag == 0x82) {
                $values{product_name} =
                    substr($vpd, $res_addr, $res_len);
            } elsif ($tag == 0x90) {
                # Iterate over key/value pairs.
                my $key_addr = 0;
                while ($key_addr + 3 <= $res_len) {
                    my $key = substr($vpd, $res_addr + $key_addr, 2);
                    my $value_len =
                        ord(substr($vpd, $res_addr + $key_addr + 2, 1));
                    last unless $key_addr + 3 + $value_len <= $res_len;
                    $values{"vpdr_$key"} =
                        substr($vpd, $res_addr + $key_addr + 3, $value_len);
                    $key_addr += 3 + $value_len;
                }
            }
            $res_addr += $res_len;
        }
	
        $values{$name} = $name;
        $return_values{$name} = \%values;
    }

    return %return_values;
}

sub get_turbo_status {
    my $address = shift;
    my $turbo_mode = '<N/A>';

    if (my $status = read_file("/sys/bus/pci/devices/$address/turbo_mode")) {
        $turbo_mode = $status;
        $turbo_mode =~  s/\n.*//s;
    }

    return $turbo_mode;
}

sub print_short_device_status {
    my ($devices, $sfc_drvinfo) = @_;

    my %device_drivers = get_device_drivers();
    my %sfc_devices = get_sfc_devices($devices);

    my @vpd_attributes = qw(address product_name vpdr_PN vpdr_EC vpdr_SN);
    my %vpd_values = get_sfc_vpd($sfc_drvinfo, @vpd_attributes);

    my @headings = ('name', 'device_id', 'revision', 'subsys_id', 'driver', 'pci_address',
                    'driver_version', 'controller_version',
                    'mac_address', 'product_name', 'vpdr_PN',
                    'vpdr_EC', 'vpdr_SN','onload_version');

    my @data = map({[$_, sprintf('%04x:%04x', $sfc_devices{$sfc_drvinfo->{$_}->bus_info}->VENDOR_ID,
                                              $sfc_devices{$sfc_drvinfo->{$_}->bus_info}->DEVICE_ID),
                         sprintf('%02x', $sfc_devices{$sfc_drvinfo->{$_}->bus_info}->REVISION),
                         sprintf('%04x:%04x', $sfc_devices{$sfc_drvinfo->{$_}->bus_info}->SUBSYSTEM_VENDOR_ID,
                                              $sfc_devices{$sfc_drvinfo->{$_}->bus_info}->SUBSYSTEM_ID),
                            $sfc_drvinfo->{$_}->driver,
                            $sfc_drvinfo->{$_}->bus_info,
                            $sfc_drvinfo->{$_}->version,
                            $sfc_drvinfo->{$_}->fw_version,
                            get_iface_mac_addr($_),
                            $vpd_values{$_}->{"product_name"},
                            $vpd_values{$_}->{"vpdr_PN"},
                            $vpd_values{$_}->{"vpdr_EC"},
                            $vpd_values{$_}->{"vpdr_SN"},
			    get_onload_version()]}
                            keys(%$sfc_drvinfo));


    $out_file->print("CSV:AMD Solarflare inventory report\n");
    # Print the attributes as a single list
    foreach (@headings) {
        $out_file->print($_);
        if ($_ ne $headings[-1]) {
            $out_file->print(",");
        } else {
            $out_file->print("\n");
        }
    }

    my $values = \@data;
    my $attributes = @headings;

    # Print out the actual data with one controller per line
    for my $i (0..$#$values) {
        my $value = $values->[$i];
        my $line = '';
        for my $j (0..$#headings) {
            my $attr_value;
            if (ref($value) eq 'HASH') {
                $attr_value = $value->{$attributes->[$j]};
            } elsif (ref($value) eq 'ARRAY') {
                $attr_value = $value->[$j];
            }
            if ( defined $attr_value ) {
                $line .= ($attr_value);
            }
            if ($j ne $#headings) {
                $line .= (",");
            }
        }
        $line .= "\n";
        $out_file->print($line);
    }

    $out_file->print("\n");

}

sub print_device_status {
    my ($devices, $sfc_drvinfo) = @_;

    # Scan sysfs to find PCI devices' driver names.
    my %device_drivers = ();
    if (my $driver_list = list_dir('/sys/bus/pci/drivers')) {
	for my $driver_name (@$driver_list) {
	    if (my $device_list =
		list_dir("/sys/bus/pci/drivers/$driver_name")) {
		for my $address (@$device_list) {
		    $device_drivers{$address} = $driver_name
			if $address =~ /^[0-9a-f]{4}:/;
		}
	    }
	}
    }

    # Identify and report the devices we're interested in.
    my %bridge_devices;
    my %sfc_devices;
    my %interesting_devices;
    my %sfc_root_ports;
    for my $address (keys(%$devices)) {
	my $device = $devices->{$address};
	if ($device->CLASS_DEVICE == 0x0604) {
	    $bridge_devices{$address} = $device;
        if (my $sub_device_list = list_dir("/sys/bus/pci/devices/$address")) {
            for my $sub_device_addr (@$sub_device_list) {
                if (my $sub_device = $devices->{$sub_device_addr}) {
                    if ($sub_device->VENDOR_ID == EFX_VENDID_SFC || 
                        ($sub_device->VENDOR_ID == EFX_VENDID_XILINX &&
                         $sub_device->CLASS_DEVICE == 0x200)) {
                        $sfc_root_ports{$address} = $device;     
                        last;
                    }
                }
            }
        }
	} elsif ($device->VENDOR_ID == EFX_VENDID_SFC) {
	    $sfc_devices{$address} = $device;
    } elsif ($device->VENDOR_ID == EFX_VENDID_XILINX) {
        if ($device->CLASS_DEVICE == 0x200){
          $sfc_devices{$address} = $device;}
        elsif ($device->DEVICE_ID == 0x5086 || $device->DEVICE_ID == 0x5074){
          $interesting_devices{$address} = $device;}
	}
    }
    tabulate('PCI bridge devices',
	     undef,
	     ['address', 'device_id', 'revision', 'subsystem_id',
	      'secondary_bus', 'subordinate_bus',
	      'max_payload_size_supported', 'max_payload_size',
	      'max_read_request_size', 'maximum_link_width',
	      'negotiated_link_width'],
	     [map({[$_->address,
		    sprintf('%04x:%04x', $_->VENDOR_ID, $_->DEVICE_ID),
		    sprintf('%02x', $_->REVISION),
		    sprintf('%04x:%04x',
			    $_->SUBSYSTEM_VENDOR_ID, $_->SUBSYSTEM_ID),
		    $_->SECONDARY_BUS,
		    $_->SUBORDINATE_BUS,
		    $_->MAX_PAYLOAD_SIZE_SUPPORTED,
		    $_->MAX_PAYLOAD_SIZE,
		    $_->MAX_READ_REQUEST_SIZE,
		    $_->MAXIMUM_LINK_WIDTH,
		    $_->NEGOTIATED_LINK_WIDTH]}
		  values(%bridge_devices))]);
    tabulate('AMD Solarflare PCI devices',
	     'pci_device_sfc',
	     ['address', 'device_id', 'revision', 'subsystem_id',
	      'max_payload_size_supported', 'max_payload_size',
	      'max_read_request_size', 'maximum_link_width',
	      'negotiated_link_width', 'turbo'],
	     [map({{address => $_->address,
		    device_id => sprintf('%04x:%04x',
					 $_->VENDOR_ID, $_->DEVICE_ID),
		    revision => sprintf('%02x', $_->REVISION),
		    subsystem_id => sprintf('%04x:%04x',
					    $_->SUBSYSTEM_VENDOR_ID,
					    $_->SUBSYSTEM_ID),
		    max_payload_size_supported =>
			$_->MAX_PAYLOAD_SIZE_SUPPORTED,
		    max_payload_size => $_->MAX_PAYLOAD_SIZE,
		    max_read_request_size => $_->MAX_READ_REQUEST_SIZE,
		    maximum_link_width => $_->MAXIMUM_LINK_WIDTH,
		    negotiated_link_width => $_->NEGOTIATED_LINK_WIDTH,
                    turbo => get_turbo_status($_->address)}}
		  values(%sfc_devices))]);
    if (keys %interesting_devices) {
        tabulate('Other Noteworthy PCI devices',
            'interesting_devices',
            ['address', 'device_id', 'revision', 'subsystem_id',
            'max_payload_size_supported', 'max_payload_size',
            'max_read_request_size', 'maximum_link_width',
            'negotiated_link_width', 'turbo'],
            [map({{address => $_->address,
                device_id => sprintf('%04x:%04x',
                        $_->VENDOR_ID, $_->DEVICE_ID),
                revision => sprintf('%02x', $_->REVISION),
                subsystem_id => sprintf('%04x:%04x',
                            $_->SUBSYSTEM_VENDOR_ID,
                            $_->SUBSYSTEM_ID),
                max_payload_size_supported =>
                $_->MAX_PAYLOAD_SIZE_SUPPORTED,
                max_payload_size => $_->MAX_PAYLOAD_SIZE,
                max_read_request_size => $_->MAX_READ_REQUEST_SIZE,
                maximum_link_width => $_->MAXIMUM_LINK_WIDTH,
                negotiated_link_width => $_->NEGOTIATED_LINK_WIDTH,
                        turbo => get_turbo_status($_->address)}}
            values(%interesting_devices))]);
    }

  print_footer('hw');
  
  print_heading("PCI configuration", "pci_config", 'hide');
     
    if (my $pcieslot_file = `dmidecode -t slot 2>/dev/null | grep -b10 'PCI Express'`) {
        print_heading('PCIe slots info ');
        print_preformatted($pcieslot_file);
    }
    
    for my $address (keys(%bridge_devices), keys(%sfc_devices)) {
	print_heading("PCI configuration space for $address");
	# Emulate lspci -x.
	begin_preformatted(0);
	for my $offset (0..0xff) {
	    my $data = $devices->{$address}->read($offset, 1);
	    last if !defined($data);
	    if ($offset % 0x10 == 0) {
		$out_file->printf("%02x:", $offset);
	    }
	    $out_file->printf(" %02x", ord($data));
	    if ($offset % 0x10 == 0x0F) {
		$out_file->print("\n");
	    }
	}
	end_preformatted(0);
    }
  print_footer('pci_config' );

  my @aer_error_names = ('Error_type');
  my @aer_error_values = ();
  my @aer_file_names = ('aer_dev_correctable', 'aer_dev_fatal', 'aer_dev_nonfatal',
  'aer_rootport_total_err_cor', 'aer_rootport_total_err_fatal', 'aer_rootport_total_err_nonfatal');
  for my $address (keys(%sfc_root_ports), keys(%sfc_devices)) {
      my %pci_aer_errors = (Error_type => $address);
      foreach my $aer_file_name (@aer_file_names) {
        my $file_path = "/sys/bus/pci/devices/$address/$aer_file_name";
        if (open my $fh, '<', $file_path) {
            if ($aer_file_name =~ /^aer_dev_/) {
                # Multi-line key-value files
                while (my $line = <$fh>) {
                    chomp $line;
                    next unless $line =~ /^(\S+)\s+(\S+)/;
                    my ($key, $value) = ($1, $2);
                    $pci_aer_errors{"${aer_file_name}_$key"} = $value;
                    push @aer_error_names, "${aer_file_name}_$key"
                        unless grep { $_ eq "${aer_file_name}_$key" } @aer_error_names;
                }
            } elsif ($aer_file_name =~ /^aer_rootport_/) {
                # Single-value files (rootport totals)
                my $value = <$fh>;
                chomp $value if defined $value;
                $pci_aer_errors{$aer_file_name} = $value;
                push @aer_error_names, $aer_file_name
                    unless grep { $_ eq $aer_file_name } @aer_error_names;
            }
            close $fh;
        }
      }
      push @aer_error_values, \%pci_aer_errors;
  }

    tabulate("PCI AER Errors",
         'pci_errors',
         \@aer_error_names,
         \@aer_error_values,
         orient_vert,
         values_format_default,
         'pci_errors',
         1);

    my $modules_base = "/lib/modules/$os_release";

    tabulate('Driver bindings',
	     undef,
	     ['address', 'driver_name'],
	     [map({[$_, $device_drivers{$_}]} keys(%sfc_devices))]);

    my %sfc_modules = ();
    if (my $pcimap_file =
	new FileHandle("$modules_base/modules.pcimap", 'r')) {
	my @pcimap = ();
	my $vendor_id_long = sprintf('0x%08x', EFX_VENDID_SFC);
	my $vendor_id2_long = sprintf('0x%08x', EFX_VENDID_XILINX);
	while (<$pcimap_file>) {
	    next if $. == 1;
	    my @fields = split(/\s+/);
	    if ($fields[1] eq $vendor_id_long || $fields[1] eq $vendor_id2_long) {
		push @pcimap, \@fields;
		$sfc_modules{$fields[0]} = undef;
	    }
	}
	tabulate('Known kernel modules for AMD Solarflare PCI IDs',
		 undef,
		 ['module_name', 'vendor', 'device', 'subvendor', 'subdevice',
		  'class', 'class_mask', 'driver_data'],
		 \@pcimap,
		 orient_horiz,
		 values_format_default,
		 'pci_id');
    }

    my @loaded_sfc_modules = ();
    if (my $modules_file = new FileHandle('/proc/modules')) {
	my $re = '^(' . driver_name_re . ') ';
	while (<$modules_file>) {
	    if (/$re/) {
		push @loaded_sfc_modules, [$1];
		$sfc_modules{$1} = undef;
	    }
	}
    }
    tabulate('Loaded AMD Solarflare kernel modules',
	     undef,
	     ['module_name'],
	     \@loaded_sfc_modules);

    for my $name (keys(%sfc_modules)) {
	my $path = `modinfo -F filename '$name' 2>/dev/null`;
	if ($path ne '') {
	    chomp $path;
	    $sfc_modules{$name} = $path;
	}
    }

    tabulate('Module file names',
	     undef,
	     ['module_name', 'file_name'],
	     [pairs(%sfc_modules)]);

    tabulate('File properties',
	     'file_properties',
	     ['file_name', 'version', 'size', 'date_last_modified', 'md5sum'],
	     [map(get_file_attributes, grep(defined, values(%sfc_modules)))],
	     orient_horiz,
	     values_format_default,
	     'file_props');

  print_heading('Module Parameters', 'mod_params');
    for my $module_name (keys(%sfc_modules)) {
	# Module parameters may be found under one of two directories
	# (or not at all) depending on the kernel version.
	if (my $params =
	    read_dir_files("/sys/module/$module_name/parameters",
			   undef,
			   sub {chomp})
	    || read_dir_files("/sys/module/$module_name",
			      sub {$_ ne 'refcnt'},
			      sub {chomp})) {
	    tabulate("Parameters for $module_name",
		     undef,
		     ['name', 'value'],
		     $params);
	}
    }

    my @module_config_lines;
    for my $config_path ('/etc/modules.conf', '/etc/modprobe.conf',
			 glob('/etc/modprobe.d/*')) {
	if (my $config_file = new FileHandle($config_path, 'r')) {
	    my $re = '^(?:' . driver_name_re . ')$';
	    while (<$config_file>) {
		if (grep({$_ =~ /$re/} split /\b/)) {
		    chomp;
		    push @module_config_lines, [$config_path, $., $_];
		}
	    }
	}
    }
    # Also check whether third-party modules are auto-loaded (SuSE only).
    for my $config_path ('/etc/sysconfig/hardware/config') {
	if (my $config_file = new FileHandle($config_path)) {
	    while (<$config_file>) {
		if (/^\s*LOAD_UNSUPPORTED_MODULES_AUTOMATICALLY\b/) {
		    chomp;
		    push @module_config_lines, [$config_path, $., $_];
		}
	    }
	}
    }
    tabulate('Configuration lines for AMD Solarflare modules',
	     undef,
	     ['file_name', 'line', 'text'],
	     \@module_config_lines);

  print_footer('mod_params');

    # Ask package managers about installed module packages.
    # rpm doesn't support package name wildcards, so we must query all
    # packages and filter by name prefix.
    # dpkg lists matching packages it knows about even if they're
    # not installed, so we must filter by status.
    my @packages;
    for (['RPM', [rpm_name_prefixes],
	  "rpm -qa --queryformat '%{Name} %{Version} - - installed\\n'"],
	 ['deb', [deb_name_prefixes],
	  join(' ',
	       "dpkg-query -W -f '\${Package} \${Version} \${Status}\\n'",
	       map({"'$_*'"} deb_name_prefixes))]) {
	my ($type, $prefixes, $command) = @$_;
	if (my $query_file = new FileHandle("$command 2>/dev/null |")) {
	    while (<$query_file>) {
		chomp;
		my ($name, $version, undef, undef, $status) = split(/ /);
		if (grep({startswith($name, $_)} @$prefixes) &&
		    $status eq 'installed') {
		    push @packages, [$type, $name, $version];
		}
	    }
	}
    }
    tabulate("AMD Solarflare software packages installed",
	     undef,
	     ['type', 'name', 'version'],
	     \@packages);

    # Onload kernel modules and shared libraries are not currently
    # installed as packages.
    my @onload_comps;
    for (glob('/lib/modules/*/extra/onload.ko')) {
	my $path = $_;
	my $name = 'kmod-' . (split(/\//, $path))[3];
	my $version = `modinfo -F version '$path'`;
	chomp $version;
	push @onload_comps, [$name, $version];
    }
    for (grep({-f} '/usr/lib64/libonload.so', '/usr/lib/libonload.so')) {
	my $path = $_;
	my $name = (split(/\//, $path))[2];
	my $version = `$path 2>/dev/null`;
	$version =~ s/\n.*//s;
	$version =~ s/^OpenOnload //;
	push @onload_comps, [$name, $version];
    }
    tabulate("Onload components installed",
	     undef,
	     ['name', 'version'],
	     \@onload_comps);

    if (my $tcpdirect_file = `zf_stackdump version 2>&1 |grep version`) {
        print_heading('TCPDirect version');
        print_preformatted($tcpdirect_file);
    }

    if (my $ptp_file = `cat /var/lib/sfptpd/version 2>/dev/null` ) {
        print_heading('sfptpd version installed');
        print_preformatted($ptp_file);
    }

    if (my $clock_file = `cat /sys/devices/system/clocksource/*/current_clocksource 2>/dev/null` ) {
        print_heading('Clock Source (/sys/devices/system/clocksource/*/current_clocksource) ');
        print_preformatted($clock_file);
    }

    print_heading('Network interfaces for AMD Solarflare adapters', 'controller');
    tabulate('',
	     undef,
	     ['name', 'address', 'driver_version', 'controller_version'],
	     [map({[$_, $sfc_drvinfo->{$_}->bus_info,
		    $sfc_drvinfo->{$_}->version,
		    $sfc_drvinfo->{$_}->fw_version]}
		  keys(%$sfc_drvinfo))]);

    if (my $interrupts_file = new FileHandle('/proc/interrupts')) {
	my @attributes = ('number', 'type', 'affinity', 'sources');
	my @values = ();
	my $n_cpus;
	while (<$interrupts_file>) {
	    s/^\s+//; s/\s+$//; # trim leading and trailing space
	    my @fields = split(/:?\s+/, $_);
	    if ($. == 1) {
		# Header line labels CPU columns.
		# The other columns are unlabelled.
		# We assume that channel name is in last column.
		push @attributes, map($_ . '_count', @fields);
		$n_cpus = @fields;
	    } elsif ($fields[1] =~ /^\d+$/) {
		# Check whether any of the interrupts sources matches
		# Interrupts can have suffix with one or more dash
		# (e.g. -1, -rx-1, -ptp) but interface name could also contain
		# a dash.  Test suffixes to see if anything matches an interface
		my @ifname_parts = split(/-/, $fields[-1]);
		my $ifname = shift(@ifname_parts);
		while (scalar @ifname_parts and not exists $sfc_drvinfo->{$ifname}
					    and $ifname ne "onld") {
			$ifname .= '-' . shift(@ifname_parts);
		}
		if (exists($sfc_drvinfo->{$ifname}) or $ifname eq "onld") {
		    my $irq = $fields[0];
		    my $affinity = read_file("/proc/irq/$irq/smp_affinity");
		    chomp($affinity) if defined($affinity);
		    my $type = ($arch_is_powerpc ?
				"${fields[-3]} ${fields[-2]}" : $fields[-2]);
		    push @values, [$irq, $type, $affinity, $fields[-1],
				   @fields[1..$n_cpus]];
		}
	    }
	}
	tabulate('IRQs for AMD Solarflare adapters',
		 undef,
		 \@attributes,
		 \@values,
		 orient_horiz,
		 values_format_default,
		 'irq');
    }
  print_footer();
  
    if (my $hwmon_devices = list_dir('/sys/class/hwmon')) {
	my @attributes = ();
	my @values = ();

	for (@$hwmon_devices) {
	    my $device_dir = "/sys/class/hwmon/$_/device";
	    my $device_dir1 = "/sys/class/hwmon/$_";
	    my $sensor_values;

	    # Check whether this is a grandchild of a device handled
	    # by sfc or xilinx_efct (the I2C adapter is a child of the PCI
            # device and the hardware monitor is a child of I2C adapter).
	    my $grandparent_driver = readlink("$device_dir/driver");
	    next unless defined($grandparent_driver)
		&& ($grandparent_driver =~ m|/sfc$| ||
                  $grandparent_driver =~ m|/xilinx_efct$|);

	    # Use last three components of the device path as its address.
	    # That should be the PCI device's address, the I2C adapter
	    # id and the I2C address of the hardware monitor.
	    my $address = readlink($device_dir);
	    $address =~ s|.*/([^/]*)$|$1|;
            if ( my $temp_file = `ls $device_dir |grep temp`){
                $sensor_values = read_dir_files($device_dir,
                                               sub {/^(in|temp|curr)\d+_/},
                                               sub {chomp});
            }
            else {
                $sensor_values = read_dir_files($device_dir1,
                                               sub {/^(in|temp|curr)\d+_/},
                                               sub {chomp});
            }

	    next unless defined($sensor_values);

	    my %value = (address => $address);
	    for (@$sensor_values) {
		my ($attr, $attr_value) = @$_;
		push @attributes, $attr
		    unless grep({$_ eq $attr} @attributes);
		# Convert from thousandths of implicit units to explicit
		# full units
		
		if (($attr !~ /_alarm$/) && ($attr !~ /_label$/)) {	
                    no warnings 'numeric';
                    if (defined($attr_value)) {
                        my ($whole, $milli) =
                           ($attr_value / 1000, $attr_value % 1000);
                        if ($attr =~ /^in/) {
                            $attr_value = sprintf('%d.%03d V', $whole, $milli);
                        } elsif ($attr =~ /^temp/) {
                            $attr_value = sprintf('%d degC', $whole);
                        } elsif ($attr =~ /^curr/) {
                            $attr_value = sprintf('%d.%03d A', $whole, $milli);
                        }
                    }
                }
		$value{$attr} = $attr_value;
	    }
	    push @values, \%value;
	}

	@attributes = ('address', sort @attributes);

	tabulate('Hardware monitors (Sensors)',
		 undef,
		 \@attributes,
		 \@values,
		 orient_vert,
		 values_format_default,
		 'hwmon');
    }


    if (my $dmesg_file = new FileHandle('dmesg -dxT 2>/dev/null |')) {
        $_ = `dmesg -dxT 2>/dev/null`; 
        if ($?!=0) {
            $dmesg_file->close();
            $dmesg_file = new FileHandle('dmesg 2>/dev/null |');
        }
	print_heading("Recent kernel messages about AMD Solarflare adapters"
		      ." and drivers", "dmesg");
	begin_preformatted(1);
	my $word_alternation = join('|',
				    'solarflare',
				    map({s/\./\\./; $_} keys(%sfc_devices)),
				    keys(%$sfc_drvinfo));
	for (<$dmesg_file>) {
	    print_text($_) if /\b(sfc|onload|ef[x1]|($word_alternation)\b)/i;
	}
	end_preformatted(1);
    }
  print_footer("dmesg");
} # print_device_status

sub parse_ipv4 {
    my $addr = shift;
    return unpack('N', inet_aton($addr));
}

sub decode_ipv4_netmask {
    my $mask = shift;
    my $prefix_len = 0;
    while ($mask && $prefix_len < 32) {
	 $mask -= 0x80000000 >> $prefix_len;
	 ++$prefix_len;
    }
    return ($mask == 0) ? $prefix_len : undef;
}

sub print_net_status {
    my $sfc_drvinfo = shift;
    my %iface_names;

    for my $iface_name (keys(%$sfc_drvinfo)) {
	$iface_names{$iface_name} = 1;
    }

    # Add related VLAN and bonding interfaces
    my $link_info = `ip link show 2>/dev/null`;
    while ($link_info =~ /^\d+: (?:([^ ]+)@)?([^ @]+): \<.*\> (.*)/gm) {
	my ($vlan_name, $name, $attrs) = ($1, $2, $3);
	if ($iface_names{$name}) {
	    if (defined($vlan_name)) {
		$iface_names{$vlan_name} = 1;
	    }
	    if ($attrs =~ / master ([^ ]+)/) {
		$iface_names{$1} = 1;
	    }
	}
    }

    if (my $iface_list = list_dir('/sys/class/net')) {
        if (my $check_ifconfig = new FileHandle('ifconfig 2>&1 |')) {
            print_heading('Network configuration (ifconfig)', 'Network_configuration');
            for my $iface_name (sort(@$iface_list)) {
                if (my $report = `ifconfig '$iface_name' 2>/dev/null`) {
                    print_heading("Network configuration for $iface_name"
                                    ." (ifconfig)");
                    print_preformatted($report);
                }
            }
            print_footer('Network_configuration');
            close $check_ifconfig;
        }
        elsif (my $check_ip_addr = new FileHandle('ip addr 2>&1 |')) {
            print_heading('Network configuration (ip addr show)', 'Network_configuration');
            print_text('Ifconfig unavailable see ');
            print_reference('ip addr show','ip_addr');
            print_footer('Network_configuration');
            close $check_ip_addr;
        }
        else {
            STDERR->print("WARNING: ifconfig and ip addr unavailble.\n"
            ."Network configuration is unavailable.\n");
        }
    }

    print_heading('Network Configuration Scripts', 'netcfg');
    for my $config_path ('/etc/sysconfig/network',
			 map('/etc/sysconfig/network-scripts/ifcfg-' . $_,
			     keys %iface_names),
			 '/etc/network/interfaces') {
	print_heading("Configuration file $config_path");
	if (my $config = read_file($config_path)) {
	    print_preformatted($config, 1);
	} else {
	    print_warning("not readable: $!");
	}
    }
  print_footer('netcfg');

    print_heading("Sysctl -a", 'sysctl', 'hide');
    if (my $report =`sysctl -a 2>/dev/null`) {
            print_preformatted($report);
    }
  print_footer('sysctl');
	
    print_heading("NUMA information ");
    if (my $NUMA = `numactl --hardware 2>/dev/null`) {
        print_preformatted($NUMA); 
    }
    for my $iface_name(keys %iface_names) {
        if (my $report = `cat /sys/class/net/'$iface_name'/device/local_cpulist 2>/dev/null`) {
            print_preformatted($iface_name);
            print_preformatted($report);
        }
    }

    print_heading("HugePages information ");
    if (my $HugePages = `cat /proc/meminfo | grep Huge 2>/dev/null; cat /sys/devices/system/node/node*/meminfo | grep Huge 2>/dev/null`) {
        print_preformatted($HugePages);
    }

    print_heading("Packet buffer information ");
    if (my $PacketBufferUsage = `grep '' /proc/driver/sfc_resource/devices/*/pd* 2>/dev/null`) {
        print_preformatted($PacketBufferUsage);
    }

tabulate('TCP (IPv4) settings',
	     undef,
	     ['name', 'value'],
	     read_dir_files('/proc/sys/net/ipv4',
			    sub {$_ =~ /^tcp_/},
			    sub {chomp; s/\t/ /g;}),
	     orient_horiz,
	     values_format_default,
	     'tcp_cfg');

	my $ss_present = 1;
    if (my $ss_file = new FileHandle('ss -s 2>&1 |')) {
        my $ss_output;
        while (<$ss_file>) {
            $ss_output .= $_;
        }
        print_heading('Network stats (ss -s)', 'socket_stats');
        print_preformatted($ss_output);
        if (my $ss_file = new FileHandle('ss -t -u -H 2>&1 |')) {
            my @values = ();
            while (<$ss_file>) {
                my ($netid, $state, $recvq, $sendq, $local_address_port,
                    $peer_address_port, $process) = split /\s+/;
                push @values, [$netid, $state, $recvq, $sendq, $local_address_port,
                    $peer_address_port, $process]
            }
            tabulate('TCP and UDP Sockets (ss -u -t)',
                'ss_tcp_udp_stats',
                ['Netid', 'State', 'Recv-Q', 'Send-Q', 'Local_Address:Port',
                 'Peer Address:Port', 'Process'],
                \@values,
                orient_horiz);
        }
        print_footer('socket_stats');
        close $ss_file;
	}
    else {
        $ss_present = 0;
    }
    if (my $netstat_file = new FileHandle('netstat -s 2>&1 |')) {
        my $netstat_output;
        while (<$netstat_file>) {
            $netstat_output .= $_;
        }
        print_heading($ss_present ? 'Netstat (netstat -s)' : 'Network stats (netstat -s)', $ss_present ? 'netstat' : 'socket_stats', $ss_present);
        print_preformatted($netstat_output);
        print_footer('netstat');
        close $netstat_file;
	}
	elsif (!($ss_present)) {
        STDERR->print("WARNING: netstat and ss unavailble.\n"
                    ."Network statistics are unavailable.\n");
	}

    my $neigh_present = 1;
    if (my $neighbor_file = new FileHandle('ip -s neigh 2>&1 |')) {
        my $neigh_text = ();
        while (<$neighbor_file>) {
            $neigh_text .= $_;
        }
        print_heading("ARP cache (ip neighbor)", "ip_neighbor");
        print_preformatted($neigh_text);
        print_footer("ip_neighbor");
        close $neighbor_file;
    }
    else {
        $neigh_present = 0;
    }
    if (my $arp_file = new FileHandle('arp -n 2>&1 |')) {
        my @values = ();
        while (<$arp_file>) {
            next if $. == 1;
            my ($ip_addr, $hw_type, $mac_addr, $flags, $iface) = split /\s+/;
            push @values, [$ip_addr, $mac_addr, $flags, $iface]
            if $hw_type eq 'ether';
        }
        tabulate('ARP cache (arp -n)',
            'arp_cache',
            ['ip_address', 'mac_address', 'flags', 'iface_name'],
            \@values,
            orient_horiz,
            undef,
            'arp_cache',
            $neigh_present ? 1 : 0
            );
        close $arp_file;
    }
    elsif (!($neigh_present)) {
        STDERR->print("WARNING: arp and ip neighbour unavailble.\n"
		."Arp tables are unavailable.\n");
    }

    my $ip_route_present = 1;
    if (my $route_file = new FileHandle('ip route show table all 2>&1 |')) {
        my $route_text = ();
        while (<$route_file>) {
            $route_text .= $_;
        }
        print_heading('Full Routing table (ip route show table all)', 'routing');
        print_preformatted($route_text);
        print_footer('routing');
    }
    else {
        $ip_route_present = 0;
    }
    if (my $ip_route_file = new FileHandle('route -A inet -n 2>&1 |')) {
	my @values = ();
        while (<$ip_route_file>) {
            next if $. <= 2;
            my ($dest, $gw, $mask, $flags, $metric, undef, undef, $iface) =
            split /\s+/;
            my $prefix_len = decode_ipv4_netmask(parse_ipv4($mask));
            push @values, ["$dest/$prefix_len", $gw, $flags, $metric, $iface];
        }
        tabulate('Routing table (IPv4) (route -A inet -n)',
            'route_ipv4',
            ['dest_address', 'gateway_address', 'flags', 'metric',
            'iface_name'],
            \@values,
            orient_horiz,
            undef,
            'route_ipv4',
            $ip_route_present ? 1 : 0);
        close $ip_route_file;
    }
    elsif (!($ip_route_present)) {
        STDERR->print("WARNING: route and ip route unavailble.\n"
		."Routing information is unavailable.\n");
    }

    if (my $route_file = new FileHandle('route -A inet6 -n 2>/dev/null |')) {
        my @values = ();
        while (<$route_file>) {
            next if $. <= 2;
            my ($dest, $gw, $flags, $metric, undef, undef, $iface) =
            split /\s+/;
            push @values, [$dest, $gw, $flags, $metric, $iface];
        }
        tabulate('Routing table (IPv6) (route -A inet6 -n)',
            'route_ipv6',
            ['dest_address', 'gateway_address', 'flags', 'metric',
            'iface_name'],
            \@values,
            orient_horiz,
            undef,
            'route_ipv6',
            $ip_route_present ? 1 : 0);
        close $route_file;
    }
   
    if (my $route_file = new FileHandle("ip rule show 2>&1 |")) {
        my $output = '';
        while (<$route_file>) {
            $output .= $_;
        }
        print_heading('ip rule show');
        print_preformatted($output);
    }

    if (my $route_file = new FileHandle("ip link show 2>&1 |")) {
        my $output = '';
        while (<$route_file>) {
            $output .= $_;
        }
        print_heading('ip link show');
        print_preformatted($output);
    }

    if (my $netns_file = new FileHandle("ip netns 2>&1 |")) {
        my $output = '';
        while (<$netns_file>) {
            $output .= $_;
        }
        print_heading('Namespace (ip netns)');
        print_preformatted($output);
        
        if (my $netns_file2 = new FileHandle("ip netns identify 2>&1 |")){
            my $output2 = '';
        while (<$netns_file2>) {
            $output2 .= $_;
        }
            print_preformatted("sfreport run in the namespace (ip netns identify): $output2");
        }
    }

    if (my $addr_file = new FileHandle("ip -s -d addr show 2>&1 |")) {
        my $output = '';
        while (<$addr_file>) {
            $output .= $_;
        }
        print_heading('ip addr show', 'ip_addr');
        print_preformatted($output);
        print_footer('ip_addr');
    }

    for my $bond_dir ('/proc/net/bonding') {
        if (opendir(DIR, $bond_dir)){
                print_heading('/proc/net/bonding');
            while (my $bond_file = readdir(DIR)) {
                next if ($bond_file =~ m/^\./);
                print_bold($bond_file);
                if (my $bond_state = read_file("$bond_dir/$bond_file")){
                    print_preformatted($bond_state);
                }
            }
            closedir(DIR);
        }
    }

    if (my $cstate_file = `cat /sys/module/intel_idle/parameters/max_cstate 2>/dev/null` ) {
        print_heading('Max Cstates');
        print_bold('/sys/module/intel_idle/parameters/max_cstate');
        print_preformatted($cstate_file);
    }

    if (my $ovs_file = `ovs-vsctl -V 2>/dev/null; ovs-vsctl show 2>/dev/null` ) {
        print_heading('OVS Information');
        print_heading('ovs-vsctl -V; show');
        print_preformatted($ovs_file);
        if (my $ovs_file1 = `ovs-appctl dpctl/show 2>/dev/null`){
           print_heading('ovs-appctl dpctl/show');
           print_preformatted($ovs_file1);
        }
        if (my $ovs_file2 = `ovs-appctl dpctl/dump-flows -m  2>/dev/null`){
           print_heading('ovs-appctl dpctl/dump-flows -m');
           print_preformatted($ovs_file2);
        }
    }

    for my $onload_dir ('/proc/driver/onload','/proc/driver/onload_cplane') {
        if (opendir(DIR, $onload_dir)){
            if ($onload_dir eq "/proc/driver/onload"){
                print_heading('Onload Control Plane State');
            }
            if ($onload_dir){
                print_heading($onload_dir);
            }
            while (my $onload_file = readdir(DIR)) {
                next if ($onload_file =~ m/^\./);
                print_bold($onload_file);
                if (my $onload_control = read_file("$onload_dir/$onload_file")){
                    print_preformatted($onload_control);
                }
            }
            closedir(DIR);
        }
    }

    if (my $mib_file = `onload_mibdump all 2>&1` ) {
        print_heading('onload_mibdump','mibdump','hide');
        print_preformatted($mib_file);
    }
  print_footer('mibdump');
    if (my $cplane_file = `journalctl --since=yesterday 2>/dev/null | grep onload_cp` ){
        print_heading('Control Plane Logs (journalctl)','cplane','hide');
        print_preformatted($cplane_file);
    }
    elsif (my $cplane_file1 = `cat /var/log/messages 2>/dev/null | grep onload_cp` ) {
        print_heading('Control Plane Logs (/var/log/messages)','cplane','hide');
        print_preformatted($cplane_file1);
    }
  print_footer('cplane');

    if (my $aoed_file = `cat /var/log/solar_aoed.log 2>/dev/null` ) {
        print_heading('Solar_Aoed Logs (/var/log/solar_aoed.log) ');
        print_preformatted($aoed_file);
    }

    my @stat_names = ('name');
    my @stat_values = ();

    for my $iface_name (sort keys(%iface_names)) {
	# ethtool's default output is difficult to parse so
	# include it (almost) verbatim.
	my %ethtool_output;
	for my $option ('', '-a', '-c', '-k', '-g', '-m', '-T', '-n', '--show-fec') {
	    if (my $ethtool_file =
		new FileHandle("ethtool $option '$iface_name' 2>/dev/null |")) {
		while (<$ethtool_file>) {
		    if ($. == 1) {
			s/^\s+//;               # remove whitespaces at the beginning
			s/ for $iface_name://;  # remove redundancy in heading
		    } elsif (/^\n/) {
			next;                   # remove blank lines
		    } else {
			s/^\s*/        /gm;     # indent others consistently
		    }
		    $ethtool_output{$option} .= $_;
		}
	    }
	}
	if (defined(keys %ethtool_output)) {
	    print_heading("Ethernet settings for $iface_name (ethtool)", 'ethset_'.$iface_name);
            for(sort(keys %ethtool_output)) {
                print_heading("ethtool $_ $iface_name");
                print_preformatted($ethtool_output{$_});
            }
      print_footer('ethset_'.$iface_name);
	}
    }

    #For devlink dev params we want to filter down to the SFC / EFCT PCI IDs
    #in order to not pollute output. Therefore, we collect these PCI ID before
    #running the command.
    my @pci_ids;
    for my $iface_name (sort(keys(%$sfc_drvinfo))) {
        my $bus_info = $sfc_drvinfo->{$iface_name}->bus_info;
        push(@pci_ids, $bus_info) if(! grep(/$bus_info/, @pci_ids));

	if (my $versions_file = `cat /sys/class/net/$iface_name/device/versions 2>/dev/null`) {
	    print_heading("Version information for $iface_name (/sys/class/net/$iface_name/device/versions)");
	    print_preformatted($versions_file);
	} elsif (my $devlink_file =`devlink dev info pci/$bus_info  2>/dev/null`) {
	    print_heading("Version information for $iface_name (devlink dev info pci/$bus_info)");
	    print_preformatted($devlink_file);
	}
      my @health_diagnose_options = ('nvcfg-active', 'nvcfg-next', 'nvcfg-stored');
      foreach my $option (@health_diagnose_options) {
        if (my $devlink_file =`devlink health diagnose pci/$bus_info reporter $option 2>/dev/null`) {
	      print_heading("Config for $iface_name (devlink health diagnose pci/$bus_info reporter $option)");
	      print_preformatted($devlink_file);
	    }
      }
    }

    #Collect all devlink params for all PCI devices into hash with parameter
    #name as the key. So for each parameter name it will store the pci_ids
    #value or N/A.
    #
    #For future reference, regex captures PCIE address and parameter output.
    #First capture group is PCI ID 'pci/{12 characters}' e.g. 0000:01.00.0.
    #Next capture groups is all text up to the next instance of 'pci/' or EOF($)
    #This captures all parameters and values for that PCIE address.
    #
    #Return to @devparams is PCI ID in first index into array, then the
    #parameters for that PCI ID repeated for all PCI IDs.
    my (@devparams, $params);
    my %devlink_params;
    if ($params = `devlink dev param  2>/dev/null`) {
        @devparams = ($params =~ /(?:pci\/(.{12}):\n)((?:.*\s)*?)(?=pci\/|$)/g);
        my ($pci_id,$dev_params);
        while (($pci_id, $dev_params) = splice(@devparams, 0, 2)) {
            if (grep(/$pci_id/, @pci_ids)) {
                my $key;
                #We are now working dev link dev params output. Capturing the name and
                #the value for a table. The type and cmode can be seen in RAW output.
                while ($dev_params =~ /(?:name )(.*)(?: .* .*\s)|(?:cmode )(?:.*)(?: .* )(.*)/g){
                    $key = $1 if defined($1);
                    $devlink_params{$key}{$pci_id} = $2 if defined($2);
                }
            }
        }
        @devparams = ();
        #This just formats above hash for table output.
        for my $param (sort(keys(%devlink_params))){
            my @paramvalues;
            for (@pci_ids) {
                push(@paramvalues, $devlink_params{$param}{$_});
            }
            push(@devparams, [$param,  @paramvalues]);
        }
        tabulate("Devlink dev params",
                 'devlink_dev_parmas',
                 ['name', @pci_ids],
                 \@devparams,
                 orient_horiz);

        #Also output the raw 'devlink dev params' output for referencing the
        #parameter types and configuration modes. These are not included in the
        #tabulated output but may be useful.
        print_heading("Devlink dev params: Raw Output", 'devlink_param_raw', 'hide');
        print_preformatted($params);
        print_footer('devlink_param_raw');
    }

    if (my $uefi_info_x3 = `lspci -d 10ee:5084 -vvv | grep -E 'Ethernet|Expansion' 2>/dev/null`) {
        print_heading("UEFI image used for x3 NIC (lspci -d 10ee:5084 -vvv)");
        print_preformatted($uefi_info_x3);
    }

    if (my $auxdev_file = `ls -l /sys/bus/auxiliary/devices/ 2>/dev/null`) {
        print_heading("Auxiliary devices list (ls /sys/bus/auxiliary/devices/)");
        print_preformatted($auxdev_file);
    }

    if (my $auxdrv_file = `ls -l /sys/bus/auxiliary/drivers/ 2>/dev/null`) {
        print_heading("Auxiliary drivers list (ls /sys/bus/auxiliary/drivers/)");
        print_preformatted($auxdrv_file);
    }

    if (my $firmware_file = `ls -l /lib/firmware/xilinx/* 2>/dev/null`) {
        print_heading("Xilinx firmware files (ls -l /lib/firmware/xilinx/* )");
        print_preformatted($firmware_file);
    }

    for my $iface_name (sort (keys%$sfc_drvinfo)) {
	# The additional statistics are regular so parse and re-
	# tabulate them.
	my %stats = (name => $iface_name);
	if (my $ethtool_file =
	    new FileHandle("ethtool -S '$iface_name' 2>/dev/null |")) {
	    while (<$ethtool_file>) {
		if (/^\s*([^:]+):\s*(.+)\n$/) {
		    if (!( grep( /^$1$/, @stat_names ))) {
			push @stat_names, $1;
		    }
		    $stats{$1} = $2;
		}
	    }
	}
	push @stat_values, \%stats;
    }

    print_heading("Interface Statistics", "ethtool");
    tabulate("",
	     'net_stats_sfc',
	     \@stat_names,
	     \@stat_values,
	     orient_vert);
    print_footer();

    if (my $tc_file = new FileHandle("tc -s qdisc show 2>&1 |")) {
	my $output = '';
	while (<$tc_file>) {
	    $output .= $_;
	}
	print_heading('Network queue discipline status (tc)');
	print_preformatted($output);
    }

    if (my $rt_file = `ps -eLo pid,lwp,rtprio,policy,lastcpu,comm |grep -E -i -v ' 99 | - '`) {
        print_heading('Real Time Priority (ps -eLo pid,lwp,rtprio,policy,lastcpu,comm)');
        print_preformatted($rt_file);
    }

    if (-e "/etc/udev/rules.d/70-persistent-net.rules")
    { 	
        if (my $license_file = new FileHandle("cat /etc/udev/rules.d/70-persistent-net.rules 2>/dev/null |")) {
            my $output = '';
            while (<$license_file>) {
                $output .= $_;
            }
            print_heading('70-persistent-net.rules');
            print_preformatted($output);
        }
    }

    if (my $license_file = new FileHandle("sfupdate 2>&1 |")) {
        my $output = '';
        while (<$license_file>) {
            $output .= $_;
        }
        print_heading('Update Utility Output (sfupdate)');
        print_preformatted($output);
    }

    if (my $license_file = new FileHandle("sfkey --report --all 2>&1 |")) {
        my $output = '';
        while (<$license_file>) {
            $output .= $_;
        }
        print_heading('License Information(sfkey --report --all)');
        print_preformatted($output);
    }
    
    if (my $license_file = new FileHandle("sfboot 2>&1 |")) {
        my $output = '';
        while (<$license_file>) {
            $output .= $_;
        }
        print_heading('Sfboot Configurations (sfboot)','sfboot');
        print_preformatted($output);
        print_footer('sfboot');
    }
	
    my @hwtstamp_config;
    for my $iface_name (keys %iface_names) {
	if (my $config = get_hwtstamp_config($iface_name)) {
	    push @hwtstamp_config, [$iface_name, $config->flags,
				    $config->tx_type, $config->rx_filter];
	} else {
	    push @hwtstamp_config, [$iface_name];
	}
    }
    tabulate("Hardware timestamp configuration",
	     'hwtstamp_config',
	     ['iface_name', 'flags', 'tx_type', 'rx_filter'],
	     \@hwtstamp_config,
	     orient_horiz);
} # print_net_status

#Recursively get list of files under $directory"
sub get_recursive_file_in_dir {
    my ($directory) = @_;

    my @all_files;
    opendir my $dh, $directory or die "Could not open directory $directory: $!";
    while (my $entry = readdir $dh) {
        next if $entry eq '.' || $entry eq '..';
	my $full_path = "$directory/$entry";

	if (-f $full_path) {
		push @all_files, $full_path;
	} elsif (-d $full_path) {
		push @all_files, get_recursive_file_in_dir($full_path);
	} } closedir $dh;

    return @all_files;
}

sub print_preformatted_file {
	my @filenames = @_;
	$out_file->print("<div style='display: flex;'>\n");
	for my $filename (@filenames) {
	if (my $content = `cat $filename 2>/dev/null` ) {
		my $heading = join("/", (split(/\//, $filename))[5..8]);
		$out_file->print("<div style='border: 1px solid #000; padding: 10px; margin: 10px;'>\n");
		$out_file->print("<h3>".html_encode($heading)."</h3>\n");
		print_preformatted($content);
		$out_file->print("</div>\n");
	}
}
	$out_file->print("</div>\n");
}

sub read_key_value_debug_files {
    my ($base_dir, @files) = @_;
    my @attributes = ('address');
    my @values = ();

	# Open the file for reading
    for my $file (@files) {
	my $relative_path = substr($file, length($base_dir) + 1);
	push @values, {address => $relative_path};
	open my $fh, '<', $file or die "Cannot open $file: $!";

	while (my $line = <$fh>) {
		chomp $line; # Remove newline characters
		my ($key, $value) = split(':', $line, 2); # Assuming key-value pairs are separated by ':'
		push @attributes, $key if defined $key && !grep { $_ eq $key } @attributes;
		$values[-1]->{$key} = $value;
	}
	close $fh;
    }

    return \@attributes, \@values;
}
sub read_debug_oneline_files {
    my ($base_dir, @files) = @_;
    my @attributes = ('address');
    my @values = ();

	# Open the file for reading
    push @values, {address => "Value"};
    for my $file (@files) {
	my $relative_path = substr($file, length($base_dir) + 1);
	open my $fh, '<', $file or die "Cannot open $file: $!";
	    my $line = <$fh>;
	    chomp $line; # Remove newline characters
            if ($line eq '') {
		next;
	}
	    push @attributes, $relative_path;
	    $values[-1]->{$relative_path} = $line;

	    close $fh;
        }

    return \@attributes, \@values;
}


sub read_debug_dir {
    my ($base_dir, @sub_dirs) = @_;
    my @attributes = ('address');
    my @values = ();
    my @sub_sub_dirs = ();
    for my $sub_dir (@sub_dirs) {
	if (my $list = list_dir("$base_dir/$sub_dir")) {
	    if ($#values < 0) {
		# Get the list of files from the first directory
		# (we assume all directories have the same set of
		# files).
		# Ignore '*_hist' files because they're binary.
		push @attributes, grep(!/_hist$/ && -f "$base_dir/$sub_dir/$_",
				       @$list);
	    }
	    push @values, {address => $sub_dir};
	    for my $attr_name (@attributes[1..$#attributes]) {
		my $attr_value = read_file("$base_dir/$sub_dir/$attr_name");
		chomp($attr_value) if defined($attr_value);
		$values[-1]->{$attr_name} = $attr_value;
	    }
	    # Record subdirectories for later inspection.
	    push @sub_sub_dirs, map("$sub_dir/$_",
				    grep(-d "$base_dir/$sub_dir/$_",
					 @$list));
	}
    }
    return \@attributes, \@values, \@sub_sub_dirs;
}

sub print_sfc_debug_info {
    # This relies on debugfs/procfs support which is likely to be
    # excluded from production drivers.  The most interesting
    # information available here should also be found in the kernel
    # log or the interface statistics.

    my @debug_dirs = find_sfc_debug_dir();

    print_heading('SFC Debug Info', 'sfcdebug');
    foreach my $debug_dir (@debug_dirs) {
        my $base_dir = "$debug_dir/cards";
	if (my $card_dirs = list_dir($base_dir)) {
	    my ($attributes, $values, $sub_dirs);

	    ($attributes, $values, $sub_dirs) =
		read_debug_dir($base_dir, @$card_dirs);
	    tabulate('SFC Adapters', 'sfc_nic',
		     $attributes, $values, orient_vert);

	    ($attributes, $values) =
		read_debug_dir($base_dir, grep(m|/errors$|, @$sub_dirs));
	    tabulate('Error counts', 'sfc_errors',
		     $attributes, $values, orient_vert);

	    ($attributes, $values) =
		read_debug_dir($base_dir, grep(m|/rxq|, @$sub_dirs));
	    tabulate('Receive queues', 'sfc_rxqueue',
		     $attributes, $values, orient_vert);

	    ($attributes, $values) =
		read_debug_dir($base_dir, grep(m|/txq|, @$sub_dirs));
	    tabulate('Transmit queues', 'sfc_txqueue',
		     $attributes, $values, orient_vert);

	    ($attributes, $values) =
		read_debug_dir($base_dir, grep(m|/chan|, @$sub_dirs));
	    tabulate('Event queues', 'sfc_eventqueue',
		     $attributes, $values, orient_vert);

	    ($attributes, $values) =
		read_debug_dir($base_dir, grep(m|/port|, @$sub_dirs));
	    tabulate('Ports', 'sfc_port',
		     $attributes, $values, orient_vert, values_format_pre);
	  }
    }
	print_footer('sfcdebug');
} # print_sfc_debug_info

sub print_x3_debug_info_compat {
    # This relies on debugfs/procfs support which is likely to be
    # excluded from production drivers.  The most interesting
    # information available here should also be found in the kernel
    # log or the interface statistics.
    my @debug_dirs = find_x3_debug_dir();

    print_heading('X3 Debug Info', 'x3debug', 'hide');
    foreach my $debug_dir (@debug_dirs) {
        my $base_dir = "$debug_dir";
        if (my $card_dirs = list_dir($debug_dir)) {
            my ($attributes, $values, $sub_dirs, $sub_dirs_aux, $sub_dirs_rxq, $sub_sub_dirs);

            my $i = 0;
            #print "card dir: $card_dirs\n"
            ($attributes, $values, $sub_dirs) =
            read_debug_dir($base_dir, @$card_dirs);
            tabulate('X3 NIC Params', 'x3_nic',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_debug_dir($base_dir, grep(m|/design_params$|, @$sub_dirs));
            tabulate('X3 Design Params', 'x3_design_params',
                 $attributes, $values, orient_vert);

            ($attributes, $values, $sub_dirs) =
            read_debug_dir($base_dir, grep(m|/port|, @$sub_dirs));
            tabulate('X3 Ports', 'x3_port',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_debug_dir($base_dir, grep(m|/errors$|, @$sub_dirs));
            tabulate('X3 Error counts', 'x3_errors',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_debug_dir($base_dir, grep(m|/link_state$|, @$sub_dirs));
            tabulate('X3 Link State', 'x3_linkstate',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_debug_dir($base_dir, grep(m|/txq|, @$sub_dirs));
            tabulate('X3 Transmit queues', 'x3_txqueue',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_debug_dir($base_dir, grep(m|/evq|, @$sub_dirs));
            tabulate('X3 Event queues', 'x3_eventqueue',
                 $attributes, $values, orient_vert);

            ($attributes, $values, $sub_dirs_aux) =
            read_debug_dir($base_dir, grep(m|/efct|, @$sub_dirs));
            tabulate('X3 Aux Device', 'x3_linkstate',
                 $attributes, $values, orient_vert);

            ($attributes, $values, $sub_sub_dirs) =
            read_debug_dir($base_dir, grep(m|/client|, @$sub_dirs_aux));
            tabulate('X3 Aux Client', 'x3_client',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_debug_dir($base_dir, grep(m|rxq_info|, @$sub_sub_dirs));
            tabulate('X3 RxqInfo', 'x3_client',
                $attributes, $values, orient_vert);

            ($attributes, $values, $sub_dirs_rxq) =
            read_debug_dir($base_dir, grep(m|/rxq|, @$sub_dirs));
            tabulate('X3 Receive queues', 'x3_rxqueue',
                 $attributes, $values, orient_vert);

            ($attributes, $values, $sub_sub_dirs) =
            read_debug_dir($base_dir, grep(m|/nbl$|, @$sub_dirs_rxq));
            tabulate('X3 NIC Buffer List', 'x3_rxqueue',
                 $attributes, $values, orient_vert);

            print_heading('X3 NB List');
            for ($i = 0; $i < 8; $i++) {
                ($attributes, $values) =
                read_debug_dir($base_dir, grep(m|rxq$i/nbl/nb|, @$sub_sub_dirs));
                tabulate("Rxq$i", 'x3_rxqueue',
                    $attributes, $values, orient_vert);
            }

            ($attributes, $values) =
            read_debug_dir($base_dir, grep(m|/hpl$|, @$sub_dirs_rxq));
            tabulate('X3 HP List', 'x3_rxqueue',
                 $attributes, $values, orient_vert);

            ($attributes, $values, $sub_sub_dirs) =
            read_debug_dir($base_dir, grep(m|/dbl$|, @$sub_dirs_rxq));

            print_heading('X3 DB List');
            for ($i = 0; $i < 8; $i++) {
                ($attributes, $values) =
                read_debug_dir($base_dir, grep(m|rxq$i/dbl/db|, @$sub_sub_dirs));
                tabulate("Rxq$i", 'x3_rxqueue',
                    $attributes, $values, orient_vert);
            }

            ($attributes, $values, $sub_sub_dirs) =
            read_debug_dir($base_dir, grep(m|/sbl$|, @$sub_dirs_rxq));

            print_heading('X3 SB List');
            for ($i = 0; $i < 8; $i++) {
                ($attributes, $values) =
                read_debug_dir($base_dir, grep(m|rxq$i/sbl/sb|, @$sub_sub_dirs));
                tabulate("Rxq$i", 'x3_rxqueue',
                    $attributes, $values, orient_vert);
            }
        }
    }
	print_footer('x3debug');
} # print_x3_debug_info_compat

sub print_x3_debug_info {
    # This relies on debugfs/procfs support which is likely to be
    # excluded from production drivers.  The most interesting
    # information available here should also be found in the kernel
    # log or the interface statistics.
    my @debug_dirs = find_x3_debug_dir();

    my $maxrx = 16;
    print_heading('X3 Debug Info', 'x3debug');
    foreach my $debug_dir (@debug_dirs) {
        my $base_dir = "$debug_dir";
        if (my @file_list = get_recursive_file_in_dir($base_dir)) {
            my ($attributes, $values);

            my $i = 0;

            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/card_params$|, reverse @file_list));
            tabulate('X3 Card Params', 'x3_card_params',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/design_params$|, reverse @file_list));
            tabulate('X3 Design Params', 'x3_design_params',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/port_params$|, reverse @file_list));
            tabulate('X3 Port params', 'x3_port',
                 $attributes, $values, orient_vert);
                             
            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/nic_errors$|, reverse @file_list));
            tabulate('X3 NIC errors', 'x3_errors',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/link_state$|, reverse @file_list));
            tabulate('X3 Link State', 'x3_linkstate',
                 $attributes, $values, orient_vert);


            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/txq|, reverse @file_list));
            tabulate('X3 Transmit queues', 'x3_txqueue',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/evq|, reverse @file_list));
            tabulate('X3 Event queues', 'x3_eventqueue',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/aux_dev_params$|, reverse @file_list));
            tabulate('aux_dev_params', 'x3_aux_dev_params',
                 $attributes, $values, orient_vert);
            
            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/client_params|, reverse @file_list));
            tabulate('client_params', 'x3_client',
                 $attributes, $values, orient_vert);
            
	    print_heading("client_rxinfo\n");
	    print_preformatted_file(grep(m|client_rxinfo|, reverse @file_list));
             
            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/rx_queue_params|, reverse @file_list));
            tabulate('X3 Receive queues params', 'x3_rxqueue',
                 $attributes, $values, orient_vert);

            ($attributes, $values) =
            read_key_value_debug_files($base_dir, grep(m|/nbl_params$|, reverse @file_list));
            tabulate('X3 NBL Params', 'x3_nbl_params',
                 $attributes, $values, orient_vert);
            

            print_heading('X3 NB List');
	    my @buf_files = grep { $_ =~ m|rxq\d{1,$maxrx}/nbl_buf_list| } reverse @file_list;
	    my %bus_val;
	    map { my $bus = (split('/'))[-4]; $bus =~ s/\.\d$//; push @{$bus_val{$bus}}, $_ } @buf_files;
	    for my $bus (keys %bus_val) {
		    for ($i = 0; $i < 4; $i++) {
			    my @file = grep { $_ =~ m|port$i/rxq\d{1,$maxrx}/nbl_buf_list| } @{$bus_val{$bus}};
			    if (@file) {
				    print_heading("$bus/port$i\n");
				    print_preformatted_file(@file);
			    }
		    }
	    }

	    ($attributes, $values) =
            read_debug_oneline_files($base_dir, grep(m|/max_hp_id$|, reverse @file_list));
            tabulate('max_hp_id', 'x3_hbl',
                 $attributes, $values, orient_vert);

            print_heading('X3 DB List');
	    my @db_buf_files = grep { $_ =~ m|rxq\d{1,$maxrx}/dbl_buf_list| } reverse @file_list;
	    my %db_bus_val;
	    map { my $bus = (split('/'))[-4]; $bus =~ s/\.\d$//; push @{$db_bus_val{$bus}}, $_ } @db_buf_files;
	    for my $bus (keys %db_bus_val) {
		    for ($i = 0; $i < 4; $i++) {
			    my @file = grep { $_ =~ m|port$i/rxq\d{1,$maxrx}/dbl_buf_list| } @{$db_bus_val{$bus}};
			    if (@file) {
				    print_heading("$bus/port$i\n");
				    print_preformatted_file(@file);
			    }
		    }
	    }

            print_heading('X3 SB List');
	    my @sb_buf_files = grep { $_ =~ m|rxq\d{1,$maxrx}/sbl_buf_list| } reverse @file_list;
	    my %sb_bus_val;
	    map { my $bus = (split('/'))[-4]; $bus =~ s/\.\d$//; push @{$sb_bus_val{$bus}}, $_ } @sb_buf_files;
	    for my $bus (keys %sb_bus_val) {
		    for ($i = 0; $i < 4; $i++) {
			    my @file = grep { $_ =~ m|port$i/rxq\d{1,$maxrx}/sbl_buf_list| } @{$sb_bus_val{$bus}};
			    if (@file) {
				    print_heading("$bus/port$i\n");
				    print_preformatted_file(@file);
			    }
		    }
	    }
    }
}
	print_footer('x3debug');
} # print_x3_debug_info

sub print_nic_type {
    my ($devices, $sfc_drvinfo) = @_;
    my %device_drivers = get_device_drivers();
    my %sfc_devices = get_sfc_devices($devices);
    my @headings = ('subsys_id','vpdr_SN');
    my @vpd_attributes = qw(address product_name vpdr_PN vpdr_EC vpdr_SN);
    my %vpd_values = get_sfc_vpd($sfc_drvinfo, @vpd_attributes);
    my @data = map({[$_, sprintf('%04x', $sfc_devices{$sfc_drvinfo->{$_}->bus_info}->SUBSYSTEM_ID), $vpd_values{$_}->{"vpdr_SN"},]} keys(%$sfc_drvinfo));

    my $values = \@data;
    my $attributes = @headings;
    my @tmp=0;
    if(@data){
    foreach my $line (@data){
        if($line->[2]){
        if( grep(/^$line->[2]/, @tmp) ){
        if( ($line->[1] eq "802C") or ($line->[1] eq "802D")){
            $out_file->print("<p>Note: NIC with Serial number: $line->[2] is a Dell version NIC </p>");
        }
        elsif(($line->[1] eq "802F")){
            $out_file->print("<p>Note: NIC with Serial number: $line->[2] is a Lenovo version NIC </p>");
        }}
        push(@tmp,$line->[2]);
        }}}
    return 0;
} #print brand version of the NIC

sub print_sfc_vpd {
    my ($devices, $sfc_drvinfo) = @_;

    my @attributes = qw(address product_name vpdr_PN vpdr_EC vpdr_SN);
    my %values = get_sfc_vpd($sfc_drvinfo, @attributes);
    my @data = map({[$sfc_drvinfo->{$_}->bus_info,
                            $values{$_}->{"product_name"},
                            $values{$_}->{"vpdr_PN"},
                            $values{$_}->{"vpdr_EC"},
                            $values{$_}->{"vpdr_SN"}]}
                            keys(%$sfc_drvinfo));

    tabulate('Vital product data (VPD)', undef,
	     \@attributes, \@data, orient_vert,
	     values_format_default, 'vitalpd');
} # print_sfc_vpd

sub get_aspm_cap {
    my $sfc_drvinfo = shift;
    my @attributes = shift;
    my %return_values = ();
    my $aspm_warn = 0;

    for my $key (keys(%$sfc_drvinfo)) {
        my $cmd = sprintf("lspci -s %s -vvv | grep -E -e 'LnkCtl:.*ASPM.*Enabled;' -e 'Capabilities: <access denied>' -e 'LnkCtl:.*ASPM.*Disabled;' 2>/dev/null", $sfc_drvinfo->{$key}->bus_info);
        my $aspm_setting = `$cmd`;
        my %values = ();

        if ($aspm_setting =~ /ASPM L.*Enabled/ ) {
            $values{"ASPM"} = "Enabled";
            if (! $aspm_warn) {
                push @interesting_stuff, ["ASPM is enabled which can cause increased latency - check BIOS and Kernel command line", interest_perf];
                $aspm_warn = 1;
            }
        } elsif ($aspm_setting =~ /ASPM Disabled/) {
            $values{"ASPM"} = "Disabled";
        } elsif ($aspm_setting =~ /Capabilities: <access denied>/) {
            $values{"ASPM"} = "Access Denied!"
        } else {
            $values{"ASPM"} = "<N/A>"
        }

        $values{$key} = $key;
        $return_values{$key} = \%values;
    }

    return %return_values;
} # get_aspm_cap

sub print_sfc_aspm_cap {
    my ($sfc_drvinfo) = @_;

    my @attributes = qw(address ASPM);
    my %values = get_aspm_cap($sfc_drvinfo, @attributes);
    my @data = map({[$sfc_drvinfo->{$_}->bus_info, 
                            $values{$_}->{"ASPM"}]}
                            keys(%$sfc_drvinfo));

    tabulate('Active State Power Management (ASPM)', undef,
        \@attributes, \@data, orient_vert,
        values_format_default, 'aspm');
} # print_sfc_aspm_cap

sub print_interesting {
    print_heading('Summary of interesting values');
    if ($out_format == format_html) {
	$out_file->print("    <ul>\n");
    }
    for my $i (0..$#interesting_stuff) {
	my ($condition, $int_type) = @{$interesting_stuff[$i]};
	my $message = $interest_labels[$int_type] . ': ' . $condition;
	if ($out_format == format_html) {
	    $out_file->print("      <li class="
			     . $interest_css_classes[$int_type]
			     . "><a href=\"#match$i\">"
			     . html_encode($message) . "</a></li>\n");
	} else {
	    $out_file->print("$message\n");
	}
    }
    if ($out_format == format_html) {
	$out_file->print("    </ul>\n");
    }
} # print_interesting

sub print_mtd {
    print_heading('MTD partitions (/proc/mtd)');
    if (my $mtd_parts = read_file('/proc/mtd')) {
	print_preformatted($mtd_parts, 0);
    } else {
	print_warning("not readable: $!");
    }
}

sub print_aoe_status {
    my $aoe_data = '/sys/devices/sfc_aoe';
    my $aoe_ls = list_dir($aoe_data);
    my @map_headers = ("index", "base_addr", "comp_info", "length", "name");
    my @version_headers = ("index", "board_rev", "fpga_version",
                           "fc_version", "mum_version", "cpld_version");
    my @build_headers = ("index", "fpga_services_version", "fpga_bsp_version",
                           "fpga_build_changeset", "fpga_services_changeset");
    my @dimm_headers = ("index", "size", "type", "voltage", "status", "partnum");
    my @info_headers = ("index", "byteblaster", "fc_running", "aoe_sm_state", "fpga_powered", "bad_sodimm", "boot");
    my @port_headers = ("index", "vod", "preemp_1stposttap", "preemp_pretap", "preemp_2ndposttap",
			"dc_gain", "rx_eq");
    my %maps = ();
    my @versions = ();
    my @build_params = ();
    my @infos = ();
    my %dimms = ();
    my %ports = ();
    for (@$aoe_ls) {
        if (index($_, 'fpga') != -1) {
            $maps{$_} = [];
        }
    }
    for (@$aoe_ls) {
        if (index($_, 'fpga') != -1) {
            $dimms{$_} = [];
        }
    }

    foreach my $fpga (keys %maps) {
        my $fpga_data = $aoe_data.'/'.$fpga;
        my $fpga_ls = list_dir($fpga_data);
        for (@$fpga_ls) {
            if(index($_, "map") == -1) {
                next;
            }
            my $base_addr = read_file($fpga_data.'/'.$_.'/base_addr');
            my $comp_info = read_file($fpga_data.'/'.$_.'/comp_info');
            my $length = read_file($fpga_data.'/'.$_.'/length');
            my $name = read_file($fpga_data.'/'.$_.'/name');
            chomp $base_addr;
            chomp $comp_info;
            chomp $length;
            chomp $name;
            push @{$maps{$fpga}}, [$_, $base_addr, $comp_info, $length, $name];
        }
        for (@$fpga_ls) {
            if(index($_, "dimm") == -1) {
                next;
            }
            my $size = read_file($fpga_data.'/'.$_.'/size');
            my $type = read_file($fpga_data.'/'.$_.'/type');
            my $voltage = read_file($fpga_data.'/'.$_.'/voltage');
            my $status = read_file($fpga_data.'/'.$_.'/status');
            my $partnum = read_file($fpga_data.'/'.$_.'/partnum');
            chomp $size;
            chomp $type;
            chomp $voltage;
            chomp $status;
            chomp $partnum;
            push @{$dimms{$fpga}}, [$_, $size, $type, $voltage, $status, $partnum];
        }
        my $aoe_state = '';
        for (@$fpga_ls) {
            if(index($_, "state") != -1) {
                $aoe_state = '/state';
                last;
            }
        }
        my $board_rev = read_file($fpga_data.$aoe_state.'/board_rev');
        my $fpga_version = read_file($fpga_data.$aoe_state.'/fpga_version');
        my $fc_version = read_file($fpga_data.$aoe_state.'/fc_version');
        my $mum_version = read_file($fpga_data.$aoe_state.'/mum_version');
        my $cpld_version = read_file($fpga_data.$aoe_state.'/cpld_version');
        my $fpga_services_version = read_file($fpga_data.$aoe_state.'/fpga_services_version');
        my $fpga_bsp_version = read_file($fpga_data.$aoe_state.'/fpga_bsp_version');
        my $fpga_build_changeset = read_file($fpga_data.$aoe_state.'/fpga_build_changeset');
        my $fpga_services_changeset = read_file($fpga_data.$aoe_state.'/fpga_services_changeset');
        if ($aoe_state ne '') {
            my $byteblaster = read_file($fpga_data.$aoe_state.'/has_byteblaster');
            my $fc_running = read_file($fpga_data.$aoe_state.'/fc_running');
            my $aoe_sm_state = read_file($fpga_data.$aoe_state.'/aoe_state');
            my $fpga_power = read_file($fpga_data.$aoe_state.'/fpga_power');
            my $bad_sodimm = read_file($fpga_data.$aoe_state.'/bad_sodimm');
            my $boot_result = read_file($fpga_data.$aoe_state.'/boot_result');
            if (defined($byteblaster)) {
                chomp $byteblaster;
            }
            chomp $fc_running;
            chomp $aoe_sm_state;
            chomp $fpga_power;
            chomp $bad_sodimm;
            chomp $boot_result;
            push @infos, [$fpga, $byteblaster, $fc_running, $aoe_sm_state, $fpga_power,
                         $bad_sodimm, $boot_result];
        }
        chomp $board_rev;
        chomp $fpga_version;
        chomp $fc_version;
        chomp $mum_version;
        if (defined($cpld_version)) {
            chomp $cpld_version;
        }
        chomp $fpga_services_version;
        chomp $fpga_bsp_version;
        chomp $fpga_build_changeset;
        chomp $fpga_services_changeset;
        push @versions, [$fpga, $board_rev, $fpga_version,
                         $fc_version, $mum_version, $cpld_version];
        push @build_params, [$fpga, $fpga_services_version,
                         $fpga_bsp_version, $fpga_build_changeset,
                         $fpga_services_changeset];
        for (@$fpga_ls) {
            if(index($_, "port") == -1) {
                next;
            }
            my $vod = read_file($fpga_data.'/'.$_.'/vod');
            my $preemp_1stposttap = read_file($fpga_data.'/'.$_.'/preemp_1stposttap');
            my $preemp_pretap = read_file($fpga_data.'/'.$_.'/preemp_pretap');
            my $preemp_2ndposttap = read_file($fpga_data.'/'.$_.'/preemp_2ndposttap');
            my $dc_gain = read_file($fpga_data.'/'.$_.'/dc_gain');
            my $rx_eq = read_file($fpga_data.'/'.$_.'/rx_eq');
            chomp $vod;
            chomp $preemp_1stposttap;
            chomp $preemp_pretap;
            chomp $preemp_2ndposttap;
            chomp $dc_gain;
            chomp $rx_eq;
            push @{$ports{$fpga}}, [$_, $vod, $preemp_1stposttap, $preemp_pretap,
				    $preemp_2ndposttap, $dc_gain, $rx_eq];
        }
    }

    tabulate("AOE FPGA Versions", undef, \@version_headers, \@versions,
             orient_horiz);

    tabulate("AOE FPGA Build Info", undef, \@build_headers, \@build_params,
             orient_horiz);

    tabulate("AOE FPGA state", undef, \@info_headers, \@infos,
             orient_horiz);

    foreach my $fpga (keys %ports) {
        tabulate("AOE Port Info ($fpga)", undef, \@port_headers, \@{$ports{$fpga}},
                 orient_horiz);
    }

    foreach my $fpga (keys %dimms) {
        tabulate("AOE DDR Info ($fpga)", undef, \@dimm_headers, \@{$dimms{$fpga}},
                 orient_horiz);
    }

    foreach my $fpga (keys %maps) {
        tabulate("AOE Memory Map ($fpga)", undef, \@map_headers, \@{$maps{$fpga}},
                 orient_horiz);
    }
}

sub apply_interest_rules {
    my $result = {};
    my ($type_name, $value, $context) = @_;
    if (defined($type_name) && exists($interest_rules{$type_name})) {
	for my $rule (@{$interest_rules{$type_name}}) {
	    my ($condition, $int_type) = @$rule;
	    my @tokens = split / /, $condition;
        my $right_value;
        my $left_value;

        next unless defined($value->{$tokens[0]});
        $right_value = $tokens[2];
        #if the right value is not a number (incl. hex 0x notation), it may
        #be a key in a key value pair
        if (!($tokens[2] =~ /^(-)?(0x[0-9a-fA-F]+|\d+(\.\d+)?)$/)) {
            if (defined($value->{$tokens[2]})) {
                $right_value = $value->{$tokens[2]};
            }
            elsif (defined($value->{"port_" . $tokens[2]})) {
                $right_value = $value->{"port_" . $tokens[2]};
            }
        }
        next unless defined($right_value);
        #if the right value is STILL not a number, we should evaluate the
        #left side as a string also
        $left_value = $right_value =~ /^(-)?(0x[0-9a-fA-F]+|\d+(\.\d+)?)$/ ?
        $value->{$tokens[0]} : "\"" . $value->{$tokens[0]} . "\"";
        next unless defined($left_value);

	    if (eval($left_value . ${tokens[1]} . $right_value)) {
            my $message = "$condition ($left_value)";
            $message = "$context - " . $message if defined $context && $context ne '';
            push @interesting_stuff, [$message, $int_type];
            $result->{$tokens[0]} = [$int_type, $#interesting_stuff];
	    }
	}
    }
    return $result;
} # apply_interest_rules

# Return -1 if $version1 less than $version2
# Return 1 if $version1 greater than $version2
# Return 0 if $version1 and $version2 are equal
sub compare_versions {
    my ($version1, $version2) = @_;

    my @parts1 = split /\./, $version1;
    my @parts2 = split /\./, $version2;

    for my $i (0 .. $#parts1) {
        return -1 if ($parts1[$i] < $parts2[$i]);
        return 1 if ($parts1[$i] > $parts2[$i]);
    }
    return 0;
}
sub check_x3_debug_info {

    my @x3_debug_dirs = find_x3_debug_dir();

    my $x3_dir = $x3_debug_dirs[0];
    if (defined $x3_dir and -d $x3_dir) {
	    my $efct_version = get_xilinx_efct_version();
	    my $target_efct_version = "1.5.4.0";
	    my $check_version_info = compare_versions($efct_version, $target_efct_version);
	    if ($check_version_info < 0) {
		    print_x3_debug_info_compat;
	    } else {
		    print_x3_debug_info;
	    }
    }
}


# Establish output stream.
my $minimal = '';
my $version = '';
GetOptions("m" => \$minimal,
           "version|v" => \$version);

if ($version) {
    STDERR->print("AMD Solarflare system report (version $VERSION)\n");
    exit 0;
}

if ($minimal) {
    $out_format = format_minimal;
}

my $out_path;
if ($#ARGV >= 0) {
    $out_path = $ARGV[0];
} else {
    $out_path = 'sfreport-'.$hostname.POSIX::strftime('-%Y-%m-%d-%H-%M-%S.html',
				localtime);
}

if ($out_path ne '-') {
    STDERR->print("AMD Solarflare system report (version $VERSION)\n");
}

if ($out_format != format_minimal) {
    if ($out_path eq '-') {
        $out_file = *STDOUT{IO};
        $out_format = format_text;
    } else {
        $out_file = new FileHandle($out_path, 'w') or die "No write permissions on output directory.\nopen: $!";
        if ($out_path =~ /\.html?$/) {
            $out_format = format_html;
        } else {
            $out_format = format_text;
        }
    }
} else {
    if ($out_path eq '-') {
        $out_file = *STDOUT{IO};
    } else {
        $out_path = 'sfreport-'.$hostname.POSIX::strftime('-%Y-%m-%d-%H-%M-%S.txt',
                                    localtime);
        $out_file = new FileHandle($out_path, 'w') or die "open: $!";
    }        
}

if ($< != 0) {
    STDERR->print
	("WARNING: This script will not provide a full report\n"
	 ."unless you run it as root.\n");
    $USER = "NON-ROOT USER"; 
}

if (my $uptime_file = new FileHandle("uptime 2>&1 |")) {
    $UPTIME = '';
    while (<$uptime_file>) {
         $UPTIME .= $_;
    }
}

if ($out_format == format_html) {
    $out_file->print("\
<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\
 \"http://www.w3.org/TR/html4/strict.dtd\">
<html>
  <head>
    <title>AMD Solarflare system report</title>
    <meta name=\"generator\" value=\"sfreport.pl\">
    <style type=\"text/css\">
      table { border-collapse: collapse; }
      th, td { text-align: left; border: 1px solid black; }
      table.vert th { text-align: right; }
      .error { background-color: #ff5555 }
      .warn { background-color: #ccaa55 }
      .perf { background-color: #cc8080 }
      .badpkt { background-color: #cc55aa }
      td > pre { margin: 0; }
    </style>
    <script>
    function toggle(id) {
      var obj = document.getElementById(id+'_c');
      var lnk = document.getElementById(id+'_l');
      if ( obj ) {
        if ( obj.style.display == 'block' ) {
          obj.style.display = 'none';
          lnk.innerHTML = ' ...Show';
        } else {
          obj.style.display = 'block';
          lnk.innerHTML = ' Hide...';
        }
      }
    }
    </script>
    </head>
  <body>
    <h1>AMD Solarflare system report (version $VERSION)</h1>
    $DATE ($USER)
    
    <hr>
    
    <ul>
      <li><a href='#controller'>Driver / Firmware</a>
      <li><a href='#dmesg'>Kernel messages</a>
      <li><a href='#ethtool'>Interface stats</a>
      <li><a href='#irq'>Interrupts</a>
      <li><a href='#mod_params'>Module Parameters</a>
      <li><a href='#socket_stats'>Socket statistics</a>
      <li><a href='#sfboot'>Sfboot</a>
      <li><a href='#sfcdebug'>SFC Debug Info</a>
      <li><a href='#x3debug'>X3 Debug Info</a>
      <li><a href='#vitalpd'>Vital Product Data</a>
    </ul>
    <hr>
    <h2> System Uptime </h2> $UPTIME
");
} elsif ($out_format == format_text) {
    $out_file->print("AMD Solarflare system report (version $VERSION)\n\n");
}

my $devices = get_pci_devices();
my $sfc_drvinfo = get_sfc_drvinfo();

if ($out_format != format_minimal) {
    my $smbios = new SmbiosInfo;
    print_system_summary($smbios);
    print_physical_memory($smbios) if $smbios->expected;
    print_device_status($devices, $sfc_drvinfo);
    print_net_status($sfc_drvinfo);
    print_sfc_debug_info;
    check_x3_debug_info;
    print_sfc_vpd($devices, $sfc_drvinfo);
    print_sfc_aspm_cap($sfc_drvinfo);
    print_mtd;
    print_aoe_status;

    print_interesting;
    print_nic_type($devices, $sfc_drvinfo);
} else {
    print_short_device_status($devices, $sfc_drvinfo);
}

if ($out_format == format_html) {
    $out_file->print("  </body>\n"
		     ."</html>\n");
}

# Let the user know what output path we picked if none was specified.
STDERR->print("Finished writing report to $out_path\n");
