#!/usr/bin/perl

# UCS Config Parser
# v1.00  8-31-2010  Craig Weinhold
# v1.01  9-01-2010  Added support for port-channels, and a non-table output option
# v1.02  1-26-2012  Fixed SAN port-channel support
# v1.03  4-25-2013  Added vnic template resolution
# v1.04  3-16-2017  cleaned up output

use CGI::Carp qw(fatalsToBrowser);
use POSIX;
use strict;
use XML::Parser;
use CGI qw/:standard *table/;
use Getopt::Long;

eval "use DDGetUserData";
eval "use DDStatusBar";
eval "use DDLogging";
eval "use DDOutput";

our $debug = 0;			# debug display
our $skipempty	= 1;		# trim empty columns
our $skipboring	= 0;		# trim columns with just one value
our $nested	= 1;		# list vnics as a nested table
our $sanboot    = 1;		# resolve sanboot targets
our $restempl	= 1;		# resolve templates
our $numeric	= 2;		# vlan/vsan 0=names, 1=numeric, 2=both
our $orgtree	= 1;		# group results by orgs
our $grouping	= 2;		# output grouping of service profiles:   0=none, 1=by vnics, 2=by vnics and config'd params
our $zwspace    = 1;		# use zero-width spaces to help wrap long field names
our $fmt	= 1;		# 0=text/ascii, 1=html, 2=tab-delimited

our $cgi = (exists $ENV{REQUEST_METHOD});
our @files;

