checktool

#!/usr/bin/perl
#
# Simple tool for manipulating STIG checklists
#
# This tool can be used for manipulating checklists produced by the
# STIG tool.  The basic idea is that once you fill in a checklist with the
# appropriate entries, you can use this tool to migrate all of your filled-in
# data to a new version of the checklist.
#
# There are four subcommands: "dump", "check", "import", and "legacyimport".
#
# "dump" outputs the matches for the given XPath expression given the
# input checklist.  It is intended only to be used by people who have to
# debug or alter this tool.
#
# "check" is given an existing checklist and a new checklist generated from
# a new STIG release.  It will tell you what it thinks needs to change
# (rules added or removed, rules that have been changed).
#
# "import" will do everything that "check" does, except then copy over
# everything it can from the existing checklist to a new checklist specified
# on the command line.  If the rules are identical it will also copy over
# the "Status" (e.g. "Not a Finding"); the idea here is that if everything
# is the same there's no need to review it, but if things have changed
# a human should rewview the changes to make sure nothing needs to be changed
# in the response.  'import' can also take the name of the YAML file which
# contains finding details to be placed in the output file for specific
# vulnerabilities.
#
# "legacyimport" is the same as import, but when doing vulnerability matching
# between checklists it will look for the V-number using the "LEGACY_ID"
# attribute in the new checklist.  This is intended when vulnerability
# numbers are changed by the STIG provider.
#

use XML::LibXML;
use YAML::Syck;

# A list of elements we ignore for rule comparisons

@ignoreattr = ('STIGRef', 'Check_Content_Ref', 'Weight', 'STIG_UUID',
	       'LEGACY_ID', 'CCI_REF', 'Rule_ID', 'Vuln_Num', 'TargetKey');

if ($#ARGV < 0) {
	usage();
}

$legacy = 0;

if ($ARGV[0] eq 'check') {
	$check = 1;
} elsif ($ARGV[0] eq 'import') {
	$import = 1;
} elsif ($ARGV[0] eq 'legacyimport') {
	$import = 1;
	$legacy = 1;
} elsif ($ARGV[0] eq 'dump') {
	$dump = 1;
} else {
	usage();
}

