#!/usr/bin/perl
#
# Copyright 2005-2012 SPARTA, Inc.  All rights reserved.  See the COPYING
# file distributed with this software for details.
#
#
# cleankrf
#
#	This script cleans unused key keyrecs from a keyrec.
#

use strict;

use Getopt::Long qw(:config no_ignore_case_always);

use Net::DNS::SEC::Tools::conf;
use Net::DNS::SEC::Tools::keyrec;
use Net::DNS::SEC::Tools::tooloptions;

#
# Version information.
#
my $NAME   = "cleankrf";
my $VERS   = "$NAME version: 1.13.0";
my $DTVERS = "DNSSEC-Tools Version: 1.13";

#######################################################################

#
# Data required for command line options.
#
my $count   = 0;			# Error-count flag.
my $list    = 0;			# List-only flag.
my $quiet   = 0;			# Quiet flag.
my $remove  = 0;			# Remove key file flag.
my $verbose = 0;			# Verbose flag.
my %options = ();			# Filled option array.
my @opts =
(
	"count",			# Give final error count.
	"list",				# Only list orphaned keys, don't delete.
	"quiet",			# Don't give any output.
	"rm",				# Remove key file.
	"verbose",			# Give lotsa output.
	"Version",			# Show version number.
	"help",				# Give a usage message and exit.
);

my $orphsets	= 0;			# Total count of orphaned sets.
my $orphans	= 0;			# Total count of orphaned keys.
my $obsoletes	= 0;			# Total count of obsolete keys.


my @krnames;				# List of keyrecs in the file.

my %zones = ();				# Names of zone keyrecs.
my %sets = ();				# Names of set keyrecs.
my %keys = ();				# Names of key keyrecs.

main();
exit($orphans);

#-----------------------------------------------------------------------------
# Routine:	main()
#
# Purpose:	This is the top-level processing routine for the command.
#
sub main
{
	my $argc = @ARGV;		# Number of command line arguments.

	erraction(ERR_EXIT);

	#
	# Check our options.
	#
	optsandargs();

	#
	# Search each specified keyrec file individually for orphaned
	# key keyrecs.
	#
	while($argc > 0)
	{
		#
		# Read the keyrec file.
		#
		getkeyrecs($ARGV[0]);

		#
		# Check for orphaned signing sets.
		#
		setchecks();

		#
		# Check for orphaned and obsolete keys.
		#
		keychecks();

		#
		# Move on to the next keyrec file.
		#
		shift @ARGV;
		$argc = @ARGV;
	}

	#
	# Save the modified keyrec file -- iff we're not just listing.
	#
	keyrec_write() if(!$list);

	#
	# If -count was given, give the counts of orphaned and obsolete keys.
	#
	if($count)
	{
		#
		# Check for orphaned sets.
		#
		if($orphsets == 1) { print("1 orphaned set\n"); }
		else		   { print("$orphsets orphaned sets\n"); }

		#
		# Check for orphaned keys.
		#
		if($orphans == 1) { print("1 orphaned key\n"); }
		else		  { print("$orphans orphaned keys\n"); }

		#
		# Check for obsolete keys.
		#
		if($obsoletes == 1) { print("1 obsolete keys\n"); }
		else		    { print("$obsoletes obsolete keys\n"); }
	}
}

#-----------------------------------------------------------------------------
# Routine:	optsandargs()
#
# Purpose:	This routine processes the command's options and arguments.
#
sub optsandargs
{
	my $argc = @ARGV;		# Number of command line arguments.

	GetOptions(\%options,@opts) || usage();
	$count	 = $options{'count'};
	$list	 = $options{'list'};
	$quiet	 = $options{'quiet'};
	$remove	 = $options{'rm'};
	$verbose = $options{'verbose'};

	usage()   if(defined($options{'help'}));
	version() if(defined($options{'Version'}));

	#
	# Can't have verbosity and quietude.
	#
	$verbose = 0 if($quiet);

	#
	# Ensure we were given a keyrec file to check.
	#
	usage() if($argc == 0);
}

#-----------------------------------------------------------------------------
# Routine:	getkeyrecs()
#
# Purpose:	This routine reads a keyrec file and puts each keyrec into
#		either a zone hash or a key hash.
#
sub getkeyrecs
{
	my $krfile = shift;			# Keyrec file.

	#
	# Read the keyrec file and get a list of the keyrec names.
	#
	keyrec_read($krfile);
	@krnames = keyrec_names();

	#
	# Go through each keyrec and put it in the appropriate hash table.
	#
	foreach my $krn (sort(@krnames))
	{
		my $kr;				# Reference to keyrec.
		my %keyrec;			# Keyrec.
		my $type;			# Keyrec's type.
		my $styp;			# Keyrec's set type.

		$kr = keyrec_fullrec($krn);
		%keyrec = %$kr;

		$type = $keyrec{'keyrec_type'};
		$styp = $keyrec{'set_type'};

		if($type eq 'zone')
		{
			$zones{$krn} = $kr;
		}
		elsif(($type eq 'set') ||
		      (($type eq 'kskobs') && ($styp eq 'kskobs')))
		{
			$sets{$krn} = $kr;
		}
		else
		{
			$keys{$krn} = $kr;
		}
	}
}