if ($cgi) {		# CGI

	our $style = <<EOT;
body { font: normal 12px/150% Arial, Helvetica, sans-serif; }
th { background-color: lightgrey; text-align: left; }

h2 { text-decoration:underline; }

td { word-break: keep-all; }

div.templates { background-color: #fff0f0; }

//div.org { background-color: #C63D0F; color: white; padding: 1px 5px; }
div.org { background-color: #E9E581; padding: 1px 5px; }

.t1 table tr:first-child th { font-weight: bold; border-bottom: 2px solid #000000; } 
.t1 table tr th {background-color:#991821; color:#FFFFFF; font-weight: normal; border-left: 1px solid #B01C26; }
.t1 table td { color: #80141C; border-left: 1px solid #F7CDCD; }
.t1 table tr:nth-child(odd) { background: #F7CDCD; }

.t2 table tr:first-child th { font-weight: bold; border-bottom: 2px solid #000000; } 
.t2 table tr th {background-color:#7F4614; color:#FFFFFF; font-weight: bold; border-left: 1px solid #BF691E; }
.t2 table td { color: #7F4614; border-left: 1px solid #D9CFB8; }
.t2 table tr:nth-child(odd) { background: #F0E5CC; }

.t3 table tr:first-child th { font-weight: bold; border-bottom: 2px solid #000000; } 
.t3 table tr th {background-color:#00557F; color:#FFFFFF; font-weight: bold; border-left: 1px solid #0070A8; }
.t3 table td { color: #00557F; border-left: 1px solid #E1EEF4; }
.t3 table tr:nth-child(odd) { background: #E1EEf4; }

.t4 table tr:first-child th { font-weight: bold; border-bottom: 2px solid #000000; } 
.t4 table tr th {background-color:#7D7D7D; color:#FFFFFF; font-weight: bold; border-left: 1px solid #A3A3A3; }
.t4 table td { color: #7D7D7D; border-left: 1px solid #DBDBDB; }
.t4 table tr:nth-child(odd) { background: #EBEBEB; }

table { border-collapse:collapse; border: 2px solid; }

th.vnic { text-align:center; }

colgroup { border-left:3px solid; }
EOT
	if (param()) {
		$skipempty	= param('skipempty');
		$skipboring	= param('skipboring');
		$sanboot	= param('sanboot');
		$restempl	= param('restempl');
		$nested		= param('nested');
		$numeric	= param('numeric');
		$orgtree	= param('orgtree');
		$grouping	= param('grouping');
		$zwspace	= param('zwspace');
		$fmt		= param('fmt');
		push(@files, &htmlProcess);
	}

	if ((! @files) || ($fmt != 2)) {			# not tab-delimited
		print header,
			start_html(
				-title=>'Cisco UCS Config Parser',
				-style=>{-code=>$style},
				-meta=>{ 'viewport' => 'width=device-width, initial-scale=1.0' }
			);
	}
}
else {			# CLI
	GetOptions(
		'd|debug' => \$debug,
		't|trim' => \$skipempty,
		'f|format=s' => sub { $fmt = ($_[1] =~ /html/i) ? 1 : ($_[1] =~ /(text|ascii)/i) ? 0 : 2 },
		'n|nested' => \$nested,
		'v|vlan|vsan' => \$numeric,
		'g|group' => \$grouping,
		's|sanboot' => \$sanboot,
		'i|restempl' => \$restempl,
		'o|orgtree' => \$orgtree,
	);

	push(@files, @ARGV);
}

our ($hp, $notes, @org);
our ($lsServer, $lsVif, $lsTemplate);
our ($fabricDceSrv, $fabricLanSan, $fabricPc, $fabricID, $netID, $topSystem, $vmm, $extMgmtPool, $bootPolicy, $bootSanImage);
our (@tableCols, $tableNest);
our $indent;

foreach ( @files ) { &process($_); }

if (! @files) {
	if ($cgi) { &doquery; }
	else { print "usage: $0 [opts] <file>\n"; }
}

if ($cgi) { print end_html; }

exit 0;


sub process
{
	my $file = shift;

	# reset globals
	undef @org;
	undef $lsServer;
	undef $lsVif;
	undef $fabricDceSrv;
	undef $fabricLanSan;
	undef $fabricPc;
	undef $fabricID;
	undef $netID;
	undef $topSystem;
	undef $vmm;
	undef $extMgmtPool;
	undef @tableCols;
	undef $tableNest;
	undef $bootPolicy;
	undef $bootSanImage;
	$indent = 0;
	$notes = {};

	$hp = {				# main data structure
		'sp' => {},
		'lan' => {},
		'san' => {},
		'fabric' => {},
		'boot' => {},
		'topSystem' => {},
	};

	my $parser = new XML::Parser(
		Handlers=> { 'Start' => \&xml_start, 'End' => \&xml_end },
		ErrorContext => 3,
	);

	
	eval { $parser->parsefile($file); };
	if ($@) {
		&err('Error with the XML input');
		print blockquote(pre($@));
		print h3("Click your browser's back button to try again with different input data");
	}
	else {
		# manual overrides...
		$hp->{topSystem}->{services}->{ssh}->{adminState} = 'enabled' if (exists $hp->{topSystem}->{services});
		&dumpResults;
	}
	&pHR;
}

sub doquery
{
	print
		h1('Cisco UCS Configuration Parser'),
		'This script generates a report of a UCS XML configuration file. To get an XML config file, use UCS Manager to backup the config, and be sure to select "All Configuration" and "Preserve identities". Upload the config using the form below.',
		p,
		start_multipart_form( { -name=>'form', -method=>'post' } ),
			'Submit a UCS XML configuration:', ol( &htmlForm('file') ),

			checkbox(-name=>'skipempty', -value=>1, -checked=>1, -label=>'Trim empty columns'), br,
			checkbox(-name=>'skipboring', -value=>1, -checked=>0, -label=>'Trim columns with only one value'), br,
			checkbox(-name=>'sanboot', -value=>1, -checked=>1, -label=>'Add SAN boot info to VHBAs'), br,
#			checkbox(-name=>'restempl', -value=>1, -checked=>1, -label=>'Resolve vNIC templates'), br,
			checkbox(-name=>'orgtree', -value=>1, -checked=>1, -label=>'Group by organizational structure'), br,
			'Grouping of service profiles: ', radio_group(-name=>'grouping', -values=>[0, 1, 2], -labels=>{0=>'none', 1=>'by vNICs only', 2=>'by vNICs and config similarities'}, default=>2), br,
			'Layout: ', radio_group(-name=>'nested', -values=>[0, 1, 2], -labels=>{0=>'one big table', 1=>'grouped tables with nested vNICs', 2=>'no table/printer-friendly'}, -default=>2), br,
			'Template-derived fields: ', radio_group(-name=>'restempl', -values=>[0, 1], -labels=>{0=>'show all values', 1=>'show values when different from template'}, -default=>1), br,
			'Format of VLANs/VSANs: ', radio_group(-name=>'numeric', -values=>[0, 1, 2], -labels=>{0=>'names', 1=>'numeric', 2=>'both'}, -default=>2), br,
			'Output format: ', radio_group(-name=>'fmt', -values=>[1, 2], -labels=>{1=>'html', 2=>'tab-delimited/excel'}, -default=>1), br,
			'Wrap field names (for screen readability): ', radio_group(-name=>'zwspace', -values=>[0, 1], -default=>1, -labels=>{0=>'no', 1=>'yes'}), 

			p,

			submit('Generate report'),
			p,
 			font({-size=>'-2'}, i(<<EOT)),
This tool does not store your config file. If you prefer, you can download <a href="ucsparse.pl">the perl script</a> and run it locally.
EOT
		end_form;
}

sub getuser
{
	if ($ENV{'HTTP_COOKIE'} =~ /wikidbUserName=(.*?);/) {
		return "$1\@cdw.com";
	}
}

sub err
{
	print h1( font({-color=>'red'}, @_) );
	return 0;
}

# ----------------------------------------------------------------------------
# OUTPUT RESULTS

sub pDiv
{
	my $divp = shift;
	if ($fmt==1)	{ 
		print "<div class='" . $divp->[0] . "'>";
		push(@$divp, shift @$divp);
	}
}

sub pNoDiv
{
	if ($fmt==1) {
		print "</div>";
	}
}

sub dumpResults
{
	my $systemName = (exists $hp->{topSystem}->{name}) ? $hp->{topSystem}->{name} . '.' . $hp->{topSystem}->{services}->{dns}->{domain} : 'Unknown';

	if ($fmt == 2) {		# text
		print header(-type=>"application/vnd.ms-excel", -attachment=>"ucs-config-$systemName.xls");
	}

	&pHeader("UCS configuration for $systemName");
	&pItalics('generated on ' . ( scalar localtime() ) );

	&dumpNet('lan', ['t4']);
	&dumpNet('san', ['t4']);
	&dumpNet('fabric', ['t4']);

	my @orgs = ($orgtree) ? (sort byPaddedNum keys %{$hp->{orgs}}) : (undef);

	foreach my $org ( @orgs ) {
		if (@orgs > 1) {
			print p;
			&pDiv(['org']);
			&pHeader( 'org ' . &prettyname( $org ) );
			&pNoDiv;
		}

		my $c = 0;

		$c += &dumpVnicTemplates($org, ['t3']);
		$c += &dumpServiceProfiles($org, 1, ['t3']);	# templates
		$c += &dumpServiceProfiles($org, 2, ['t1']);	# non-templates

		&addNote( "org $org has no templates or service profiles ") if ($c == 0);
	}

	&dumpSystem(['t4']);
	&dumpNotes(['t4']);
}

sub dumpSystem
{
	return if (! %{$hp->{topSystem}});

	pHeader('System');

	foreach (grep !/services/, keys %{$hp->{topSystem}}) {
		&pSettings($_, $hp->{topSystem}->{$_});
	}

	foreach my $which (qw/lan san/) {
		foreach (sort byPaddedNum keys %{$hp->{$which}->{settings}}) {
			&pSettings(uc($which) . ' ' . $_, $hp->{$which}->{settings}->{$_});
		}
	}

	if ($hp->{lan}->{settings}->{mode} =~ /switch/) {
		&addNote("This UCS system is running in switch mode!");
	}

	&pSettings("extMgmtPool",
		$hp->{extMgmtPool}->{count} . " (" . (
			(exists $hp->{extMgmtPool}->{blocks}) ?
				join(', ', @{$hp->{extMgmtPool}->{blocks}}) :
				'none'
		) . ")"
	);

	&pHeader2('Services');

	my $base = $hp->{topSystem}->{services};
	my @cols = qw/service adminState server\/user descr other/;

	&pTableStart(@cols);

	foreach my $service (sort { ($base->{$b}->{adminState} cmp $base->{$a}->{adminState}) || ($a cmp $b) } keys %$base) {

		my $sbase = $base->{$service};
		my @peers = sort byPaddedNum keys %{$sbase->{peers}};
		if (@peers > 0) {	# one or more elements
			foreach my $peer (@peers) {
				my $pbase = $sbase->{peers}->{$peer};

				&pRow($service,	
					$pbase->{adminState} || $sbase->{adminState},
					$peer,
					$pbase->{descr} || $sbase->{descr},
					join(', ', map { $_ . '=' . $pbase->{$_} }
						grep !/(adminState|peers|descr|name)/, keys %$pbase)
				);
			}
		}
		else {										# no elements
			&pRow($service,	
				$base->{$service}->{adminState},
				undef,
				$base->{$service}->{descr},
				join(', ', map { $_ . '=' . $base->{$service}->{$_} } grep !/(adminState|peers|descr|name)/, keys %{$base->{$service}})
			);
		}

	}
	&pTableEnd;
}

sub sanbootSet {
	my($vnic, $boot, $order) = @_;
	$vnic->{"sanboot/Order"} = $order;
	$vnic->{"sanboot/PrimaryTarget"} = $boot->{$order}->{primary};
	$vnic->{"sanboot/SecondaryTarget"} = $boot->{$order}->{secondary};
}

# &templateCompare($vnic, $sp, 'vnicSanConnTempl', 'nwTemplName', 'vHBA', @vnicFcFields);
# &templateCompare($vnic, $sp, 'vnicLanConnTempl', 'nwTemplName', 'vETH', @vnicEtherFields);
# &templateCompare($base, $sp, 'sp', 'srcTemplName', 'Service Profile', @serverFields);

sub templateCompare
{
	my ($base, $sp, $templObj, $key, $label, @fields) = @_;

	return if ((! exists $base->{$key}) || ($base->{$key} !~ /^(.+)$/) || (! exists $hp->{$templObj}));
	my $templName = $1;

	my $t = $hp->{$templObj};

	my $name;
	my $org = $sp;
	$org =~ s/[^\/]+$//;

	# search for template
	while ($org) {		# /root/CustA/Engineering  /root/CustA  /root
		if (exists $t->{$org . $templName}) { $name = $org . $templName; last; }
		$org =~ s/[^\/]+\/$//;
	}

	if (! defined $name) {
		&addNote( $label . ' ' . $base->{name} . " refers to non-existent template $templName", $sp);
		return;
	}

	$base->{$key} = $name;		# set full reference

	push(@fields, keys %$base) if (! @fields);

	my $excludefields = {
		'name' => 1,
		'srcTemplName' => 1,
		'nwTemplName' => 1,
		'type' => 1,
		'descr' => 1,
	};

	foreach (@fields) {
		if (! exists $excludefields->{$_}) {
			if ((exists $t->{$name}->{$_}) && ($base->{$_} eq $t->{$name}->{$_})) {
				$base->{$_} = 'from-template' if ($restempl);
			}
			elsif ((exists $t->{$name}->{$_}) && ($t->{$name}->{$_} ne 'derived'))  {
				&addNote("$label '$base->{name}', field '$_', value '$base->{$_}' is different from template '$name', value '$t->{$name}->{$_}'", $sp);
			}
		}
	}
}

sub dumpVnicTemplates
{
	my $org = shift;
	my $divs = shift;
	my $orgLabel = (defined $org) ? "org $org " : "";
	my $count = 0;

	&pDiv($divs);

	foreach my $templType (qw/vnicSanConnTempl vnicLanConnTempl/) {
		$templType =~ /(San|Lan)/;
		my $which = uc($1);
		my @templs;
		map { push(@templs, $_) if ((! defined $org) || (/^$org[^\/]*$/)) } (keys %{$hp->{$templType}});

		next if (! @templs);

		&pHeader($which . (($which eq 'LAN') ? ' vNIC' : ' vHBA') . " templates");
		my $templRoot = $hp->{$templType};
		my $fields = {};

		foreach (@templs) { &tallyfield($fields, $templRoot->{$_}); }
		&purgefields($fields) if ($skipboring);

		my @fields = grep (!/^(name|nets)/, sort byfields keys %$fields);
		push(@fields, "V$which");
		&pTableStart( 'name', @fields );

		foreach my $vnicTemplate (sort byPaddedNum @templs) {
			my $base = $templRoot->{$vnicTemplate};
			$base->{"V$which"} = &netpretty($vnicTemplate, $which, $base);
			my @cols = ( map { $base->{$_} } @fields );
			&pRow(&prettyname($vnicTemplate), @cols);
			$count++;
		}
		&pTableEnd;
	}

	&pNoDiv;
	return $count;
}

sub dumpServiceProfiles
{
	my $org = shift;
	my $doTemplates = shift;		# 0=both, 1=templates only, 2=instances only
	my $divs = shift;
	my (@splist2, @splist);
	my $orgLabel = (defined $org) ? "org $org " : "";

	map { push(@splist2, $_) if ((! defined $org) || (/^$org[^\/]*$/)) } (sort byPaddedNum keys %{$hp->{sp}});

	map { push(@splist, $_) if ( $hp->{sp}->{$_}->{type} =~ /template/) } @splist2 if ($doTemplates != 2);
	map { push(@splist, $_) if ( $hp->{sp}->{$_}->{type} !~ /template/) } @splist2 if ($doTemplates != 1);

	return undef if (! @splist);

	&pDiv($divs);
	&pHeader( 'Service Profile' . (($doTemplates == 1) ? ' Templates' : 's') );

	# DETERMINE MAX VNICS (for grouping = 0)
	my ($maxVnicFc, $maxVnicEther);
	foreach (@splist) {
		my $base = $hp->{sp}->{$_};
		my $vnicFc = scalar @{$base->{vnicFc}};
		my $vnicEther = scalar @{$base->{vnicEther}};
		$maxVnicFc = $vnicFc if ($vnicFc > $maxVnicFc);
		$maxVnicEther = $vnicEther if ($vnicEther > $maxVnicEther);

		if ($sanboot) {			# DERIVE SANBOOT FIELDS
			my $boot = (exists $base->{boot}) ? $base->{boot} : $hp->{boot}->{$base->{bootPolicyName}};
			next if (! defined $boot);

			if ($base->{boot}->{enforceVnicName} eq 'yes') {			# EXACT MATCH
				for (my $ix=0; $ix<@{$base->{vnicFc}}; $ix++) {
					foreach my $bootOrder (qw/primary secondary/) {
						if ($boot->{target}->{$bootOrder}->{vnicName} eq $base->{vnicFc}->[$ix]->{name}) {	# match
							&sanbootSet($base->{vnicFc}->[$ix], $boot->{target}, $bootOrder);
							last;
						}
					}
				}
			}
			else {									# ORDERED MATCH
				my @vnics = sort { ( $a->{order} <=> $b->{order} ) || ($a->{name} cmp $b->{name}) } @{$base->{vnicFc}};
				&sanbootSet($vnics[0], $boot->{target}, 'primary') if (@vnics > 0);
				&sanbootSet($vnics[1], $boot->{target}, 'secondary') if (@vnics > 1);
			}
		}
	}

	# CREATE GROUPS
	my $spgroups;
	foreach (@splist) {
		my @key;
		if ($grouping == 0) {	push(@key, $maxVnicFc, $maxVnicEther);	}
		else {			push(@key, scalar @{$hp->{sp}->{$_}->{vnicFc}}, scalar @{$hp->{sp}->{$_}->{vnicEther}});	}

		if ($grouping > 1) {
			my $fields = {}; &tallyfield($fields, $hp->{sp}->{$_});
			push(@key, sort byPaddedNum keys %$fields);
		}
		$spgroups->{join($;, @key)}->{$_} = 1;
	}

	# DISPLAY EACH GROUP
	foreach (sort byPaddedNum keys %$spgroups) {
		my ($vnicFc,$vnicEther,undef) = split(/$;/);

		my (@sp, @spt);
		foreach my $x (keys %{$spgroups->{$_}}) {
			if ($hp->{sp}->{$x}->{type} =~ /template/) { push(@spt, $x); }
			else { push(@sp, $x); }
		}

#		print STDERR "spt = @spt\nsp = @sp\n\n";
		my @sps;
		push(@sps, sort byPaddedNum @spt);
		push(@sps, sort byPaddedNum @sp);

#		my @sps = ( sort byPaddedNum keys %{$spgroups->{$_}} );

		if ($nested < 2) {
			if ($grouping == 1) {
				&pHeader2("profiles with $vnicFc vhba's and $vnicEther veth's");
			}
			elsif ($grouping == 2) {
				&pHeader2("similar profiles with $vnicFc vhba's and $vnicEther veth's");
			}
		}

		my $fields = {};
		foreach (@sps) { &tallyfield( $fields, $hp->{sp}->{$_} ); }
		&purgefields($fields) if ($skipboring);

		# delete the table key -- these are always displayed first
#		delete $fields->{name};
#		delete $fields->{'lsBinding/pnDn'};
#		delete $fields->{'srcTemplName'};

		my @fields = grep (!/^(name|lsBinding\/pnDn|srcTemplName)$/, sort byfields keys %$fields);
		unshift(@fields, 'lsBinding/pnDn', 'srcTemplName');

		# figure out which vnic fields to display
		my $vnicFcFields = {};
		my $vnicEtherFields = {};
		foreach (@sps) {
			map { &tallyfield($vnicFcFields, $_) } @{$hp->{sp}->{$_}->{vnicFc}};
			map { &tallyfield($vnicEtherFields, $_) } @{$hp->{sp}->{$_}->{vnicEther}};
		}
		if ($skipboring) {
			&purgefields($vnicFcFields);
			&purgefields($vnicEtherFields);
		}

		my @vnicFcFields = grep (!/^(name|nets|nwTemplName)/, sort byfields keys %$vnicFcFields);
		my @vnicEtherFields = grep (!/^(name|nets|nwTemplName)/, sort byfields keys %$vnicEtherFields);
		unshift(@vnicFcFields, 'name', 'nwTemplName');
		unshift(@vnicEtherFields, 'name', 'nwTemplName');
		push(@vnicFcFields, 'VSAN');
		push(@vnicEtherFields, 'VLAN');

		# prepare column headers

		my @headers = @fields;
# (
#			'lsBinding/pnDn',
#			'srcTemplName',
#			@fields,
#		);

		if (! $nested) {						# display vnics on a single table
			for (my $ix=1; $ix<=$vnicFc; $ix++) {				# vnicFc fields
				push(@headers, map { sprintf("vfc%02d:$_", $ix) } @vnicFcFields);
			}

			for (my $ix=1; $ix<=$vnicEther; $ix++) {			# vnicEther fields
				push(@headers, map { sprintf("veth%02d:$_", $ix) } @vnicEtherFields);
			}
		}

		if ($nested < 2)	{ &pTableStart( 'name', @headers ); }

		# display service profiles

		foreach my $sp (@sps) {
			my $base = $hp->{sp}->{$sp};
			&templateCompare($base, $sp, 'sp', 'srcTemplName', 'Service Profile', @fields);

	#		my @cols = ( $base->{lsBinding}->{pnDn}, map { (/^(.*?)\/(.*)$/) ? $base->{$1}->{$2} : $base->{$_} } @fields );
			my @cols = map { (/^(.*?)\/(.*)$/) ? $base->{$1}->{$2} : $base->{$_} } @fields;

			my(@nFc, @nEth);

			my %sanbootMap;

			foreach my $vnic ( sort { ( $a->{order} <=> $b->{order} ) || ($a->{name} cmp $b->{name}) } @{$base->{vnicFc}} ) {	# vnicFc fields
				$vnic->{VSAN} = &netpretty($sp, 'san', $vnic);
				&templateCompare($vnic, $sp, 'vnicSanConnTempl', 'nwTemplName', 'vHBA', @vnicFcFields);
				if ($nested)	{ push(@nFc, [ map { &templatepretty($vnic, $_) } @vnicFcFields] );	}
				else		{ push(@cols, map { &templatepretty($vnic, $_) } @vnicFcFields);	}
			}

			foreach my $vnic ( sort { ( $a->{order} <=> $b->{order} ) || ($a->{name} cmp $b->{name}) } @{$base->{vnicEther}} ) {	# vnicEther fields
				$vnic->{VLAN} = &netpretty($sp, 'lan', $vnic);
				&templateCompare($vnic, $sp, 'vnicLanConnTempl', 'nwTemplName', 'vETH', @vnicEtherFields);
				if ($nested)	{ push(@nEth, [ map { &templatepretty( $vnic, $_ ) } @vnicEtherFields ] );	}
				else		{ push(@cols, map { &templatepretty( $vnic, $_ ) } @vnicEtherFields);	}
			}

			if ($nested < 2) { &pRow(&prettyname($sp), @cols); }
			else {
				&pHeader2( $sp );
				&pIndent;
				&pTableStart;
				for (my $i=0; $i<@headers; $i++) { &pRowFlat($headers[$i], $cols[$i]); }
				&pTableEnd;
			}

			if ( ($nested) && (($vnicFc) || ($vnicEther)) ) {
				if ($nested < 2) { &pStartNested; } else { &pBreak; }
				if ($vnicFc) { &pTableStart(@vnicFcFields); foreach (@nFc) { &pRow(@$_); } &pTableEnd; &pBreak; }
				if ($vnicEther) { &pTableStart(@vnicEtherFields); foreach (@nEth) { &pRow(@$_); } &pTableEnd; }
				if ($nested < 2) { &pEndNested; } else { &pUnindent; }
			}
		}

		&pTableEnd if ($nested < 2);
	}

	&pNoDiv;
	return scalar @splist;
}

# returns a list of vlans, either numeric, named, or both. Also checks for common mistakes, such as a missing vlan ID.
sub netpretty
{
	my($sp, $which, $vnic) = @_;
	my $nets = {};
	my $global = $hp->{lc($which)};
	my $valid = (%$global);

	foreach my $net (keys %{$vnic->{nets}}) {
		my $id_a = $global->{A}->{$net}->{id} if ($valid);
		my $id_b = $global->{B}->{$net}->{id} if ($valid);
		my $id_both = $global->{both}->{$net}->{id} if ($valid);
		my $fabric = $1 if ($vnic->{switchId} =~ /^(\S)/);

		if (($vnic->{switchId} =~ /\-/) && ($id_a != $id_b)) {			# failover NIC
			&addNote( "V" . uc($which) . " '$net' is $id_a on fabric A and $id_b on fabric B. At least one server has a failover vnic using $net, possibly causing unexpected behavior", $sp) if ($valid);
		}
		elsif ( ($fabric eq 'A') && ($id_a) ) {
			$nets->{$net} = $id_a;
		}
		elsif ( ($fabric eq 'B') && ($id_b) ) {
			$nets->{$net} = $id_b;
		}
		elsif ($id_both) {
			$nets->{$net} = $id_both;
		}
		else {
			&addNote("V" . uc($which) . " '$net' is not defined on fabrics", $sp) if ($valid);
			$nets->{$net} = '?';
		}
	}

	if ($numeric == 0) {						# names only
		return join(', ', sort byPaddedNum keys %$nets);
	}
	elsif ($numeric == 1) {						# numbers only
		return netlist(values %$nets);
	}
	else {
		return join(', ', map { $_ . '(' . $nets->{$_} . ')' } keys %$nets);
	}
}

sub tallyfield
{
	my($fields, $item) = @_;
	while ( my($k,$v) = each %$item ) {
		if (! ref($v)) {			# simple scalar
			if (($v ne "") || (! $skipempty)) { $fields->{$k}->{$v}++; }
		}

		elsif (ref($v) eq 'HASH') {		# nested
			while ( my($kp,$vp) = each %$v ) {
				if (($vp ne "") || (! $skipempty)) { $fields->{"$k/$kp"}->{$vp}++; }
			}
		}
	}
}

# delete fields that have only a single value
sub purgefields
{
	my $fields = shift;

	foreach (keys %$fields) {
		delete $fields->{$_} if (scalar keys %{$fields->{$_}} == 1);
	}
}


sub addNote
{
	my($msg, $sp) = @_;

	if (defined $sp) {
		$notes->{$msg}->{$sp}++;
	}
	else {
		$notes->{$msg} = {} if (! exists $notes->{$msg});
	}
}

sub dumpNotes
{
	my $divs = shift;

	if (%$notes) {
		&pDiv($divs);
		&pHeader('Configuration Notes');
		&pListStart;
		foreach (sort byPaddedNum keys %$notes) { &pList($_ . ( (scalar keys %{$notes->{$_}} > 0) ? "(" . join(', ', sort byPaddedNum keys %{$notes->{$_}}) . ")" : "" ) ); }
		&pListEnd;
		&pNoDiv;
	}
}

sub dumpNet
{
	my $which = shift;
	my $divs = shift;
	my $base = $hp->{lc($which)};
	my $dups;

	return if (! %$base);

	if ($which ne "fabric") {
		my $v = uc("v$which");

		&pDiv($divs);
		&pHeader2("$v Definition");

		my @cols = ($which eq 'lan') ? qw/id defaultNet/ : qw/id fcoeVlan/;
		&pTableStart('fabric', 'name', @cols);
		foreach my $fabricID ('both', 'A', 'B') {
			my $nets = $base->{$fabricID};

			foreach my $net (sort { ( $nets->{$a}->{id} <=> $nets->{$b}->{id} ) || &byPaddedNum } keys %$nets) {
				&pRow($fabricID, $net, map { $nets->{$net}->{$_} } @cols);
				$dups->{$nets->{$net}->{id}}->{$net} = 1;
			}
		}
		&pTableEnd;
		&pNoDiv;

		foreach (keys %$dups) {
			if (scalar keys %{$dups->{$_}} > 1) {		# more than one VLAN/VSAN name pointing to same id
				&addNote( "$v $_ has multiple names (" . join(', ', sort byPaddedNum keys %{$dups->{$_}}) . ")");
			}
		}
	}

	&pHeader2(uc($which) . ' Uplink Configuration');

	# determine all physical ports on both switches (should be symmetrical, but doesn't have to be)
	my @fabrics = sort byPaddedNum keys %{$base->{ports}};
	my $portList = {};
	my $fields = {};
	foreach my $fabric (@fabrics) {
		my $f = $base->{ports}->{$fabric};
		map { $portList->{$_} = 1 } keys %$f;		# determine all physical ports to include

		foreach my $p (values %$f) {			# determine which fields to display
			if ( my $x = delete $p->{nets} ) { $p->{uc($which)} = &netlist(keys %$x); }
			&tallyfield( $fields, $p );
		}	
	}

#	&purgefields($fields) if ($skipboring);			# unsure if this is OK

	my @ports = sort byPaddedNum keys %$portList;
	my @cols = grep(!/(portId|slotId|switchId)/, sort keys %$fields);

	&pDiv($divs);
	&pTableStart('port', map { my $fabric=$_; ( map { $fabric . '/' . $_ } @cols ) } @fabrics);

	foreach my $port (@ports) {
		&pRow($port, map { my $fabric=$_; ( map { $base->{ports}->{$fabric}->{$port}->{$_} } @cols ) } @fabrics);
	}
	&pTableEnd;
	&pNoDiv;

}

sub pHeader
{
	if ($fmt==1)	{ print h1(shift()); }
	else		{ print "\n*** " . shift() . " ***\n\n"; }
}

sub pHeader2
{
	if ($fmt==1)	{ print h2(shift()); }
	else		{ print "\n** " . shift() . "\n\n"; }
}

sub pHeader3
{
	if ($fmt==1)	{ print h3(shift()); }
	else		{ print shift() . "\n\n"; }
}

sub pItalics
{
	if ($fmt==1)	{ print i(shift()) . br; }
	else		{ print shift() . "\n"; }
}

sub pSettings
{
	if ($fmt==1)	{ print shift() . ' = ' . b(shift()) . br; }
	elsif ($fmt==2)	{ print join("\t", @_) . "\n"; }
	else		{ print shift() . ' = ' . shift() . "\n"; }
}

sub pList
{
	if ($fmt==1)	{ print li( &nbspit(shift()) ); }
	else		{ print shift() . "\n"; }
}

sub pListStart
{
	if ($fmt==1)	{ print "<ul>"; }
}

sub pListEnd
{
	if ($fmt==1)	{ print "</ul>"; }
}


sub pHR { print hr if ($fmt==1); }

sub pBreak { print br if ($fmt==1); }

sub pIndent { print '<ul>' if ($fmt==1); }

sub pUnindent { print '</ul>' if ($fmt==1); }

sub pTableStart
{
	if ($fmt==1)	{ print start_table({-border=>1, -cellpadding=>3, -cellspacing=>0}); }

	&pRowHeader(@_) if (@_);
#	&pRow(map { "-------------------" } @_) if ($fmt == 0);
	push(@tableCols, scalar @_ || 2);
}

sub pTableEnd
{
	if ($fmt==1)	{ print end_table; }
	pop @tableCols;
}

sub pStartNested
{
	$tableNest = 1;
	if ($fmt==1) {
		print "<tr><td colspan=" . ($tableCols[$#tableCols]) . "><ul>";
	}
}

sub pEndNested
{
	if ($fmt==1) {
		print "</ul></td></tr>";
	}
	$tableNest = 0;
}

sub pRow
{
	print "\t" if (($tableNest) && ($fmt!=1));
	if ($fmt==1)	{ print Tr( map { td($_) } @_ ); }
	elsif ($fmt==2)	{ print join("\t", @_) . "\n"; }
	else		{ print join('', (map { sprintf("%20s", $_) } @_)) . "\n"; }
}

sub pRowFlatHeader
{
	if ($fmt!=1) { &pRow(@_); }
	else { print Tr( { -valign=>'bottom'}, th({-colspan=>2}, &breakit( @_ ) ) ); }
}

sub pRowFlat
{
	if ($fmt!=1) { &pRow(@_); }
	else { print Tr( td({-align=>'right'}, shift @_), map { td($_) } @_); }
}

sub pRowHeader
{
	print "\t" if (($tableNest) && ($fmt!=1));

	if ($fmt==1)	{
		if (grep /^(veth|vfc)\d+\:/, @_) {		# two header lines
			my(@l1, @l2);

			foreach (@_) {
				if ( /^(veth|vfc)(\d+)\:(.*)/ ) { push(@l1, $1.$2); push(@l2, $3); }
				else { push(@l1, 'service profile'); push(@l2, $_); }
			};

			my @cspan = &colspan(@l1);
			print map { colgroup( col( $_->[0] > 1 ? {-span=>$_->[0]} : undef ) ) } @cspan;

			print Tr( {-valign=>'bottom'}, map { ($_->[0] > 1) ? 
					th( {-colspan=>$_->[0], -class=>'vnic'}, $_->[1] ) :
					th( {-rowspan=>2}, &breakit($_->[1]) )
				} @cspan);

			print Tr( {-valign=>'bottom'}, map { th( &breakit( $_ ) ) } @l2 );
		}
		else {						# one header line
			print Tr( {-valign=>'bottom'}, map { th( &breakit( $_ ) ) } @_ );
		}
	}
	elsif ($fmt==2)	{ print join("\t", @_) . "\n"; }
	else {
		print join(' ', (map { sprintf("%20s", $_) } @_)) . "\n";
		print join(' ', (map { "--------------------" } @_)) . "\n";
	}
}

# insert zero-width spaces to help with breaking
sub breakit
{
	my $ZWSPACE = '&#8203;';

	return map {
		my $x = $_;
		$x =~ s/([a-z])([A-Z][a-z]{2})/ $1 . $ZWSPACE . $2/ge;
		$x =~ s/(\/)/ $1 . $ZWSPACE/ge;
		$x;
	} @_;
}

sub nbspit
{
	my $x = shift;
	$x =~ s/,\s*/,/g;
	$x =~ s/ /\&nbsp;/g;
	$x =~ s/,/, /g;
	return $x;
}

# ----------------------------------------------------------------------------
# PARSE CONFIGURATION FILE

sub org { return join('/', @org) . '/'; }

sub xml_start {
	my ($expat, $element, %args ) = @_;
	my @args = sort byPaddedNum keys %args;

	if ($debug) {
		print ('  ' x $indent);
		print $element . " (" . join(', ', map { $_ . '=' . $args{$_} } @args) . ")<br>\n";
	}

	# parse ORG STRUCTURE

	if ($element eq 'orgOrg') {
		push(@org, $args{name});
	}

	# parse SAN BOOT POLICIES		note: global $bootPolicy can be set by lsbootPolicy or a SP's local lsbootDef

	elsif ($element eq 'lsbootPolicy') {
		$bootPolicy = $hp->{boot}->{$args{name}} = { enforceVnicName => $args{enforceVnicName} };
	}
	elsif (defined $bootPolicy) {
		if ($element eq 'lsbootSanImage') {
			$bootSanImage = $bootPolicy->{target}->{$args{type}} = {};
			$bootSanImage->{vnicName} = $args{vnicName};
		}
		elsif (defined $bootSanImage) {
			if ($element eq 'lsbootSanImagePath') {
				$bootSanImage->{$args{type}} = $args{wwn} . ', lun ' . $args{lun};
			}
		}
	}

	# parse SERVICE PROFILE

	elsif ($element eq 'lsServer') {
		$hp->{orgs}->{&org}++;
		my $name = &org . $args{name};
		$lsServer = $hp->{sp}->{$name} = \%args;

		$lsServer->{vnicEther} = [];
		$lsServer->{vnicFc} = [];
	}
	elsif (defined $lsServer) {
		if ($element =~ /^vnic(Ether|Fc)$/) {
			push(@{$lsServer->{$element}}, \%args);					# add all args
			$lsVif = $lsServer->{$element}->[$#{$lsServer->{$element}}]->{nets} = {};	# pointer to interace hash
		}
		elsif (($element =~ /^vnic(Ether|Fc)If$/) && (defined $lsVif)) {
			$lsVif->{$args{name}} = $args{defaultNet};				# sets hash of allowed VLAN/VSAN
		}
		elsif ($element eq 'lsbootDef') {						# local boot definition
			$bootPolicy = $lsServer->{boot} = {};
			map { $bootPolicy->{$_} = $args{$_}  } qw /enforceVnicName name/;		# import only a few fields
		}
		else {										# vnicFcNode, lsPower, lsBinding, ... (only one tier deep allowed)
			$lsServer->{$element} = { %args };
		}
	}

	# parse VNIC TEMPLATES

	elsif ($element =~ /^vnic(Lan|San)ConnTempl$/) {
		$hp->{orgs}->{&org}++;
		my $name = &org . $args{name};
		$lsTemplate = $hp->{$element}->{$name} = { %args };
		$lsVif = $lsTemplate->{nets} = {};
	}
	elsif (defined $lsTemplate) {
		if (($element =~ /^vnic(Ether|Fc)If$/) && (defined $lsVif)) {
			$lsVif->{$args{name}} = $args{defaultNet};				# sets hash of allowed VLAN/VSAN
		}
	}

	# parse FABRIC LAN/SAN PORTS

	elsif ($element =~ /^fabric(Lan|San)Cloud$/) {		# lan/san uplinks
		$fabricLanSan = $hp->{lc($1)} = {};
		$fabricLanSan->{settings} = { %args };
		$fabricLanSan->{ports} = {};
		$fabricID = 'both';
	}
	elsif ( defined $fabricLanSan ) {
		if ($element =~ /^fabric(FcSan|EthLan)$/) {
			$fabricID = $args{id};
		}
		elsif ($element =~ /^fabric(Vlan|Vsan)$/) {
			$netID = $args{id};
			$fabricLanSan->{$fabricID}->{$args{name}} = { %args };
		}
		elsif ($element =~ /fabric(EthLan|FcSan)Pc$/) {
			$fabricPc = { %args };
		}
		elsif ($element =~ /^fabric(EthLan|EthLanPc|FcSan|FcSanPc)Ep$/) {
			my $p = &mergeHash(\$fabricLanSan->{ports}->{$fabricID}->{ $args{slotId} . '/' . $args{portId} }, \%args);

			if (defined $fabricPc) {		# part of a port-channel
				$p->{channelGroup} = $fabricPc->{portId};
				while (my($k,$v) = each %$fabricPc) {		# import settings from port-channel
					$p->{$k} = $v if ($p->{$k} eq '');
				}
			}
		}
		elsif ($element eq 'fabricFcVsanPortEp') {		# special table showing which VSAN is on which port
			$fabricLanSan->{ports}->{$args{switchId}}->{$args{slotId} . '/' . $args{portId}}->{nets}->{$netID}++;
		}
	}

	# parse FABRIC SERVER PORTS

	elsif ($element eq 'fabricDceSrv') {		# server ports
		$fabricDceSrv = $hp->{fabric} = {};
	}
	elsif (defined $fabricDceSrv) {
		if ($element eq 'fabricDceSwSrv') {		# server ports
			$fabricID = $args{id};
		}
		elsif ($element eq 'fabricDceSwSrvEp') {	# physical port info
			$fabricDceSrv->{ports}->{$fabricID}->{$args{slotId} . '/' . $args{portId}}->{adminState} = $args{adminState};
		}
	}
	elsif ($element eq 'computeChassisDiscPolicy') {	# chassis discovery details
		$hp->{fabric}->{settings}->{chassisDiscPolicyAction} = $args{action};
		$hp->{fabric}->{settings}->{chassisDiscPolicyRebalance} = $args{rebalance};
	}

	# parse SYSTEM CONFIGURATION

	elsif ($element eq 'topSystem') {
		$topSystem = $hp->{topSystem} = { %args };		# 'address' and 'name'
	}
	elsif (defined $topSystem) {
		if ($element eq 'commDateTime') {
			$topSystem->{services}->{ntp} = { %args };
		}
		elsif ($element eq 'commNtpProvider') {
			$topSystem->{services}->{ntp}->{peers}->{$args{name}} = { %args };
		}
		elsif ($element eq 'commSnmp') {
			$topSystem->{services}->{snmpv2} = { %args };
		}
		elsif ($element eq 'commSnmpUser') {
			$topSystem->{services}->{snmpv3}->{peers}->{$args{name}} = { %args };
			$topSystem->{services}->{snmpv3}->{adminState} = 'enabled';
		}
		elsif ($element eq 'commDns') {
			$topSystem->{services}->{dns} = { %args };
		}
		elsif ($element eq 'commDnsProvider') {
			$topSystem->{services}->{dns}->{peers}->{$args{name}} = { %args, 'domain' => $topSystem->{services}->{dns}->{domain} };
		}
		elsif ($element =~ /^commSyslog(.*)$/) {
			if ($1 eq 'Client') {
				$topSystem->{services}->{syslog}->{peers}->{$args{hostname}} = { %args };
				$topSystem->{services}->{syslog} = { %args };
			}
		}
		elsif ($element =~ /^aaa(Ldap|Tacacs|Radius)Provider$/) {
			$topSystem->{services}->{lc($1)}->{peers}->{$args{name}} = { %args };
			$topSystem->{services}->{lc($1)}->{adminState} = 'enabled';
		}
		elsif ($element =~ /^comm(.*)/) {
			my $name = $args{name} || lc($1);
			$topSystem->{services}->{$name} = { %args };
		}
		elsif ($element eq 'extvmmProvider') {
			$vmm = $topSystem->{services}->{vmm}->{peers}->{$args{name}} = { %args };
			$vmm->{id} = [];
		}
		elsif (defined $vmm) {
			if ($element =~ /^(vmDCOrg|vmDC|vmOrg)$/) {
				push(@{$vmm->{id}}, $args{name});
			}
			elsif ($element eq 'vmSwitch') {
				$vmm->{vmSwitch} = { %args };
			}
		}
	}
	elsif ($element eq 'ippoolPool') {
		$extMgmtPool = $hp->{extMgmtPool} = {} if ($args{name} eq 'ext-mgmt');
	}
	elsif ( ($element eq 'ippoolBlock') && (defined $element)) {
		my($count, $block) = &iprange($args{from}, $args{to});
		$extMgmtPool->{count} += $count;
		push(@{$extMgmtPool->{blocks}}, $block);
	}

	$indent++;
}

sub xml_end {
	my ($expat, $element) = @_;

	if ($element eq 'orgOrg') {
		pop @org;
	}
	elsif ($element eq 'lsServer') {
		undef $lsServer;
	}
	elsif ( ($element =~ /^vnic(Ether|Fc)$/) && (defined $lsServer) ) {
		undef $lsVif;
	}
	elsif ($element =~ /^vnic(Lan|San)ConnTempl$/) {
		undef $lsTemplate;
	}
	elsif ( ($element =~ /^vnic(Ether|Fc)$/) && (defined $lsTemplate) ) {
		undef $lsVif;
	}
	elsif ( $element =~ /^fabric(Lan|San)Cloud$/ ) {
		undef $fabricLanSan; undef $fabricID;
	}
	elsif ($element =~ /fabric(EthLan|FcSan)Pc$/) {
		undef $fabricPc;
	}
	elsif ( $element eq 'fabricDceSrv' ) {
		undef $fabricDceSrv; undef $fabricID;
	}
	elsif ( $element eq 'topSystem' ) {
		undef $topSystem;
	}		
	elsif ( ($element eq 'lsbootPolicy') || ($element eq 'lsbootDef') ) {
		undef $bootPolicy;
	}
	elsif ( $element eq 'lsbootSanImage' ) {
		undef $bootSanImage;
	}
	elsif ( $element eq 'extvmmProvider' ) {
		$vmm->{id} = join('/', @{$vmm->{id}});
		$vmm->{adminState} = $vmm->{vmSwitch}->{adminState};
		$vmm->{vmSwitch} = $vmm->{vmSwitch}->{name};
		undef $vmm;
	}
	elsif ( $element eq 'ippoolPool' ) {
		undef $extMgmtPool;
	}

	$indent--;
}

sub mergeHash
{
	my ($hpp, $hp) = @_;
	$$hpp = {} if (ref($$hpp) ne 'HASH');
	while (my($k,$v) = each %$hp) { $$hpp->{$k} = $v; }
	return $$hpp;
}

sub byPaddedNum
{
	my($a1,$b1) = ($a,$b);
	$a1 =~ s/(\d+)/sprintf("%08d",$1)/ge;
	$b1 =~ s/(\d+)/sprintf("%08d",$1)/ge;
	return (lc($a1) cmp lc($b1));
}

sub netlist
{
	my (@nets) = @_;

	my ($r1, $r2, @list );
	foreach (sort {$a <=> $b} @nets) {
		if (! defined $r1) { $r1 = $r2 = $_; }
		elsif ($_ == $r2 + 1) { $r2++; }
		else { push(@list, ($r1 == $r2) ? $r1 : "$r1-$r2");  $r1 = $r2 = $_; }
	}
	push(@list, ($r1 == $r2) ? $r1 : "$r1-$r2");

	return join(',', @list);
}

sub iprange
{
	my $from = ($1 << 24) | ($2 << 16) | ($3 << 8) | $4 if ($_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);
	my $to   = ($1 << 24) | ($2 << 16) | ($3 << 8) | $4 if ($_[1] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);
	my $count = abs($to - $from) + 1;

	if (($from & 0xffffff00) == ($to & 0xffffff00)) {	return ($count, $_[0] . '-' . ($to & 0xff));	}
	else {							return ($count, $_[0] . '-' . $_[1]);		}
}

sub prettyname
{
	my $x = shift;
	chop $x if ($x =~ /\/$/);
	if ($x =~ /^root\/(.+)$/) {
		$x = $1;
		if (($x =~ /^(.*)\/([^\/]+)$/) && ($orgtree)) {
			return $2;
		}
		else {
			return $x;
		}
	}
	return $x;
}

sub templatepretty
{
	my ($hp, $v) = @_;
	if ($v eq 'nwTemplName') { return &prettyname($hp->{$v}); }
	else { return $hp->{$v}; }
}

sub colspan
{
	my $x;
	my $count = 0;
	my @results;

	foreach (@_, 'fart') {
		if ($_ eq $x) { $count++; }
		else {
			if ($count) {
				push(@results, [$count + 1, $x]);
				undef $count;
			}
			elsif (defined $x) {
				push(@results, [1, $x]);
			}
			$x = $_;
		}
	}

	return @results;
}

sub byfields
{
	my ($a1, $a2, $b1, $b2);

	if ( $a =~ /^(.*?)\/(.*)$/ ) { $a1 = $1; $a2 = $2; } else { $a2 = $a; }
	if ( $b =~ /^(.*?)\/(.*)$/ ) { $b1 = $1; $b2 = $2; } else { $b2 = $b; }

	return ($a1 cmp $b1) || ($a2 cmp $b2);
}