# $Id: Key.pm,v 1.33 2005/06/27 14:39:50 olaf Exp $
#
#
#

=head1 NAME

Net::DNS::SEC::Maint::Key - Class used for implementing a 
DNSSEC Key Database

=head1 DESCRIPTION

This class implements an interface to a database of private keys used
during DNSSEC administration. The class implements the Key object.

A Key object has two 'incarnations' when an instance is first created
it is a generic object that knows all about the database in which the
keys are stored;

Once the 'fetch' method (see below) is called the attributes that are
specific to one key in the database are loaded and can be accessed with 
number of methods documented below.

=cut

#'

package Net::DNS::SEC::Maint::Key;
use Net::DNS::SEC;
use Net::DNS::SEC::Maint::Key::Config;
use File::Copy;
use File::Basename;
use File::Path;
use Data::Dumper;
use IO::LockedFile;
use Log::Log4perl qw(get_logger :levels);


my $default_log4perl_conf=q(
#    log4perl.rootLogger=DEBUG,Screen
#    log4perl.category.MAINT.KEY         = INFO, Logfile, Screen

    log4perl.appender.Logfile          = Log::Log4perl::Appender::File
    log4perl.appender.Logfile.filename = test.log
    log4perl.appender.Logfile.layout   = Log::Log4perl::Layout::PatternLayout
    log4perl.appender.Logfile.layout.ConversionPattern = [%r] %F %L %m%n

    log4perl.appender.Screen         = Log::Log4perl::Appender::Screen
    log4perl.appender.Screen.stderr  = 0
    log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout
  );




use Carp;

use strict;

use vars qw(
  $VERSION
  @EXPORT
  @EXPORT_OK
  @ISA
  $AUTOLOAD
  @algorithms
  %algorithms_by_name
);

require Exporter;
@ISA = qw(Exporter);

@EXPORT_OK = qw (oldest_key);