#-----------------------------------------------------------------------------
# Routine:      setchecks()
#
# Purpose:      This routine searches the list of signing sets in a keyrec
#               file for orphaned sets.  If found, the orphans are deleted,
#		unless the -list option was specified.
#
sub setchecks
{
	#
	# If there are no signing sets, we have nothing here to do.
	#
	if(length(%sets) == 0)
	{
		vprint("no signing sets defined\n");
		return;
	}

	#
	# Check each key to see if it is an orphan.  If so, we'll delete it,
	# unless the user just wants a list of orphans.
	#
	foreach my $setname (sort(keys(%sets)))
	{
		my $zone = $sets{$setname}{'zonename'};		# Set's zone.

		#
		# Handle two error conditions:
		#	- the set's zone doesn't exist
		#	- the set isn't a current set in its zone
		#
		if(!defined($zones{$zone}))
		{
			qprint("warning:  set $setname references $zone, but $zone does not exist\n");
			$orphsets++;
		}
		elsif(($zones{$zone}{'zskcur'} ne $setname)	&&
		      ($zones{$zone}{'zskpub'} ne $setname)	&&
		      ($zones{$zone}{'zsknew'} ne $setname)	&&
		      ($zones{$zone}{'zsknew'} ne $setname)	&&
		      ($zones{$zone}{'kskcur'} ne $setname)	&&
		      ($zones{$zone}{'kskpub'} ne $setname)
		     )
		{
			qprint("obsolete set:  $setname\n");
			$orphsets++;

			#
			# Resetting the keyrec_type to ensure that obsolete
			# KSK sets will actually be deleted.
			#
			keyrec_setval('set',$setname,'keyrec_type','set');
		}
		else
		{
			vprint("referenced set:  $setname  ($zone)\n");
			next;
		}

		#
		# Go to the next set if we're just listing or if this
		# one is okay.
		#
		next if($list);

		#
		# Delete the set.
		#
		keyrec_del($setname);
		delete $sets{$setname};
	}
}

#-----------------------------------------------------------------------------
# Routine:	keychecks()
#
# Purpose:	This routine searches the list of keys in a keyrec file for
#		orphaned keys.  If found, the orphans are deleted, unless
#		the -list option was specified.
#
sub keychecks
{
	#
	# If there are no keys, we have nothing here to do.
	#
	if(length(%keys) == 0)
	{
		vprint("no keys defined\n");
		return;
	}

	#
	# Check each key to see if it is obsolete.  If so, we'll delete it,
	# unless the user just wants a list of obsolete keys.
	#
	# This should find anything, as obsolete keys should be orphans.
	# However, we'll do this check just to be sure.
	#
	foreach my $keyname (sort(keys(%keys)))
	{
		my $kr;				# Keyrec reference.
		my %keyrec;			# Keyrec hash.

		$kr = $keys{$keyname};
		%keyrec = %$kr;

		if(($keyrec{'keyrec_type'} eq "zskobs")	||
		   ($keyrec{'keyrec_type'} eq "kskobs")	||
		   ($keyrec{'keyrec_type'} eq "kskrev"))
		{
			qprint("obsolete key:  $keyname\n");
			$obsoletes++;

			next if($list);

			rmkey($keyname) if($remove);
			keyrec_del($keyname);
			delete $keys{$keyname};
		}
	}

	#
	# Check each key to see if it is an orphan.  If so, we'll delete it,
	# unless the user just wants a list of orphans.
	#
	foreach my $keyname (sort(keys(%keys)))
	{
		if(orphankey($keyname))
		{
			next if($list);

			rmkey($keyname) if($remove);
			keyrec_del($keyname);
			delete $keys{$keyname};
		}
	}
}

#-----------------------------------------------------------------------------
# Routine:	orphankey()
#
# Purpose:	This routine checks if a given key is an orphan or if it's
#		referenced by a signing set.
#		The orphan count is incremented when an orphan is found.
#
# Return Values:
#		0 - referenced key
#		1 - orphaned key
#
sub orphankey
{
	my $keyname = shift;			# Keyrec's name.
	my $kr;					# Keyrec reference.
	my %keyrec;				# Key's keyrec.
	my @keysets = ();			# Set list.
	my $found = 0;				# Found flag.

	#
	# Get the key's keyrec and save the its zone name.
	#
	$kr = $keys{$keyname};
	%keyrec = %$kr;

	#
	# Check the zones to see if one references this key.
	#
	foreach my $setname (sort(keys(%sets)))
	{
		if(keyrec_signset_haskey($setname,$keyname))
		{
			push @keysets, $setname;
			$found = 1;
		}
	}

	#
	# Give an appropriate message.  If the key was found, we'll
	# report all the sets it belongs to.
	#
	if($found)
	{
		my $setlist;			# All of key's sets.

		$setlist = join ' ', @keysets;
		vprint("referenced key:  $keyname $setlist\n");
		return(0);
	}

	#
	# This key isn't referenced by any of our zones, so it's an orphan.
	# Bump our counter and give an error message.
	#
	qprint("orphaned key:  $keyname\n");
	$orphans++;
	return(1);
}