if (($check && $#ARGV != 2) || ($import && ( $#ARGV != 3 && $#ARGV != 4)) ||
    ($dump && $#ARGV != 2)) {
	usage();
}

if ($check || $import || $dump) {
	$oldcheck = XML::LibXML->load_xml(location => $ARGV[1]);
	if ($check || $import) {
		$newcheck = XML::LibXML->load_xml(location => $ARGV[2]);
	}
	if ($import && $#ARGV == 4) {
		$fdata = LoadFile($ARGV[4]);
	}
}

#
# "dump" is designed to handle an XPath expression.  It should only
# be used for testing and development
#

if ($dump) {
	my @nodes = $oldcheck->findnodes($ARGV[2]);
	print "For expression \"$ARGV[2]\", there were ", scalar(@nodes),
	      " matches\n";
	foreach my $elem (@nodes) {
		print "Node: ", ref($elem), ", name = ", $elem->nodeName,
		      ", path = ", $elem->nodePath(), ", value = ",
		      $elem->nodeValue(), "\n";
	}
	exit 0;
}

$oldvuls = getvuls($oldcheck, $ARGV[1], 0);
$newvuls = getvuls($newcheck, $ARGV[2], $legacy);

#
# Report which vulnerabilities have been removed from old to new, and
# which ones have been added
#

foreach my $vul (sort(keys %$oldvuls)) {
	if (! exists $newvuls->{$vul}) {
		print "Vulnerability $vul removed from new checklist\n";
	} else {
		push @xfervuls, $vul;
	}
}

foreach my $vul (sort(keys %$newvuls)) {
	if (! exists $oldvuls->{$vul}) {
		print "Vulnerability $vul added in new checklist\n";
	}
}

#
# The array @xfervuls contains the intersection of vulnerabilities between
# the old and new checklist.  Cycle through each one and compare the
# vulerabilities.  We always copy over the FINDING_DETAILS; if the rule
# "matches" (for some definition of "match"), then we set the status
# to the value of the original rule status.  Otherwise set the status
# to "Open"
# 

foreach my $vul (@xfervuls) {

	# We're printing out the exact difference in comprule now

	if ($import) {
		copyrule($oldvuls->{$vul}, $newvuls->{$vul}, $vul, $fdata,
			 comprule($oldvuls->{$vul}, $newvuls->{$vul}, $vul));
	} else {
		comprule($oldvuls->{$vul}, $newvuls->{$vul}, $vul);
	}
}

if ($import) {
	#
	# Copy over asset data.  Loop through the asset data in the old
	# file and transfer it over IF the node exists in 
	#

	my @assetlist = $oldcheck->findnodes('/CHECKLIST/ASSET/*');
	my ($newasset) = $newcheck->findnodes('/CHECKLIST/ASSET');

	foreach my $asset (@assetlist) {
		if (! $newasset->exists($asset->nodeName)) {
			print "Warning: asset " . $asset->nodeName .
				" does not exist in new checklist\n";
			next;
		}
		#
		# Skip over blank nodes
		#
		if (! defined($asset->textContent) ||
		    $asset->textContent eq '') {
			next;
		}

		#
		# If there's a text node then grab that and set it,
		# otherwise use appendTextNode
		#

		my ($newanode) = $newasset->findnodes($asset->nodeName);

		if ($newanode->exists('text()')) {
			my ($newtnode) = $newanode->findnodes('text()');
			$newtnode->setData($asset->textContent);
		} else {
			$newanode->appendTextNode($asset->textContent);
		}
	}

	#
	# libxml wants to turn empty elements into self-closing tags.
	# Specifically, it wants to turn things like:
	#
	# <FOO></FOO>
	#
	# into
	#
	# <FOO/>
	#
	# Which is technically fine as they are semantically equivalent ...
	# but in my experience the STIG viewer can be kind of sensitive to
	# changes in the XML like this (I think it is telling that the
	# checklists we get from the STIG viewer never use self-closing
	# tags).  So for EVERY element in the output document that is
	# empty, add an empty text node.  That will force libxml to
	# never use a self-closing tag.
	#

	#
	# This XPath expression breaks down like this:
	#
	# //*			Match all nodes in document
	# [not(node())]		Only ones without children.  Note:
	#			A standalone node() means child::node().
	#

	for my $node ($newcheck->findnodes('//*[not(node())]')) {
		#
		# appendText doesn't work in this case; we actually need
		# to make sure we create a text node.
		#
		$node->appendChild($newcheck->createTextNode(''));
	}

	#
	# Generate output file
	#

	$newcheck->toFile($ARGV[3], 0);
}

exit 0;

sub comprule {
	my ($oldrule, $newrule, $vulname) = @_;

	#
	# Get a list of all STIG_DATA attributes for old and new vulnerability
	#

	my @oldattr = $oldrule->findnodes("STIG_DATA");
	my @newattr = $newrule->findnodes("STIG_DATA");

	#
	# Generate a hash for each attribute name and data.
	#

	my %oldathash = map { $_->findvalue('VULN_ATTRIBUTE') => $_->findvalue('ATTRIBUTE_DATA') } @oldattr;
	my %newathash = map { $_->findvalue('VULN_ATTRIBUTE') => $_->findvalue('ATTRIBUTE_DATA') } @newattr;

	#
	# Delete out hash table entries that we specifically ignore
	# (because they always change, or are new and we don't care if
	# they are missing from the old checklist).  Note we only delete
	# from newathash because we use that as the list to base things on.
	#

	map { delete $newathash{$_}; } @ignoreattr;

	#
	# So here is our logic where we decide if a vulnerability is the "same"
	# or not to the point where we can mark it as "not a finding".
	#
	# If an attribute exists in the old checklist but not in the new,
	# we don't care about that and consider it still ok.  Note that we
	# don't actually check for this case, because we are using the new
	# list of rules, we don't actually check for this at all.
	#
	# Certain attributes always change; those are in @ignoreattr and
	# those should have been deleted from the hash.
	#
	# If an attribute is NEW in the new checklist, then consider the
	# rule NOT EQUAL.
	#
	# Do a string comparison on the attribute data between old and new;
	# if it is NOT the same, then consider it NOT EQUAL.
	#
	# Otherwise it is equal.
	#

	foreach my $attr (keys %newathash) {
		if (! exists $oldathash{$attr}) {
			print "In $vulname attribute $attr not in old checklist\n";
			return 0;
		}

		if ($oldathash{$attr} ne $newathash{$attr}) {
			print "In $vulname attribute $attr has changed\n";
			return 0;
		}
	}

	return 1;
}

#
# Get a list of vulernability numbers and nodes for a checklist.
#
# This returns a hash reference where the keys are vulnerability numbers
# (usually in the form V-XXXX) and the value is the LibXML node which
# corresponds to the vulnerability.
#

sub getvuls {
	my ($checklist, $name, $uselegacy) = @_;
	my %hashret;

	#
	# The vulernabilities are all under the XML path:
	# /CHECKLIST/STIGS/iSTIG
	#
	# Each vulnerability is a VULN node under the above path.
	#
	# Currently each VULN node consists of elements consisting
	# of STIG_DATA elements, a STATUS element, FINDING_DETAILS, COMMENTS,
	# SEVERITY_OVERRIDE, and SEVERITY_JUSTIFICATION
	#
	# The STIG_DATA elements all contain two elements: a VULN_ATTRIBUTE
	# and ATTRIBUTE_DATA.  These are basically key-value pairs that
	# contains information about each vulnerability.  The key thing
	# we care about here is the node that contains a VULN_ATTRIBUTE
	# of "Vuln_Num"; the corresponding ATTRIBUTE_DATA is the
	# vulerability number.
	#

	#
	# Extract out a list of VULN elements; these are a list of nodes
	# as described above.
	#

	my @vuls = $checklist->findnodes('/CHECKLIST/STIGS/iSTIG/VULN');

	die "No vulnerabilities found in $name\n" if (scalar(@vuls) == 0);

	#
	# For each vulnerability, extract the vulnerability number out
	# and use it as a key for our hash.  It lives under the STIG_DATA
	# element that has a VULN_ATTRIBUTE value of "Vuln_Num"
	#

	foreach my $node (@vuls) {
		my $v;

		if ($uselegacy) {
			$v = $node->findvalue('STIG_DATA[VULN_ATTRIBUTE="LEGACY_ID" and starts-with(ATTRIBUTE_DATA, "V-")]/ATTRIBUTE_DATA');
			if (! defined($v) || $v eq '') {
				warn "Missing LEGACY_ID for rule " .
					$node->findvalue('STIG_DATA[VULN_ATTRIBUTE="Rule_ID"]/ATTRIBUTE_DATA') .
					", assuming is new vulnerability " .
					"and using new V-number\n";
				$v = $node->findvalue('STIG_DATA[VULN_ATTRIBUTE="Vuln_Num"]/ATTRIBUTE_DATA');
			}
		} else {
			$v = $node->findvalue('STIG_DATA[VULN_ATTRIBUTE="Vuln_Num"]/ATTRIBUTE_DATA');
		}

		die "Internal error; cannot find vulnerability number " .
		    "for Rule ID " .
		    $node->findvalue('STIG_DATA[VULN_ATTRIBUTE="Rule_ID"]/ATTRIBUTE_DATA') . "\n"
			if (! defined($v) || $v eq '');

		die "Internal error: multiple vulnerabilities found ",
			"for $v\n" if exists($hashret{$v});

		$hashret{$v} = $node;
	}

	return \%hashret;
}

#
# Copy information from the old checklist to the new.  Bring over the
# FINDING_DETAILS and COMMENTS from the old vulnerability to the new.  If the
# third argument is true, then bring over the STATUS as well, otherwise
# set it to 'Open'
#

sub copyrule {
	my ($oldrule, $newrule, $vulname, $fdata, $copystatus) = @_;

	my @oldfind = $oldrule->findnodes('FINDING_DETAILS');
	my @newfind = $newrule->findnodes('FINDING_DETAILS');
	my @oldcomm = $oldrule->findnodes('COMMENTS');
	my @newcomm = $newrule->findnodes('COMMENTS');
	my @oldstat = $oldrule->findnodes('STATUS');
	my @newstat = $newrule->findnodes('STATUS');

	my @list = (\@oldfind, \@newfind, \@oldcomm, \@newcomm,
		    \@oldstat, \@newstat);

	foreach (@list) {
		if (scalar(@$_) != 1) {
			die "Internal error: for rule $vulname expected a " .
			    "single match for FINDING_DETAILS, COMMENTS, or " .
			    "STATUS but found " . scalar(@$_) . "\n";
		}
	}

	#
	# Get out the text children of these elements
	#

	my ($oldfindt) = $oldfind[0]->childNodes();
	my ($newfindt) = $newfind[0]->childNodes();
	my ($oldcommt) = $oldcomm[0]->childNodes();
	my ($newcommt) = $newcomm[0]->childNodes();
	my ($oldstatt) = $oldstat[0]->childNodes();
	my ($newstatt) = $newstat[0]->childNodes();

	#
	# So, THIS is weird.  Technically things like FINDING_DETAILS
	# are element nodes, and any text associated with them are text
	# nodes that are children of the element node.  But if there is
	# no text at all, there is no text node.  So for that case we
	# should use the appendTextNode method to add a text string directly
	# to the element node
	#

	my $finding;
	my $status;

	if (defined($fdata) && exists $fdata->{$vulname}) {
		print "Using finding data for $vulname\n";
		$finding = $fdata->{$vulname}->{'FINDING_DETAIL'};
		chomp($finding);
		$status = $fdata->{$vulname}->{'STATUS'};
	} else {
		#
		# Make sure there was finding data; if not, use a
		# blank string
		#
		if (defined($oldfindt)) {
			$finding = $oldfindt->data;
		} else {
			$finding = '';
		}
		$status = $oldstatt->data;
	}

	if (defined($newfindt)) {
		$newfindt->setData($finding);
	} else {
		$newfind[0]->appendTextNode($finding);
	}

	#
	# If there was a comment, then copy it over
	#

	if (defined($oldcommt)) {
		if (defined($newcommt)) {
			$newcommt->setData($oldcommt->data);
		} else {
			$newcomm[0]->appendTextNode($oldcommt->data);
		}
	}

	#
	# There should always be a text node for the status
	#

	if ($copystatus) {
		$newstatt->setData($status);
	} else {
		$newstatt->setData('Open');
	}
}

sub usage {
	print <<"EOF";
Usage:	$0 check old-checklist new-checklist
	$0 import old-checklist new-checklist output-checklist [finding-yaml]
	$0 legacyimport [import-options]
	$0 dump checklist XPath-expression

	legacyimport should be used migrating from a checklist that has changed
	major version numbers.  Instead of matching up vulnerabilies based
	on the vulnerability number, it will use the "Legacy ID" in
	"new-checklist" as the matching element.
EOF
	exit 1;
}