$VERSION = do { my @r = ( q$Revision: 1.33 $ =~ /\d+/g ); sprintf  "%d." . "%03d" x $#r, @r; };


# Use 3 digits strings, perl will do the context magic.
%algorithms_by_name = (
    "RSA"     => "001",
    "RSAMD5"  => "001",
    "DSA"     => "003",
    "RSASHA1" => "005",

);




my @algorithms = keys %algorithms_by_name;

# Files in the database may have the following extensions

my @admin_extensions = (
    "adm",        # Stores administrative information
    "private",    # Public key as generated by bind.
    "key",        # Private key as generated by bind.
    "attr",        # file in which attributes are stored.
);

=head1  Generic database methods.

=head2 new ($responsible_person, $session_id)

    my $keydb=Net::DNS::SEC::Maint::Key->new;

Initializes a key object that can be used to create access, modify
and delete DNSSEC keypairs. The arguments are used for logging purposes.

=cut

sub new {
    my $caller      = shift;
    my $resp_person = shift;
    my $session_id  = shift;
    my $class = ref($caller) || $caller;



#
# Need some wrapper to get to the "standard"
#
    if (-f "/usr/local/etc/log4perl.conf"){
	Log::Log4perl::init_once("/usr/local/etc/log4perl.conf");
      }elsif(-f "/etc/log4perl.conf" ){
	  Log::Log4perl::init_once("/etc/log4perl.conf");
	}else{
	    Log::Log4perl::init_once(\$default_log4perl_conf);
	  }



    my $logger=get_logger($class);
    $logger->debug("new instance");
    # A config object is embeded in the key object.  If you know of a
    # more elegant way to keep the Config code independend from the
    # Key class ... let me know.
    my $config = Net::DNS::SEC::Maint::Key::Config->new();
    $config->set_default_conf;    #sets the defaults See Key::Config
    $config->read_config_file;
    my $self = {
        "_Config"         => $config,
        "_Keypath"        => "",
        "_algorithm"      => "",
        "_domain"         => "",
        "_keyid"          => "",
        "_key_attributes" => { "attribute_state" => "empty" },
    };
    bless $self, $class;
    $self->set_SessionID($session_id);
    $self->set_RespPerson($resp_person);
    return $self;
}


=head2 get_keyset


   $keyset=$keydb->get_keyset($domain);
   $keyset=$keydb->get_keyset($domain,$ttl);


Unless specified by the second argument the TTL on the keys in the
keyset is set to 3600,

The method returns a string with a string representation of the key
RRs that are used for signing i.e. the keys that are set as ACTIVE.

=cut

sub get_keyset {
    my $self   = shift;
    my $domain = shift;
    my $ttl    = shift;
    $ttl = 3600 unless $ttl;

    # sort will garrantee allway same order
    my $key;
    my @keys       = $self->get_active($domain);
    my @keys2      = $self->get_published($domain);
    my $keyset_out = "";

    foreach $key ( @keys, @keys2 ) {
        $keyset_out .= $key->keyrrstring($ttl) . "\n";
    }
    return $keyset_out;
}

=head2 get_all   Get all keys.


   @keyobjects=$keydb->get_all();
   @keyobjects=$keydb->get_all($domainlist);

Returns an array of 'fetched' keyobjects.

=cut

sub get_all {
    my $self       = shift;
    my $domainlist = shift;
    my @keys=();
    my $logger=get_logger();
    my $output = "";
    my @domain;
    if ( !$domainlist ) {
        @domain = $self->get_available_domains(1);
    }
    else {
        my @alldomains = $self->get_available_domains(1);
        my @mydomains = ( split /\s+/, $domainlist );

        foreach my $name (@mydomains) {
            $name = lc($name);

            # Compile wildcard matcher...
            if ( $name =~ /(\*)/ ) {
                foreach my $entry (@alldomains) {
                    push @domain, $entry if $entry =~ /^$name/;
                }
            }
            else {
                push @domain, $name;
            }
        }
    }
    my $domain;
    foreach $domain (@domain) {
        my $i             = 0;
        my @algo_id_pairs = $self->get_algo_id_pairs($domain);
        while ( $i < @algo_id_pairs ) {
            $algo_id_pairs[$i] =~ /(\d+)\+(\d+)/;
            my $a = $1;
            my $k = $2;

            my $keyobj =
              Net::DNS::SEC::Maint::Key->new( $self->get_RespPerson,
                $self->get_SessionID );


            if ( $keyobj->fetch( $domain, $a, $k ) ) {
                croak
"Inconsistency between fetch and get_available_domains/get_algo_id_pairs";
            }
            push @keys, $keyobj;
            $i++;
        }
    }

    $logger->debug("No keys found");

    return @keys;
}

=head2 get_active

    @keys=$keydb->get_active($domain,$algorithm);
    @keys=$keydb->get_active_zone ($domain,$algorithm);
    @keys=$keydb->get_active_key ($domain,$algorithm);


Returns an array of key objects with the set of all active keys, the
active zone signing keys or the active keysigning keys for the
specified domain respectively.

The return value is an array containing strings specifiying the paths to the
private keys of the active keys.

The 'algorithm' must be the algorithm in string representation.

An optional 3rd argument (boolean) determines if the not-active keys
are returned as well.





=head2 get_inactive

    @keys=$keydb->get_inactive($domain,$algorithm);
    @keys=$keydb->get_inactive_zone ($domain,$algorithm);
    @keys=$keydb->get_inactive_key ($domain,$algorithm);

Same as get_active but then for in_active keys.

=head2 get_published

    @keys=$keydb->get_published($domain,$algorithm);
    @keys=$keydb->get_published ($domain,$algorithm);
    @keys=$keydb->get_published ($domain,$algorithm);

Same as get_active but then for published keys.


=cut

sub get_active_zone {
    my $self      = shift;
    my $domain    = shift;
    my $algorithm = uc shift;
    my $logger=get_logger();
    $logger->debug("Arguments domain: $domain algorithm: $algorithm");
    my @zone_sig_keys;
    my @keys = $self->get_active( $domain, $algorithm );
    foreach my $k (@keys) {
        push @zone_sig_keys, $k if $k->is_zsk;
    }

    return @zone_sig_keys;
}

sub get_active_key {
    my $self      = shift;
    my $domain    = shift;
    my $algorithm = uc shift;
    my $logger=get_logger();
    $logger->debug("Arguments domain: $domain algorithm: $algorithm");
    my @key_sig_keys;
    my @keys = $self->get_active( $domain, $algorithm );

    foreach my $k (@keys) {
        push @key_sig_keys, $k if $k->is_ksk;
    }
    return @key_sig_keys;
}

sub get_active {
    my $self           = shift;
    my $domain         = shift;
    my $algorithm      = uc shift;
    my $logger=get_logger();
    my $algid;
    $logger->debug("Arguments domain: $domain algorithm: $algorithm");

    #convert algorithm from text presentation to numeric if needed
    if ( $algorithm =~ /^\s*\d+\s*$/ ) {
        $algid = $algorithm;    #numeric
    }
    else {
        $algid = alg_name2num($algorithm);
    }
    chop $domain if $domain =~ /\.$/;    # No trailing dot in the directory
                                         # structure.
    my @keys=();
    my $keyobj;
    my $i = 0;

    foreach $keyobj ( $self->get_all($domain) ) {
        if ($algorithm) {    # if an algorithm was specified then only add if
            if ( $algid == $keyobj->get_algorithm )
            {                # the algid equals the algorithm as in the key
                $keys[ $i++ ] = $keyobj
                  if ( $keyobj->is_active );

            }
        }
        else {               # algorithm was not passed as argument.. just add.
            $keys[ $i++ ] = $keyobj
              if ( $keyobj->is_active );
        }
    }
    closedir DOMAINDIR;

    return (@keys);
}





sub get_inactive_zone {
    my $self      = shift;
    my $domain    = shift;
    my $algorithm = uc shift;
    my @zone_sig_keys;
    my @keys = $self->get_inactive( $domain, $algorithm );
    foreach my $k (@keys) {
        push @zone_sig_keys, $k if $k->is_zsk;
    }

    return @zone_sig_keys;
}

sub get_inactive_key {
    my $self      = shift;
    my $domain    = shift;
    my $algorithm = uc shift;
    my @key_sig_keys;
    my @keys = $self->get_inactive( $domain, $algorithm );

    foreach my $k (@keys) {
        push @key_sig_keys, $k if $k->is_ksk;
    }
    return @key_sig_keys;
}

sub get_inactive {
    my $self           = shift;
    my $domain         = shift;
    my $algorithm      = uc shift;
    my $algid;

    #convert algorithm from text presentation to numeric if needed
    if ( $algorithm =~ /^\s*\d+\s*$/ ) {
        $algid = $algorithm;    #numeric
    }
    else {
        $algid = alg_name2num($algorithm);
    }
    chop $domain if $domain =~ /\.$/;    # No trailing dot in the directory
                                         # structure.
    my @keys=();
    my $keyobj;
    my $i = 0;

    foreach $keyobj ( $self->get_all($domain) ) {
        if ($algorithm) {    # if an algorithm was specified then only add if
            if ( $algid == $keyobj->get_algorithm )
            {                # the algid equals the algorithm as in the key
                $keys[ $i++ ] = $keyobj
                  if ( $keyobj->is_inactive  );

            }
        }
        else {               # algorithm was not passed as argument.. just add.
            $keys[ $i++ ] = $keyobj
              if ( $keyobj->is_inactive );
        }
    }
    closedir DOMAINDIR;

    return (@keys);
}




sub get_published {
    my $self      = shift;
    my $domain    = shift;
    my $algorithm = uc shift;

    my $algid;

    #convert algorithm from text presentation to numeric if needed
    if ( $algorithm =~ /^\s*\d+\s*$/ ) {
        $algid = $algorithm;    #numeric
    }
    else {
        $algid = alg_name2num($algorithm);
    }

    chop $domain if $domain =~ /\.$/;    # No trailing dot in the directory
                                         # structure.
    my @keys;
    my $keyobj;
    my $i = 0;
    foreach $keyobj ( $self->get_all($domain) ) {
        if ($algorithm) {    # if an algorithm was specified then only add if
            if ( $algid == $keyobj->get_algorithm )
            {                # the algid equals the algorithm as in the key
                $keys[ $i++ ] = $keyobj if ( $keyobj->is_published );

            }
        }
        else {               # algorithm was not passed as argument.. just add.
            $keys[ $i++ ] = $keyobj if ( $keyobj->is_published );
        }
    }
    closedir DOMAINDIR;

    return (@keys);
}

sub get_published_zone {
    my $self          = shift;
    my $domain        = shift;
    my $algorithm     = uc shift;
    my @zone_sig_keys = ();
    my @keys          = $self->get_published( $domain, $algorithm );

    foreach my $k (@keys) {
        push @zone_sig_keys, $k if $k->is_zsk;
    }

    return @zone_sig_keys;
}

sub get_published_key {
    my $self         = shift;
    my $domain       = shift;
    my $algorithm    = uc shift;
    my @key_sig_keys = ();
    my @keys         = $self->get_published( $domain, $algorithm );

    foreach my $k (@keys) {

        push @key_sig_keys, $k if $k->is_ksk;
    }

    return @key_sig_keys;
}


=head2 purge


  $keydb->purge;

Delete private keys are actually not deleted but stored elsewhere in
the database, inaccesible to the user. The purge command will remove
these "backup" keys as well as all the data about keys that used to
exist (possibly shorten the list of domains that is returned with the
get_available_domain method)

As this is a somewhat radical method advice not to use this command as
it will prohibit manual rollback in case the database gets corrupted.

=cut

sub purge {
    my $self=shift;
    my @domains=$self->get_available_domains;
    my $dnskeydirbase = $self->getconf("dns_key_db");
    
    foreach my $domain (@domains){
	# UNTAINT the path....
	"$dnskeydirbase/$domain"=~ m!(.*/.*)!;
	my $path=$1;

	if ( -d "$path/Expired_keys" ){
	    rmtree("$path/Expired_keys");
	    
	}

	rmtree($path) unless $self->get_all($domain);
    }
}


=head1 Rollover Commands


The system implements rudmentary rollover methods. Only the more
simple rollover methods as discribed in [Document with distribution]
is implemented.

The automatic rollover commands may fail to work if you have tried to
mannually add or remove keys. For more details see the rollover_zone and 
rollover_key methods.


=head2 set_rollover, unset_rollover, is_rollover


These methods set, unset and determine the state of the rollover
attribute. These methods should not be used directly, they may lead to
database inconsistencies. Use rollover_zone and rollover_key methods
instead. Be careful if you use these methods anyway (use in
combination with the checkconsistency method)

=cut

sub unset_rollover {
    my $self = shift;
    my $output;
    $self->_read_attributes;
    $output =
      "  + Key with keyID " . $self->get_keyid . " rollover attribute unset\n";
    $self->{"_key_attributes"}->{"rollover"} = 0;

    $self->_write_attributes;

#    print $output;
    $self->add_log_message($output);
    return 1 if !$self->is_rollover;
    die "unset_rollover failed. Your database may be inconsistent";
}

sub set_rollover {
    my $self = shift;
    my $output;

    $self->_read_attributes;
    $output =
      "  + Key with keyID " . $self->get_keyid . " rollover attribute set\n";
    $self->{"_key_attributes"}->{"rollover"} = 1;

    $self->_write_attributes;

#    print $output;
    $self->add_log_message($output);
    return 1 if $self->is_rollover;
    die "set_rollover failed. Your database may be inconsistent";
}

sub is_rollover {
    my $self = shift;
    $self->_read_attributes;
    return 1 if $self->{"_key_attributes"}->{"rollover"};
    return 0;
}



=head2 get_rollover, get_rollover_key, get_rollover_zone


    @keys=$key->get_rollover($domain,$algorithm);

    @keys=$key->get_rollover_key($domain,$algorithm);
    @keys=$key->get_rollover_zone($domain,$algorithm);



Returns an array of key objects with the set of all keys for the
specified domain that have the rollover attribute set.

The return value is an array containing strings specifiying the paths
to the private keys of the active keys.

If the 2nd optional paramater is specified then only the keys that
have the rollover attribute set for the specified domain AND algorithm
are returned.

=cut


sub get_rollover {
    my $self      = shift;
    my $domain    = shift;
    my $algorithm = uc shift;
    my $algid;

    #convert algorithm from text presentation to numeric if needed
    if ( $algorithm =~ /^\s*\d+\s*$/ ) {
        $algid = $algorithm;    #numeric
    }
    else {
        $algid = alg_name2num($algorithm);
    }
    chop $domain if $domain =~ /\.$/;    # No trailing dot in the directory
                                         # structure.
    my @keys;
    my $keyobj;
    my $i = 0;

    foreach $keyobj ( $self->get_all($domain) ) {
        if ($algorithm) {    # if an algorithm was specified then only add if
            if ( $algid == $keyobj->get_algorithm )
            {                # the algid equals the algorithm as in the key
                $keys[ $i++ ] = $keyobj if ( $keyobj->is_rollover );

            }
        }
        else {               # algorithm was not passed as argument.. just add.
            $keys[ $i++ ] = $keyobj if ( $keyobj->is_rollover );
        }
    }
    closedir DOMAINDIR;

    return (@keys);
}





sub get_rollover_key {
    my $self         = shift;
    my $domain       = shift;
    my $algorithm    = uc shift;
    my @key_sig_keys = ();
    my @keys         = $self->get_rollover( $domain, $algorithm );

    foreach my $k (@keys) {

        push @key_sig_keys, $k if $k->is_ksk;
    }

    return @key_sig_keys;
}




sub get_rollover_zone {
    my $self         = shift;
    my $domain       = shift;
    my $algorithm    = uc shift;
    my @zone_sig_keys = ();
    my @keys         = $self->get_rollover( $domain, $algorithm );

    foreach my $k (@keys) {

        push @zone_sig_keys, $k if $k->is_zsk;
    }

    return @zone_sig_keys;
}




=head2 rollover_zone

    $key->rollover_zone($domain,"RSASHA1")

The rollover_zone command takes care of rolling a zone signing key. This
method implies that a very specific key maintenance scheme is used; At
any given time not more than two zone-signing keys (per algorithm) are
published in the keyset.

The first argument specifies for which domain the rollover is to take
place, the second specifies for which algorithm (by name) there is a zone
signing key rollover. If there are only keys from one algorithm then
this argument is optional.

The method returns 0 on success or a string with an error condition.

The rollover precondition is that one of the keys (key 1) is active
and another key (key 2) is published (see set_published method). When
the rollover_zone method first is issued key 1 is set to published and
marked as "rollover" (see is_rollover method), the key 2 is then set
to active.

When the rollover_zone method is called a second time the system first
determines if a zone signing key rollover is in progress. If so key 1,
the key that has the rollover attribute set, will be deleted from the
system and a new key, key 3, will be created so that it can be used in
the future.

Users of the rollover method should be carefull issueing the rollover
commands to fast. The data signed with the different keys and the different
keysets, as published in the DNS, will need time to propagate. One should 
not underestimate the time needed for DNS data to propagate.


=cut

sub rollover_zone {
    my $self    = shift;
    my $domain  = shift;
    my $algname = uc shift;    #upercase and remve shifts
    my $logger=get_logger();
    my $alg_id;

    $algname =~ s/ //g;        #remove shifts

    #
    # Check if the domain exists in the key database.
    $domain =~ s/\.$//;
    my %domains;
    my $name;
    my @domains = $self->get_available_domains(1);
    foreach $name (@domains) {
        $domains{$name} = 1;
    }
    if ( !$domains{$domain} ) {
        return "No such domain: $domain";
    }

    # Check if there are more than one algorithms in
    # use and how many keys are available for each of them.
    my %algidpairs;
    my @algidpairs = $self->get_algo_id_pairs($domain);
    foreach my $algidpair (@algidpairs) {
        $algidpair =~ /^(\d+)\+(\d+)$/;
        $algidpairs{$1}++;
        $alg_id = $1;
    }
    return "No keys for this domain" if !keys(%algidpairs);

    if ( keys(%algidpairs) > 1 ) {
      # only now the algname is relevant.
      if ($algname !~ /^\d+$/){
        $alg_id = alg_name2num($algname);
      }else{
	$alg_id=$algname;
      }
      return "$algname is not a valid algorithm" unless $alg_id;
    }
    else {

        # number of algorithms is 1
        # therefore $alg_id contains the proper $algid
        if ( defined $algname ) {
	  if ($algname =~ /^\d+$/){
            return "Algorithm $algname is provided as argument "
              . "but there are no keys of this algorithm"
              if $algname != $alg_id;
	  }else{
            return "Algorithm $algname is provided as argument "
              . "but there are no keys of this algorithm"
              if $algorithms_by_name{$algname} != $alg_id;
	  }
        }
    }

  # $alg_id is now set to the algorithm on which we have to perform the rollover

# We now have to establish that there are actually two keys, one active and one pending.
    my @active_keys    = $self->get_active_zone( $domain,    $alg_id );

    my @published_keys = $self->get_published_zone( $domain, $alg_id );


    return
"automatic rollover of zone signing keys is only possible if there is one active zone signing key"
      if @active_keys != 1;
    return
"automatic rollover of zone signing keys is only possible if there is one published zone signing key"
      if @published_keys != 1;

# If the published key has it's rollover attribute set we are performing a rollover.
# and thus are in the second phase of the rollover.

    if ( $published_keys[0]->is_rollover ) {

        # SECOND phase of the rollover.
	$logger->debug("SECOND PHASE\n");
        my $size = 0;

        $size = $self->getconf("RSAKEYSIZEZONE")
          if ( $alg_id == 1 || $alg_id == 5 );
        $size = $self->getconf("DSAKEYSIZEZONE") if ( $alg_id == 3 );
        $size = 2048 unless $size;    #just to be safe

        my $newkey=$self->create( $domain, $alg_id, $size, "zonesigning" );
	$newkey->set_published;

        $published_keys[0]->deletekey;
    }
    else {
        $logger->debug("FIRST PHASE\n");
        $published_keys[0]->set_active;
        $active_keys[0]->set_published;
        $active_keys[0]->set_rollover;
    }
    return 0;
}

=head2 rollover_key

    $key->rollover_key($domain,"RSASHA1")

The rollover_key command takes care of rolling a key signing key. This
method implies that a very specific key maintenance scheme is used; At
any given time not more than two zone-signing keys (per algorithm) are
published in the keyset.

The first argument specifies for which domain the rollover is to take
place, the second specifies for which algorithm (by name) there is a zone
signing key rollover. If there are only keys from one algorithm then
this argument is optional.

The method returns 0 on success or a string with an error condition.

The rollover precondition is that there is one that there are one ore
more active key signing key. When the rollover_zone method first is
issued the oldest key is marked as "rollover" (see is_rollover
method), a new key is created and both keys and set to active. The key
second key should be exchanged with the parent.

When the rollover_key method is called a second time the system first
determines if a key signing key rollover is in progress. If so the key
marked as "rollover" will be deleted from the system.

Users of the rollover method should be carefull issueing the rollover
commands to fast. The data signed with the different keys and the
different keysets, as published in the DNS, will need time to
propagate. One should not underestimate the time needed for DNS data
to propagate.


=cut

sub rollover_key {
    my $self    = shift;
    my $domain  = shift;
    my $algname = uc shift;    #upercase and remve shifts
    my $logger=get_logger();
    my $alg_id;

    $algname =~ s/ //g;        #remove shifts

    #
    # Check if the domain exists in the key database.
    $domain =~ s/\.$//;
    my %domains;
    my $name;
    my @domains = $self->get_available_domains(1);
    foreach $name (@domains) {
        $domains{$name} = 1;
    }
    if ( !$domains{$domain} ) {
        return "No such domain: $domain";
    }

    # Check if there are more than one algorithms in
    # use and how many keys are available for each of them.
    my %algidpairs;
    my @algidpairs = $self->get_algo_id_pairs($domain);
    foreach my $algidpair (@algidpairs) {
        $algidpair =~ /^(\d+)\+(\d+)$/;
        $algidpairs{$1}++;
        $alg_id = $1;
    }
    return "No keys for this domain" if !keys(%algidpairs);
    if ( keys(%algidpairs) > 1 ) {
      # only now the algname is relevant.
      if ($algname !~ /^\d+$/){
        $alg_id = alg_name2num($algname);
      }else{
	$alg_id=$algname;
      }
      return "$algname is not a valid algorithm" unless $alg_id;
    }
    else {

      # number of algorithms is 1
      # therefore $alg_id contains the proper algorithm id.

      if ( defined $algname ) {
	if ($algname =~ /^\d+$/){
	  return "Algorithm $algname is provided as argument "
	    . "but there are no keys of this algorithm"
	      if $algname != $alg_id;
	}else{
	  return "Algorithm $algname is provided as argument "
	    . "but there are no keys of this algorithm"
	      if $algorithms_by_name{$algname} != $alg_id;
	}
	
      }
    }
  # $alg_id is now set to the algorithm on which we have to perform the rollover

# We now have to establish that there are actually two keys, one
# active and one pending.

    my @active_keys    = $self->get_active_key( $domain,    $alg_id );
    my @published_keys = $self->get_published_key( $domain, $alg_id );


    $logger->debug("active keys ".@active_keys."\tpublished keys ".@published_keys."\n");

    return
"automatic rollover of key signing keys is only possible if there is one or more active key(s)"
      if ( @active_keys < 1 );

    return
"automating rollover of key signing key is only possible if there are no  published keys"
      if @published_keys != 0;

# If the published key has it's rollover attribute set we are performing a rollover.
# and thus are in the second phase of the rollover.
    my @keysinrollover=();
    foreach my $ak (@active_keys){
	push @keysinrollover, $ak if $ak->is_rollover;

    }
    $logger->debug("Number of keys in rollover: @keysinrollover");


    if ( @keysinrollover == 0 ) {
	$logger->debug("FIRST PHASE");
        my $size = 0;
        $size = $self->getconf("RSAKEYSIZEKEY")
          if ( $alg_id == 1 || $alg_id == 5 );
        $size = $self->getconf("DSAKEYSIZEKEY") if ( $alg_id == 3 );
        $size = 2048 unless $size;    #just to be safe
        my $key = $self->create( $domain, $alg_id, $size, "keysigning" );
        $key->set_active;
	
        my $oldest=oldest_key(@active_keys);
	die "Could not get oldest key, contact developer" if (ref($oldest)ne"Net::DNS::SEC::Maint::Key");
	$oldest->set_rollover;
    }
    elsif ( @keysinrollover == 1)
    {
	
	$logger->debug("SECOND PHASE");

        $keysinrollover[0]->deletekey;
    }else{

	$logger->warn("More than ond key marked as being in rollover (@keysinrollover) this indicates a database inconsistency, correct this mannually");
	return "More than ond key marked as being in rollover (@keysinrollover) this indicates a database inconsistency, correct this mannually";


    }

    return 0;
}

=head2 get_rollover

  @rolloverkeys=$key->get_rollover($domain);

Returns an array of 'fetched' keys for wich the rollover attribute is
set.

=cut

sub rollover_in_progress {
    my $self       = shift;
    my $domain     = shift;
    my @keyobjects = $self->get_all($domain);
    my @outarry    = ();
    foreach my $k (@keyobjects) {
        push @outarry, $k if ( $k->is_rollover && !$k->is_inactive );
    }
    return @outarry

}

=head2 get_available_domains

Returns array with domains for which there are, or have been, keys in
the database.

If a non-zero argument is provided then only the domains for which
there currently are private keys are returned.

=cut

sub get_available_domains {
    my $self = shift;
    my $only_non_empty=shift;
    $only_non_empty=0 unless defined ($only_non_empty);
    my $direntry;
    my @domains;


    my $dnskeydirbase = $self->getconf("DNS_Key_DB");
    if ( !opendir( DIRHANDLE, $dnskeydirbase ) ) {
        die "Important directory does not exist\n"
          . "This may happen if keys have never been created on this system\n"
          . "Contact your system administrator.\n"
          . "DNS_Key_DB in Net::DNS::SEC::Maint::Config is set to $dnskeydirbase\n";

    }

  DIR:    foreach $direntry ( readdir(DIRHANDLE) ) {
      next DIR if ( $direntry eq "." || $direntry eq ".." );	    
      if ( !opendir( KEYDIRHANDLE, "$dnskeydirbase/$direntry" ) ) {
	  die "Could not open $dnskeydirbase/$direntry\n";
      }

      my $dircontainsprivkey=0;
    KEYS:  foreach my $keyentry ( readdir(KEYDIRHANDLE) ) {
	next KEYS if ( $keyentry eq "." || $keyentry eq ".." );	    
	$dircontainsprivkey=1 if $keyentry=~/^K.*\.private$/;
	last KEYS if $dircontainsprivkey;
    }
      close KEYDIRHANDLE;
      next DIR if (! $dircontainsprivkey && $only_non_empty);
      push @domains, $direntry;
    }
    close DIRHANDLE;
    return sort @domains;
}

=head2 get_algo_id_pairs

  $key->get_algo_id_pairs($domain);

Returns array with algo_idpairs in "algo+keyid" notation. Returns
empty array on error.

=cut

sub get_algo_id_pairs {
    my $self   = shift;
    my $domain = shift;
    my $logger=get_logger();
    $domain =~ s/\.$//;    #remove trailing dot
    my $keyfile;
    my $name;
    my %domains;

    my @domains = $self->get_available_domains(1);
    foreach $name (@domains) {
        $domains{$name} = 1;
    }
    return unless $domains{$domain};
    my @algo_id_pair;

    my $dnskeydirbase = $self->getconf("dns_key_db");
    if ( !opendir( DIRHANDLE, $dnskeydirbase ) ) {
        die "Important directory does not exist\n"
          . "This may happen if keys have never been created on this system\n"
          . "Contact your system administrator.\n"
          . "DNS_Key_DB in Net::DNS::SEC::Maint::Config is set to $dnskeydirbase\n";
    }
    if ( !opendir( DOMAINDIR, "$dnskeydirbase/$domain" ) ) {
	$logger->info( "No such domain: $domain");
        return;
    }
    foreach $keyfile ( sort readdir(DOMAINDIR) ) {
        no utf8;
	my $matchdomain=domain2ascii($domain);
        next if -d $dnskeydirbase . "/" . $domain . "/" . $keyfile;
        next if $keyfile !~ /K(\Q$matchdomain\E\.\+(\d*)\+(\d*)).key$/;
        push @algo_id_pair, $2 . "+" . $3;

    }
    return sort @algo_id_pair;

}

=head2 get_available_keyids

  @keyids=$self->get_available_keyid("RSASHA1",$domains);

Returns an array of keyIDs for the specified algorithm from specfied domains.

=cut

sub get_available_keyids {
    my $self=shift;
    my $algorithm=shift;
    my $domain=shift;
    my $algid;

    #convert algorithm from text presentation to numeric if needed
    if ( $algorithm =~ /^\s*\d+\s*$/ ) {
        $algid = $algorithm;    #numeric
    }
    else {
        $algid = alg_name2num($algorithm);
    }
 
    my @keyids;
    my @algidpairs=$self->get_algo_id_pairs($domain);
    print join " ",@algidpairs;

    foreach my $algidpair (@algidpairs){
	if ($algidpair=~/^(\d+)\+(\d+)$/){
	    push @keyids, $2 if $algid==$1 ;
	}
    }	
    return @keyids;
    
}
=head1 Methods to operate on specific keys



=head2 create

   $key->create($domainname,$algorithm,$keysize,
                $functionality,$setactive)

Adds a new key to the database. Returns the new key. The functinality
is either ZSK or KSK, setactive is a boolean, if true the key is set
to active no matter what.

=cut

sub create {
    my $self = shift;
    my ( $domainname, $algorithm, $keysize, $functionality, $setactive ) = @_;
    my $logger=get_logger();

    $domainname =
      lc $domainname;    # Otherewise the keygen tool will do that for us.
    $domainname =~ s/\.$//;    # strip trailing dot...

    $algorithm =~ s/\s//g;

    # Be a little less anal about the argument supplied
    # make it case insensitive and allow for aliases
    $functionality="zonesigning" if $functionality =~/zsk|zonesigning|zone/i;
    $functionality="keysigning" if $functionality =~/ksk|keysigning|key/i;

    die "Sorry invalid functionalit argument in create method " unless 
      $functionality =~ /zonesigning|keysigning/;

    # Algorithm is either a number of specified by name.
    if ( $algorithm =~ /^\d+$/ ) {

        # numeric representation of the algorithm
        my $algname;
        my $found = 0;
        foreach $algname ( keys %algorithms_by_name ) {
            if ( $algorithms_by_name{$algname} == $algorithm ) {
                $algorithm = $algname;
                $found     = 1;
                last;
            }
        }
        return "Algorithm $algorithm is not known" unless $found;
    }
    else {

        # String representation of the algorithm
        return "Algorith "
          . $algorithm
          . " not one of "
          . join ( " ", @algorithms ) . "\n"
          if !$algorithms_by_name{ uc($algorithm) };
    }

$logger->debug("arguments: "
      . $domainname . " "
      . $algorithm . " "
      . $keysize);

    my $dnssec_keygencommand = $self->getconf("dnssec_keygen");
    $dnssec_keygencommand =~ s/^(\S*)\s*.*/$1/;    #strip flags
    die $dnssec_keygencommand
      . " is not executable\n "
      . "We will not be able to create keys\n "
      . "make sure that the proper value for dnssec_keygen is specified in\n "
      . $self->getconf("conffile")
      . "\n or set the environment variable DNSSECMAINT_DNSSEC_KEYGEN \n"
      if !-x $dnssec_keygencommand;

    my $cmnd = $self->getconf("dnssec_keygen")

      # placeholder for the KSK keyflag
     	. ($functionality eq "keysigning"?" -f KSK ":" ")
      . " -a " . $algorithm . " -b " . $keysize . " -n ZONE " . $domainname;
    $logger->debug("  + Generating key, may take a while") if $keysize > 1024;
    umask 007;

    # Key name is printed to STD out.

    $logger->debug("Will execute:". $cmnd );
    my $pid          = open( PH, $cmnd . " 2>&1 |" );
    my $keyname      = "";
    my $keyid        = "unset";
    my $keyalg       = "000";
    my $errormessage = "";

    my $matchdomainname=domain2ascii($domainname);

    while (<PH>) {
        $errormessage .= $_;
        if (/(K\Q$matchdomainname\E(\.)?\+(\d+)\+(\d+))/) {
            $keyname = $1;
            $keyalg  = $3;
            $keyid   = $4;
            last;
        }
    }
    if ( $keyname eq "" ) {
        print " Could not create Key, contact system admin:\n";
        print $errormessage . "\n";
	print "The command that failed was: \n".$cmnd ."\n";
	print "DEBUG info: Match domain : $domainname -> $matchdomainname\n";
        return 2;
    }

    my $pubkey  = $keyname . ".key";
    my $privkey = $keyname . ".private";
    my $keyadm  = $keyname . ".adm";


    # Test if the file actually exists.
    if ( !open( TESTFH, $pubkey ) ) {
        print "WARNING: " . $pubkey . " does not seem to exist.\n";
        print "          contact the system admin.\n";
        return 3;
    }
    else {
        close(TESTFH);
    }
    if ( !open( TESTFH, $privkey ) ) {
        print "WARNING: " . $privkey . " does not seem to exist.\n";
        print "          contact the system admin.\n";
        return 3;
    }
    else {
        close(TESTFH);
    }

    # Created keys are stored DNS_Key_DB/domainname/
    # Copy the key file (maybe accross file systems so use File::Copy

    my $dnskeydirbase = $self->getconf("DNS_Key_DB");
    if ( !opendir( DIRHANDLE, $dnskeydirbase ) ) {
        print "Important directory does not exist\n";
        print "DNS_Key_DB in Net::DNS::SEC::Maint::Config is set to $dnskeydirbase\n";
        if ( !mkdir($dnskeydirbase) ) {
            print $! . "\n";
            print "Could not create $dnskeydirbase\n";
            print "Contact your system admin";
            exit 1;
        }
        print
" This directory has been created but contact your system adminstator\n";
        print " this problem may be a symptom of other problems \n";
    }

    closedir(DIRHANDLE);
    my $dnskeydir = $dnskeydirbase . "/" . $domainname;

    if ( !opendir( DIRHANDLE, $dnskeydir ) ) {
        if ( !mkdir($dnskeydir) ) {
            print $! . "\n";
            print "Could not create $dnskeydir\n";
            print "Contact your system admin\n";
            exit 1;
        }

        my $gid = getgrnam $self->getconf("maintgroup");
        if ( !defined $gid ) {
            print "    "
              . $self->getconf("maintgroup")
              . " is an unknown group\n";
            print
"    Please add the group to /etc/group or change the maintgroup \n";
            print "    paramater in " . $self->getconf("conffile") . "\n";

            exit 1;
        }
        else {
            chown( -1, $gid, $dnskeydir )
              or die "Can't change group of "
              . $dnskeydir . " to "
              . $gid . ": $!";
            my $mode = "6770";
            chmod oct($mode), $dnskeydir
              or die "Can't change file permissions on " . $dnskeydir . ": $!";
        }

    }
    closedir(DIRHANDLE);

    if ( !open( ADM, ">> $dnskeydir/$keyadm" ) ) {
        print "Error could not open $dnskeydir/$keyadm \n";
        print "Contact your system admin\n";
        exit 1;
    }

    if ( !move( $pubkey, $dnskeydir . "/" . $pubkey ) ) {
        print "Error moving $pubkey to $dnskeydir:\n" . $!;
        return 4;
    }
    if ( !move( $privkey, $dnskeydir . "/" . $privkey ) ) {
        print "Error moving $privkey to $dnskeydir:\n" . $!;
        return 4;
    }

    $self->{"_Keypath"} = $dnskeydir . "/" . $privkey;

    # TODO:  we could do some file locking to make sure this is the only
    # programm appublished data.


    print ADM "LOG: added by "
      . $self->get_RespPerson
      . " during session "
      . $self->get_SessionID . "\n";
    print ADM "USAGE: $functionality \n";
    close(ADM);

#    print "  + A "
#      . $algorithm . " "
#      . $functionality
#      . " key for \'"
#      . $domainname
#      . "\' has been created with KeyID: "
#      . $keyid . "\n";

    $self->{"_key_attributes"}                      = {};
    $self->{"_key_attributes"}->{"attribute_state"} = "created";
    $self->{"_key_attributes"}->{"state"}           = "INACTIVE";
    $self->{"_key_attributes"}->{"state_change"} = time ;
    $self->{"_key_attributes"}->{"key_size"}        = $keysize;
    $self->{"_key_attributes"}->{"purpose"}         = $functionality;
    $self->{"_keyid"}     = $keyid;
    $self->{"_algorithm"} = $keyalg;


    $self->_write_attributes;

    $self->{"_domain"}     = $domainname;

# Default action... Set to active if there are no active keys (or the
# key is forced to be set active)


# Default action... Set to passive if the key is a zonesigning and
# there is one active key zsk and no published zsk in the database

    if ( $functionality eq "zonesigning"  ) {
        if ( !$self->get_active_zone($domainname) || $setactive ) {
#            print "  + No active zone signing keys found. Default action:\n"
#              unless $setactive ;
#            print "  + Status is set to active\n";
            $self->set_active;
        }
        if ( ! $self->is_active &&
	     ! $self->get_published_zone($domainname)){
	    $self->set_published;
	}
	  

    }
    else {    # Must be keysigning per definition
        if ( !$self->get_active_key($domainname) || $setactive ) {
#            print "  + No active key signing keys found. Default action:\n"
#              unless $setactive ;
#            print "  + Status is set to active\n";
            $self->set_active ;
        }
    }


    my $keystring = $self->keyrrstring;
    $logger->info($keystring);
    $logger->debug($keystring);
    return ($self);

}


=head2 fetch

  $key->fetch($domain,$algorithm,$keyid);
  $key->fetch($fullpath);

Sets the $key attributes to reflect domain, algorithm (by name or
number) and keyid. Once the key is fetched one can use the deletekey, bla
and foo methods on it.

Alternatively one can specify the full path to the private key. This
may be handy because an array containing those paths is returned by
other methods.

Returns 0 if the key is uniquely identified. Ruturns a string with
error conditition if the key could not be uniquely identified or could
not otherwise be fetched.

=cut

#'

sub fetch {
    my $self = shift;
    my $domain;
    my $algorithm;
    my $keyid;
    my $logger=get_logger();
    my $keypath;
  $logger->debug("Arguments: ".join (" ",@_)."\n");

    my $dnskeydirbase = $self->getconf("dns_key_db");

    # This check has been performed many times...
    if ( !opendir( DIRHANDLE, $dnskeydirbase ) ) {
        die "The fetch function cannot locate $dnskeydirbase"
          . "this is a serious error. Please contact developer"
          . "DNS_Key_DB in Net::DNS::SEC::Maint::Config is set to $dnskeydirbase\n";
    }

    # Either a full path is supplied or the domain, algorthm and key-id are
    # supplied seperatly.
    if ( @_ == 1 ) {

        #Single argument must be a filename
        $keypath = shift;
        if ( -f $keypath ) {
            $self->{"_Keypath"} = $keypath;
            if ( $keypath !~ /^$dnskeydirbase/ ) {

                # Rudimentary test.

                return $keypath
                  . " is not in the database specified in your configuration ("
                  . $dnskeydirbase . ")";
            }
            return (0);
        }
        return "$keypath not found";

    }
    elsif ( @_ == 3 ) {

        # 3 arguments block... runs to almost the end of this method.
        $domain = shift;
        $domain =~ s/\.$//;
        $algorithm = shift;
        my $keyid = shift;


        $algorithm =~ s/\s//g;

        # Algorithm is either a number of specified by name.
        if ( $algorithm =~ /^\d+$/ ) {

            # numeric representation of the algorithm
            my $algname;
            my $found = 0;
            foreach $algname ( keys %algorithms_by_name ) {
                if ( $algorithms_by_name{$algname} == $algorithm ) {
                    $algorithm = $algname;
                    $found     = 1;
                    last;
                }
            }
            return "Algorithm $algorithm is not known" unless $found;
        }
        else {

            # String representation of the algorithm
            return "Algorith "
              . $algorithm
              . " not one of "
              . join ( " ", @algorithms ) . "\n"
              if !$algorithms_by_name{ uc($algorithm) };
        }

        $keypath = sprintf "%s/%s/K%s\.+%03d+%05d.private", $dnskeydirbase,
          $domain, domain2ascii($domain), $algorithms_by_name{ uc($algorithm) }, $keyid;
        if ( -f $keypath ) {
            $self->{"_algorithm"} = $algorithms_by_name{ uc($algorithm) };
            $self->{"_keyid"}     = uc $keyid;
            $self->{"_domain"}    = lc $domain;
            $self->{"_Keypath"}   = $keypath;
            return (0);
        }
        else {

            # Figure out what went wrong.. (I had the code from a less
            # efficient implementation.. so why not use it.:-)
            my %domains;
            my $name;
            my @domains = $self->get_available_domains(1);
            foreach $name (@domains) {
                $domains{$name} = 1;
            }
            return "No such domain: $domain" unless $domains{$domain};
            my @algo_id_pairs = $self->get_algo_id_pairs($domain);
            my $i             = 0;
            my $found         = 0;
            while ( $i < @algo_id_pairs ) {
                $algo_id_pairs[$i] =~ /(\d+)\+(\d+)/;
                my $a = $1;
                my $k = $2;
                if (   $a eq $algorithms_by_name{ uc($algorithm) }
                    && $k eq $keyid )
                {
                    $found                = $algo_id_pairs[$i];
                    $self->{"_algorithm"} = $a;
                    $self->{"_keyid"}     = $k;
                    last;
                }
                $i++;
            }
            return "algorithm-keyid not found for $domain $algorithm $keyid"
              if !$found;
            if ( !opendir( DOMAINDIR, "$dnskeydirbase/$domain" ) ) {
                die
"Strange Error condition in fetch function: no such domain: $domain, contact developer";
            }
            return (" contact developer, we should not end up here");
        }

        #end of the code block that figures out why the setting keypath
        # from domain , algorithm and keyid failed.

    }
    else {

        # Last possible conditional for the argument parsing bit.
        return "Wrong number of arguments";
    }
    return (0);
}



=head2  deletekey


    $key->deletekey;

Delete the "fetched" key.

=cut

sub deletekey {
    my $self = shift;
    my $logger=get_logger();
    my $deletekey = $self->get_keypath;
    $deletekey =~ s/\.private$//;
    my $sourcedir = dirname($deletekey);

    # Do the actual work...
    # Deleting is done by moving the key into the Expired_Keys subdirectory
    my $destdir = $sourcedir . "/Expired_Keys";
    if ( !opendir( DIRHANDLE, $destdir ) ) {
        $logger->debug( "Creating  $destdir\n");
        if ( !mkdir($destdir) ) {
            print $! . "\n";
            print "Could not create $destdir\n";
            print "Contact your system admin";
            exit 1;
        }
    }
    closedir(DIRHANDLE);
    foreach my $extension (@admin_extensions) {
        my $filename = $deletekey . "." . $extension;

        # File:Move function.

        if ( -f $filename ) {
            move( $filename, $destdir . "/" . basename($filename) )
              or die "The deletion is actually a move... The move failed:\n"
              . "Could not move "
              . $sourcedir . "/"
              . $filename . " "
              . $destdir . "/"
              . $filename . "\n";
        }
    }

    # Make sure the key is not accesible anylonger
    $self->{"_Keypath"} = "";

    # Audit trail... Who deleted the key.
    #


    open( ADM, ">>  $destdir/" . basename("$deletekey.adm") )
      or die " Could not open file for administration";
    print ADM "LOG: deleted during session " . $self->get_SessionID . "\n";
    close(ADM);
    return 0;

}



=head2 state

  $state=$key->state;
  die "state change failed" if "ACTIVE" ne $key->state("active");

Read or set the state attribute of a key. A key can be

  ACTIVE      : Used for signing and published in a keyset.
  PUBLISHED   : Published in a keyset but not used for signing.
  INACTIVE    : Not published in a keyset nor used for signing.



On success the method returns the state (in upper case) othewise
the method rerurns an error mesage.

The argument has to be one of the states mentioned above. The input
is case insensitive.

=cut

sub state {
    my $self    = shift;
    my $new_val = shift;
    if ( defined $new_val ) {
        $new_val = uc $new_val;
        $new_val =~ s/\s+//g;
        if ( $new_val !~ /(ACTIVE|INACTIVE|PUBLISHED)/ ) {
            return
              "Error in the state method: $new_val is not an allowed state\n";
        }
        $self->_read_attributes;
        my $output =
          "  + Key with keyID "
          . $self->get_keyid
          . " had its state changed from "
          . $self->{"_key_attributes"}->{"state"} . " to "
          . $new_val . "\n";
        $self->{"_key_attributes"}->{"state"} = $new_val;
        $self->{"_key_attributes"}->{"state_change"} = time ;
        $self->_write_attributes;

#        print $output;
        $self->add_log_message($output);
    }
    return $self->{"_key_attributes"}->{"state"};
}


=head2 get_state_change

Returns the time of the last state change (in seconds since epoch).

=cut


sub get_state_change {
    my $self=shift;
    $self->_read_attributes;
    return $self->{"_key_attributes"}->{"state_change"} if defined $self->{"_key_attributes"}->{"state_change"};
    return 0;
}




=head2 is_active, is_published, is_inactive

These are wrappers around the "state" method.

Returns true if the state of a key is ACTIVE, PUBLISHED or INACTIVE
respectively. 



=head2 set_active, set_published, set_inactive

These are wrappers around the "state" method.

Set the state of a fetched key to  ACTIVE, PUBLISHED or INACTIVE
respectively. 


=cut

sub is_active {
    my $self = shift;
    $self->_read_attributes;
    return ( $self->{"_key_attributes"}->{"state"} eq "ACTIVE" );
}

sub is_published {
    my $self = shift;
    $self->_read_attributes;
    return ( $self->{"_key_attributes"}->{"state"} eq "PUBLISHED" );
}

sub is_inactive {
    my $self = shift;
    $self->_read_attributes;
    return ( $self->{"_key_attributes"}->{"state"} eq "INACTIVE" );
}

sub set_published {
    my $self = shift;
    $self->state("published");
    return 1 if $self->is_published;
    die "set_published failed. Your database may be inconsistent";
}

sub set_active {
    my $self = shift;
    $self->state("active");
    return 1 if $self->is_active;
    die "set_active failed. Your database may be inconsistent";

}

sub set_inactive {
    my $self = shift;
    $self->state("inactive");
    return 1 if $self->is_inactive;
    die "set_inactive failed. Your database may be inconsistent";
}

=head2 is_zsk, is_ksk


    print "Key is Keysigning Key" if $key->is_zsk;

Returns true if the key is a zone signing or a key signing key respectivly

Note that the fact that a key is a zone or key singing key is determined at
key creation time. Hence there are no equivalent set methods.


=cut

sub is_zsk {
    my $self = shift;

    $self->_read_attributes;

    return $self->{"_key_attributes"}->{"purpose"}
      && $self->{"_key_attributes"}->{"purpose"} eq "zonesigning";

}

sub is_ksk {
    my $self = shift;

    $self->_read_attributes;
    return $self->{"_key_attributes"}->{"purpose"}
      && $self->{"_key_attributes"}->{"purpose"} eq "keysigning";

}



=head2 is_algortithm();


  print "Is an RSASHA1 KEY" if $key->is_algorithm("rsasha1");
  print "Is an RSASHA1 KEY" if $key->is_algorithm(5);

Tests if the algorithm of  the key stored in $key is the one that has been
provided in the argument.

=cut


sub is_algorithm {
    my $self = shift;
    my $alg = shift;
    my $algid;
    if ($alg=~ /^\s*\d+\s*$/) {
	$algid=$alg ;
    }else{
	$algid=alg_name2num(uc $alg);
    }
    return 1 if $algid == $self->get_algorithm;
    return 0;
}



=head2 get_algortithm, get_keyid, get_keypath

After applying the fetch method these method will return non-empty 
strings.

   $key->fetch("dacht.net","RSASHA1","21827");
   print $key->get_keypath;

get_keypath the path to the private key. Returns empty string if the path
is not set. Only useful after the fetch method that uniqely identifies
a key.

=cut

sub get_domain {
    my $self = shift;
    return $self->{"_domain"};
}

sub get_algorithm {
    my $self = shift;
    return $self->{"_algorithm"};
}

sub get_keyid {
    my $self = shift;
    return $self->{"_keyid"};
}

=head3 get_keypath

   $key->fetch("dacht.net","RSASHA1","21827");
   print $key->get_keypath;

Returns the path to the private key. Returns empty string if the path
is not set. Only useful after the fetch method that uniqely identifies
a key.

=cut

sub get_keypath {
    my $self = shift;
    return $self->{"_Keypath"};
}


=head2 keysize

Returns a string the size of the key.

    print $key->keysize();

=cut


sub keysize {
    my $self=shift;
    $self->_read_attributes;
    return $self->{"_key_attributes"}->{"key_size"};
}





=head2 description

    print $key->description."\n"

Returns a string with a consice description of the key.

=cut


sub description {
    my $self = shift;
    my $description;
    $description =
     sprintf("%-18s", $self->get_domain)
      . " " . sprintf ("%04d ",$self->keysize())
      . alg_num2name( $self->get_algorithm ) . " "
      . $self->get_keyid;
    $description .= "   ZSK" if $self->is_zsk;
    $description .= "   KSK" if $self->is_ksk;
    $description .= " active   " if $self->is_active;
    $description .= " inactive " if $self->is_inactive;
    $description .= " published" if $self->is_published;


    my $now=time;
    my $days=int(($now-$self->get_state_change)/(24*3600));
    my $hours= int (($now-$self->get_state_change)/3600-$days*24);
    my $minutes=int ((($now-$self->get_state_change)%(24*60))/60);
    $description .= "  (${days}d".($hours<10?"0".$hours:$hours)."h".
	($minutes<10?"0".$minutes:$minutes)."m)";
	    
    $description .= "\t(R)" if $self->is_rollover;

    return $description;
}

=head2 keyrrstring

    print $key->keyrrstring;
    print $key->keyrrstring(3600);

Prints a multiline representation of the key RR string. By default the TTL of the
key RR is set to 0. An optional argument will overwrite this.

=cut

sub keyrrstring {
    my $self = shift;
    my $ttl  = shift;
    my $path = $self->get_keypath;
    $path =~ s/private$/key/;

    die "Could not open  $path" unless open( FH, "< $path" );
    my $keystring = "";
    $keystring .= $_ while <FH>;
    $keystring =~ s/\n//g;
    my $keyrr = Net::DNS::RR->new($keystring);
    

   $keyrr->ttl($ttl) if $ttl;
    return "error creating keyrrstring" unless $keyrr;
    return $keyrr->string;

}

#-Helper methods -------------------------------------------------------------

=head1 Some helper methods


These are methods used by other methods to access some esoteric
attributes. They may proof handy for other tools.

=head2 get_SessionID

  print $key->get_SessionID

Each session is associated with a sessionID that consists of a string 
with the date in yyyymmddhhmm and a random number. The SessionID is used for
logging purposes.

=cut

sub set_SessionID {
    my $self       = shift;
    my $session_id = shift;
    my @now        = gmtime();
    if ( !$session_id ) {
        $self->{'_SessionID'} =
          ( 1900 + $now[5] )
          . ( ( $now[4] + 1 ) < 10 ? "0" . ( $now[4] + 1 ) : ( $now[4] + 1 ) )
          . $now[3] . "-"
          . $now[2] . ":"
          . $now[1] . "."
          . ( $now[0] < 10 ? "0" . $now[0] : $now[0] )
          . ":Unknown";
    }
    else {
    }
    return $session_id;
}

=head2 add_log_message

  $key->add_log_message("Add some LOG message to the key");

Adds a log message to the key.

Use only on 'fetch'ed keys

=cut

sub add_log_message {
    my $self   = shift;
    my $output = shift;
    my $path   = $self->get_keypath;
    $path =~ s/private$/adm/;

    open( ADM, ">>  $path" )
      or die " Could not open file $path for administration";
    print ADM "LOG: $output  by "
      . $self->get_RespPerson
      . " during session "
      . $self->get_SessionID . "\n";
    close(ADM);
}

sub get_SessionID {
    my $self = shift;
    return ( $self->{'_SessionID'} ? $self->{'_SessionID'} : "NOT SET" );
}

sub set_RespPerson {
    my $self      = shift;
    my $resp_pers = shift;
    if ( !$resp_pers ) {
        $self->{'_RespPers'} = "Unknown";
    }
    else {
        $self->{'_RespPers'} = $resp_pers;
    }
    return $resp_pers;
}

sub get_RespPerson {
    my $self = shift;
    return ( $self->{'_RespPers'} ? $self->{'_RespPers'} : "NOT SET" );
}



sub get_ds_representation {
    my $self   = shift;
    my $domain = shift;
    my $algid  = shift;
    my $keyid  = shift;

    my $dnskeydirbase = $self->getconf("DNS_Key_DB");
    my $dnskeydir     = $dnskeydirbase . "/" . $domain;
    my @keys          = ($self->get_active( $domain, alg_num2name($algid)),
			 $self->get_inactive( $domain, alg_num2name($algid)));
    my $keystring     = "";
    foreach my $pubkey (@keys) {
        $pubkey =~ s/(.*K$domain\.\+(\d+)\+(\d+))\.private$/$1\.key/;
        next if $3 != $keyid;
        die "Could not open  $pubkey" unless open( FH, "< $pubkey" );
        $keystring .= $_ while <FH>;
        $keystring =~ s/\n//g;
        close FH;
        last;
    }
    my $keyrr = Net::DNS::RR->new($keystring);
    carp "Could not create KEY RR object from \n" . $keystring . "\n"
      if !$keyrr;
    my $dsrr = Net::DNS::RR::DS->create($keyrr);
    return $dsrr->rdatastr;

}

#--------------------

=head2 checkconsistency

    $key->fetch($fullpath);
    $key->checkconsistency;

Checks the consistency of the different attributes that may be set for
a given key.

The method should only be used on 'fetched' keys. Will return an error
message if there is an inconsistency. The message generated will be
something like:

 "Database inconistency: ...."

returns 0 if there are no problems.


=cut

#

sub checkconsistency {
    my $self = shift;
    $self->_read_attributes;

    return "Database inconsistency: A key cannot be active and published "
      if $self->is_published
      && $self->is_inactive;

    return "Database inconsistency: A key cannot be active and inactive "
      if $self->is_active
      && $self->is_inactive;

    return "Database inconsistency: A key cannot be published and inactive "
      if $self->is_published
      && $self->is_inactive;

    return
      "Database inconsistency: A ZSK key cannot be active and in rolled state"
      if $self->is_zsk
      && $self->is_active
      && $self->{"_key_attributes"}->{"rollover"};

    return "Database inconsistency: A ZSK key cannot be inactive and rolled"
      if $self->is_zsk
      && $self->is_inactive
      && $self->{"_key_attributes"}->{"rollover"};

}

sub _read_attributes {
    my $self = shift;
    $self->{"_key_attributes"} = {};
    $self->{"_key_attributes"}->{"attribute_state"} = "unread";
    my $storepath = $self->get_keypath;
    return 0 if $storepath eq "";
    $storepath =~ s/private$/attr/;
    my $file = new IO::LockedFile($storepath);

    return 0 unless $file;

    my $encoding = "";
    while (<$file>) {
        $encoding .= $_;
    }
    $encoding=~ m/(^\s*\$self->\{\"_key_attributes\"\}\s*=\s*\{
		   .*   # Should test on 'attribute' => 'vallue', 
		   \};)$/xsi;
    my $untaintedencoding=$1;
    eval $untaintedencoding;
    $file = undef;

}

sub _write_attributes {
    my $self = shift;
    $self->{"_key_attributes"}->{"attribute_state"} = "fromdisk";
    my $storepath = $self->get_keypath;
    return 0 if $storepath eq "";
    $storepath =~ s/private$/attr/;

    my $d = Data::Dumper->new( [ $self->{"_key_attributes"} ],
        ["\$self->\{\"_key_attributes\"\}"] );

    my $file = new IO::LockedFile(">$storepath");
    print $file $d->Dump;
    $file = undef;

    return 1;
}



sub alg_num2name {
    my $algid     = shift;
    my $algorithm = "UNKNOWN";
    $algorithm = "RSAMD5"  if ( $algid == 1 );
    $algorithm = "DSA"     if ( $algid == 3 );
    $algorithm = "RSASHA1" if ( $algid == 5 );

    carp "Algorithm number $algid  is not known. " if $algorithm eq "UNKNOWN";
    return $algorithm;
}

sub alg_name2num {
    my $algorithm = uc shift;
    my $algid;
    if ($algorithm) {
        $algid = "001" if $algorithm eq "RSAMD5";
        $algid = "001" if $algorithm eq "RSA";
        $algid = "003" if $algorithm eq "DSA";
        $algid = "005" if $algorithm eq "RSASHA1";
        if ( !$algid ) {
            return 0;
        }
    }
    return $algid;
}


#
# Helper function that escapes non-hostname characters into %HEX.
#
# dnssec-keygen converts non hostname characters to hex, therefore the 
# names of the key files need to be converted.
#
# This function does the trick.

sub domain2ascii {
    my $domain=shift;

    my $ascii="";

    while ($domain =~ m/\G(\C)/g){
	my $char=$1;
	if ($char=~/[\w|\.|-]/ ){
	    $ascii .= $char ;
	}else {
	    $ascii .=  
	      sprintf ("%%%X",ord($char));
	}
    }
    return $ascii;

}

=head2 algorithms

Returns the avialble algorithms. The list of algorithms is hardcoded and
should be consistent to the list as offered by dnssec-keygen.

(TODO: make this a configuration option?)

=cut

sub algorithms {
    my $self = shift;
    return @algorithms;
}

=head2 valid_algorithm

Returns true if the argument is a valid algotithm i.e. if it is 
one of the algorithms returned by the algorithm method.


=cut






sub valid_algorithm {
    my $self = shift;
    my $arg  = shift;
    return $algorithms_by_name{ uc $arg } if $algorithms_by_name{ uc $arg };
    return 0;
}

=head2 getconf

When a key object is created using 'new' there it contains an embedded
Net::DNS::SEC::Maint::Config object.

This is the interface method that accesses the embedded
Net::DNS::SEC::Maint::Key::Config object see Net::DNS::SEC::Config and
Net::DNS::SEC::Maint::Key::Config for details.

=cut

#
#  getconf passes the arguments to the getconf method of the embedded
#  Config object
#
sub getconf {
    my $self     = shift;
    my $argument = shift;
    my $logger=get_logger();

    $logger->debug( "GETCONF: " . ref($self) . " " . $argument) ;
    return $self->{'_Config'}->getconf($argument);
}



=head1 Functions

=head1 oldest_key


Helper function. The input is an array of keys. The function returns
the key that had the first state_change

If there are multiple keys that had the state change at exactly the
same moment the key with the lowest keyid is returned.

typical use case is
$oldest_key_active_key=oldest_key($keydb->get_active("bla.foo","RSAHA1"));
returns the oldest_key key or undefined on failure...

=cut

sub oldest_key {
    my @keys=@_;
    my $logger=get_logger();
    my $oldest=$keys[0];
    if (ref($oldest) ne "Net::DNS::SEC::Maint::Key"){
	$logger->info("MAINGKEYDB::oldest firt argument was not a Net::DNS::SEC::Maint::KEY object");	
	return (0) ;
    }
    my $i;
    for ($i=1; $i<@keys; $i++){
	if (ref($keys[$i]) ne "Net::DNS::SEC::Maint::Key"){
	    $logger->info("MAINGKEYDB::oldest argument number $i was not a Net::DNS::SEC::Maint::KEY object");	
	    return (0) ;
	}
	
	$oldest=$keys[$i] if 
	    $keys[$i]->get_state_change() < $oldest->get_state_change();
	$oldest=$keys[$i] if 
	    $keys[$i]->get_state_change() == $oldest->get_state_change() &&
	    $keys[$i]->get_keyid <  $oldest->get_keyid;

    }
    return $oldest;
}




#-----------------------------------------------------------------------------

=head1 Logging

The class uses log4perl for logging.

If not yet initialized the code will use /usr/local/etc/log4perl.conf,
/etc/log4perl.conf or use the default:

    log4perl.appender.Logfile          = Log::Log4perl::Appender::File
    log4perl.appender.Logfile.filename = test.log
    log4perl.appender.Logfile.layout   = Log::Log4perl::Layout::PatternLayout
    log4perl.appender.Logfile.layout.ConversionPattern = [%r] %F %L %m%n

    log4perl.appender.Screen         = Log::Log4perl::Appender::Screen
    log4perl.appender.Screen.stderr  = 0
    log4perl.appender.Screen.layout = Log::Log4perl::Layout::SimpleLayout



=head1 REFERENCES

[1]  SEP KEY 


=head1 TODO, BUGS and FEATURS

Whenever a database inconsistency is encountered the module will call
"die()".





=head1 COPYRIGHT

Copyright (c) 2004  RIPE NCC.  Author Olaf M. Kolkman <net-dns-sec@ripe.net>

All Rights Reserved

Permission to use, copy, modify, and distribute this software and its
documentation for any purpose and without fee is hereby granted,
provided that the above copyright notice appear in all copies and that
both that copyright notice and this permission notice appear in
supporting documentation, and that the name of the author not be used
in advertising or publicity pertaining to distribution of the software
without specific, written prior permission.


THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS; IN NO
EVENT SHALL AUTHOR BE LIABLE FOR ANY SPECIAL, INDIRECT OR
CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
PERFORMANCE OF THIS SOFTWARE.



=head1 SEE ALSO


=cut

# Make sure we return true

1;

__END__;