#-----------------------------------------------------------------------------
# Routine:	rmkey()
#
# Purpose:	This routine deletes the .key and .private file associated
#		with the key specified by the caller.
#
sub rmkey
{
	my $keyname = shift;			# Keyrec's name.
	my $keyrec;				# Key's keyrec.
	my $fname;				# Name of key to be deleted.

	#
	# Get the key's keyrec and save its pathname.
	#
	$keyrec = $keys{$keyname};
	$fname	= $keyrec->{'keypath'};
	return if($fname eq "");

	#
	# Delete the public half of the key.
	#
	print "\tunlinking $fname\n" if($verbose);
	unlink($fname);

	#
	# Delete the private half of the key.
	#
	$fname =~ s/key$/private/;
	print "\tunlinking $fname\n" if($verbose);
	unlink($fname);
}

#-----------------------------------------------------------------------------
# Routine:	qprint()
#
# Purpose:	Print the given output iff -quiet wasn't specified.
#
sub qprint
{
	my $line = shift;

	print $line if(!$quiet);
}

#-----------------------------------------------------------------------------
# Routine:	vprint()
#
# Purpose:	Print the given output iff -verbose was specified.
#
sub vprint
{
	my $line = shift;

	print $line if($verbose);
}

#----------------------------------------------------------------------
# Routine:	version()
#
# Purpose:	Print the version number(s) and exit.
#
sub version
{
	print STDERR "$VERS\n";
	print STDERR "$DTVERS\n";

	exit(0);
}

#-----------------------------------------------------------------------------
# Routine:	usage()
#
sub usage
{
	print STDERR "usage:  cleankrf [options] <keyrec files>\n";
	print STDERR "\toptions:\n";
	print STDERR "\t\t-count    -  give count of orphan keys\n";
	print STDERR "\t\t-list     -  only list orphaned keys\n";
	print STDERR "\t\t-rm       -  delete orphaned keys\n";
	print STDERR "\t\t-quiet    -  don't give any output\n";
	print STDERR "\t\t-verbose  -  give much output\n";
	print STDERR "\t\t-Version  -  show the version number\n";
	print STDERR "\t\t-help     -  give a usage message and exit\n";

	exit(0);
}

1;

##############################################################################
#

=pod

=head1 NAME

cleankrf - Clean a DNSSEC-Tools I<keyrec> files of old data

=head1 SYNOPSIS

  cleankrf [options] <keyrec-files>

=head1 DESCRIPTION

B<cleankrf> cleans old data out of a set of DNSSEC-Tools I<keyrec> files.
The old data are obsolete signing sets, orphaned keys, and obsolete keys.

Obsolete signing sets are set I<keyrec>s unreferenced by a zone I<keyrec>.
Revoked signing sets are considered obsolete by B<cleankrf>.

Orphaned keys are KSK and ZSK key I<keyrec>s unreferenced by a set I<keyrec>.

Obsolete keys are key I<keyrec>s with a I<keyrec_type> of B<kskobs> or
B<zskobs>.

B<cleankrf>'s exit code is the count of orphaned and obsolete I<keyrec>s
found.

=head1 OPTIONS

=over 4

=item B<-count>

Display a final count of old I<keyrec>s found in the I<keyrec> files.  This
option allows the count to be displayed even if the B<-quiet> option is given.

=item B<-list>

The key I<keyrec>s are checked for old I<keyrec>s, but they are not removed
from the I<keyrec> file.  The names of the old I<keyrec>s are displayed.

=item B<-rm>

Delete the key files, both B<.key> and B<.private>, from orphaned and
expired I<keyrec>s.

=item B<-quiet>

Display no output.

=item B<-verbose>

Display output about referenced keys and unreferenced keys.

=item B<-Version>

Displays the version information for B<cleankrf> and the DNSSEC-Tools package.

=item B<-help>

Display a usage message.

=back

=head1 COPYRIGHT

Copyright 2004-2012 SPARTA, Inc.  All rights reserved.
See the COPYING file included with the DNSSEC-Tools package for details.

=head1 AUTHOR

Wayne Morrison, tewok@tislabs.com

=head1 SEE ALSO

B<fixkrf(8)>,
B<lskrf(8)>,
B<zonesigner(8)>

B<Net::DNS::SEC::Tools::keyrec.pm(3)>

B<file-keyrec.pm(5)>

=cut