#################### main pod documentation begin ###################

=head1 NAME

  Zymonic::Decryptor - Zymonic Decryptor base module.

=head1 SYNOPSIS

 These methods form the basis of a Decryptor.

=head1 DESCRIPTION

 These methods form the basis of a Decryptor.

=head1 USAGE

 The following configuration options need setting in the XML of the 
 Decryptor's system:
 
  decryptor_queue_size - Number of active connections to allow
 per decryptor port (defaults to 10 if not set)

  decryptor_ssl_key_file - SSL Key File

  decryptor_ssl_cert_file - SSL Certificate File
  
  decryptor_start_port - The lowest port to listen on (defaults to
  9599)
  
  decrypt_systems - a comma separated list of Zymonic systems to 
  store encrypted data in (optional - if blank only the decryptor's
  own system will be used.)

 The following configuration options need setting in the XML of each
 system being used to store encrypted data:
 
  keydir - The directory containing the public key and encrypted 
  private key.
  
  enc_db_username - a user to read from the zz_enc_data table as. (optional)
  enc_db_password - a password for the user above. (mandatory if username specified.)

=head1 BUGS

None we're aware of...

=head1 SUPPORT

As in the license, Zymonic is provided without warranty or support
unless purchased separately, however... If you email 
zymonic-support@zednax.com your issue will   be noted and may 
receive a response.

For security issues, please contact zymonic-security@zednax.com and
someone will respond within 8 working hours.


=head1 AUTHOR

    Alex Masidlover et al.
    CPAN ID: MODAUTHOR
    Zednax Limited
    alex.masidlover@zednax.com
    http://www.zednax.com

=head1 COPYRIGHT

This program is free software licensed under the...

    Zymonic Public License 1.0

The full text of the license can be found in the
LICENSE file included with this module.

Other licenses may be acceptable if including
parts of Zymonic in larger projects, please
contact Zednax for details. 

=head1 SEE ALSO

perl(1).

=cut

#################### main pod documentation end ###################

package Zymonic::Decryptor::Server;

use strict;
use warnings;

BEGIN
{
    use Exporter ();
    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION = '0.01';
    @ISA     = qw(Exporter);

    #Give a hoot don't pollute, do not export more than needed by default
    @EXPORT      = qw();
    @EXPORT_OK   = qw();
    %EXPORT_TAGS = ();
}

use base 'Zymonic::Decryptor';
use Zymonic;
use Zymonic::DB;
use Zymonic::Table;
use Zymonic::Utils qw(zymonic_log rethrow_exception death_handler random_string debug random_base64_string clean);

use Crypt::OpenSSL::RSA;
use Crypt::CBC;
use File::Copy;
use IO::Socket::SSL;
use MIME::Base64;
use Net::hostent;
use Storable qw(thaw);
use JSON::XS;
use Taint::Util qw(untaint);

use Zymonic;
use Exception::Class (
    'Zymonic::Exception::Decryptor' => {
        isa         => 'Zymonic::Exception',
        fields      => ['decryptor'],
        description => 'Decryptor related exception',
    },
    'Zymonic::Exception::Decryptor::Server' => {
        isa         => 'Zymonic::Exception::Decryptor',
        fields      => [],
        description => 'Decryptor Server related exception'
    },
    'Zymonic::Exception::Decryptor::Server::MissingDB' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Decryptor Server requires DB'
    },
    'Zymonic::Exception::Decryptor::Server::MissingHostname' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Decryptor Server requires hostname'
    },
    'Zymonic::Exception::Decryptor::Server::StartFailed' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Decryptor Server failed to start'
    },
    'Zymonic::Exception::Decryptor::Server::MemKeyNotFound' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Decryptor Server failed to find the Memory information'
    },
    'Zymonic::Exception::Decryptor::Server::InvalidSystem' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Invalid system specified.'
    },
    'Zymonic::Exception::Decryptor::Server::NoEncDB' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => ['system'],
        description => 'No EncryptedDB connection for [[system]]'
    },
    'Zymonic::Exception::Decryptor::Server::NoKey' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Decryptor Server does not have a key loaded yet.'
    },
    'Zymonic::Exception::Decryptor::Server::DecryptFailed' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [ 'encrypted_id', 'encrypted_data', 'enc_error' ],
        description => 'Decryptor Server could not decrypt retrieved data.'
    },
    'Zymonic::Exception::Decryptor::Server::DataNotFound' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => ['encrypted_id'],
        description => 'Decryptor Server could not find encrypted data'
    },
    'Zymonic::Exception::Decryptor::Server::RoundTripFailed' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Decryptor Server could not encrypt and decrypt data with keys.'
    },
    'Zymonic::Exception::Decryptor::Server::ForkingFailed' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Could not Fork.'
    },
    'Zymonic::Exception::Decryptor::Server::ReEncryptFailed' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [],
        description => 'Could not get Data to Reencrypt'
    },
    'Zymonic::Exception::Decryptor::Server::KeyLength' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => ['key_length'],
        description => 'Key Length needs to be an integer > 48: [[key_length]]'
    },
    'Zymonic::Exception::Decryptor::Server::AcceptError' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => [ 'perl_err', 'ssl_err' ],
        description => 'Accept connection failed: [[perl_err]] - [[ssl_err]]'
    },
    'Zymonic::Exception::Decryptor::Server::KeyOpen' => {
        isa         => 'Zymonic::Exception::Decryptor::Server',
        fields      => ['file'],
        description => 'Could not open key file'
    },
);
#################### subroutine header begin ####################

=head2 init

 Usage     :  $zd->init
 Purpose   : This is called by the constructor for the Zymonic 
 Decryptor to perform initialisation tasks.
 Returns   : nothing
 Argument  : nothing
 Throws    : Zymonic::Exception::Decryptor::Server::MissingDB
 Zymonic::Exception::Decryptor::Server::MissingHostname
 Zymonic::Exception::Decryptor::Server::StartFailed
 Comment   : 

See Also   : Zymonic::Decryptor::new

=cut

#################### subroutine header end ####################

sub init
{
    my $self = shift;

    $self->SUPER::init;

    # Exception if no DB
    Zymonic::Exception::Decryptor::Server::MissingDB->throw() unless $self->{db};

    # Exception if no hostname
    Zymonic::Exception::Decryptor::Server::MissingHostname->throw() unless $self->{hostname};

    $self->load_systems;

    # Empty hash for system dbs (if not present).
    $self->{systems} = {} unless ref( $self->{systems} );

    # Load the decryptor log table
    $self->{log_table} = $self->get_table(
        'zz_decryptor_log',
        {
            ident => '',
            DB    => $self->{config}->{DB},
        }
    );

    # Log start up
    zymonic_log(
        $self->{config}, '',
        'Decryptor Server on ' . $self->{hostname} . ' started.',
        'Decryptor Server',
        'yes', 'information'
    );

    # check for common extra fields
    $self->{decryptor_extra_fields} = [];
    if ( $self->{config}->{decryptor_extra_fields} )
    {
        $self->{decryptor_extra_fields} = [ split( /,/, $self->{config}->{decryptor_extra_fields} ) ];
    }
}

#################### subroutine header begin ####################

=head2 got_key

 Usage     :  $zd->got_key
 Purpose   : Sets the 'has key' flag in the DB, thus allowing 
 clients to connect.
 Returns   : nothing
 Argument  : The system and The keyversion (A or B)
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub got_key
{
    my $self       = shift;
    my $system     = shift;
    my $keyversion = shift;

    # For each system check which keys are currently in use.
    my $has_keys = scalar( grep { $self->all_keys_loaded($_) } keys( %{ $self->{systems} } ) );

    # Set has_key if all keys in use are loaded.
    $self->{db}->run_statement(
        {
            string => "UPDATE zz_decryptors SET has_key = 'Y' WHERE hostname = ? ",
            params => [ $self->{hostname} ],
        }
    ) if $has_keys;

}

#################### subroutine header begin ####################

=head2 connection_start

 Usage     :  $zd->connection_start('message_type','client_ip')
 Purpose   : Flags the decryptor as in use and logs the starting of 
 the connection.
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : Zymonic::Decryptor::Server::connection_close

=cut

#################### subroutine header end ####################

sub connection_start
{
    my $self      = shift;
    my $client_ip = shift;

    $self->{db}->run_statement(
        {
            string => 'UPDATE zz_decryptors SET in_use = in_use + 1 WHERE hostname = ? ',
            params => [ $self->{hostname} ],
        }
    );

    $self->{memory_log} = {
        hostname           => { value => $self->{hostname} },
        d_posix_process_id => { value => $$ },
        client             => { value => $client_ip },
        start_time         => { value => $self->{db}->timestamp_function(), direct_sql => 'true' },
        messages => [],
    };

    # clear encrypted data cache for each connection
    $self->{encrypted_data_cache} = {};

    $self->{log_id} = time() . random_string( 5, ( "a" .. "z" ) );

    return $self->{log_id};

}

#################### subroutine header begin ####################

=head2 connection_log

 Usage     :  $zd->connection_log('log message')
 Purpose   : Adds information to the log for the connection.
 Returns   : nothing
 Argument  : a message
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub connection_log
{
    my $self     = shift;
    my $message  = shift() . "\n";
    my $log_id   = shift || $self->{log_id};
    my @messages = ();

    # TODO replace the untaint with a clean using the zz_df_misc_info field
    # Will need some care to ensure continuity of service.
    untaint($message);
    push( @{ $self->{memory_log}->{messages} }, $self->{db}->timestamp( '', 'display_only' ) . " - " . $message );

}

#################### subroutine header begin ####################

=head2 connection_close

 Usage     :  $zd->connection_close('log message')
 Purpose   : Marks the decryptor as available again and logs the
 close time of the connection.
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : Zymonic::Decryptor::Server::connection_start

=cut

#################### subroutine header end ####################

sub connection_close
{
    my $self = shift;
    my $log_id = shift || $self->{log_id};

    my $message = join( "\n", @{ $self->{memory_log}->{messages} } );
    $self->{memory_log}->{misc_info} = { value => $message };
    delete $self->{memory_log}->{messages};

    $self->{log_table}->insert( $self->{memory_log} );

    $self->{db}->run_statement(
        {
            string => 'UPDATE zz_decryptors SET in_use = in_use - 1 ' . ' WHERE hostname = ? ',
            params => [ $self->{hostname} ],
        }
    );

}

#################### subroutine header begin ####################

=head2 shutdown

 Usage     :  $zd->shutdown
 Purpose   : Removes the decryptor from the table of running 
 decryptors.
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub shutdown
{
    my $self = shift;

    # Log start up
    zymonic_log(
        $self->{config}, '',
        'Decryptor Server on ' . $self->{hostname} . ' port ' . $self->{port} . ' shutdown.',
        'Decryptor Server',
        'yes', 'information'
    );

}

#################### subroutine header begin ####################

=head2 receive

 Usage     : my $incoming = $zd->receive($handle)
 Purpose   : Takes a connection handle, accepts data from it and
 returns the received hashref having replaced the encrypted
 references in all scalar values.
 Returns   : a hashref
 Argument  : a handle
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub receive
{
    my $self = shift;
    my $cgi  = shift;

    my $in = decode_json( $cgi->param('message') );

    # Add system if not peresent.
    $in->{system} = $self->{config}->{system_name}
      unless $in->{system};

    # Log the message
    $self->connection_log( "Zymonic Decryptor Message Type: " . $in->{messagetype} );

    # replace references
    my $ret = {};

    $ret = $self->replace_refs( $in, $in->{system} || '' );

    return $ret;

}

#################### subroutine header begin ####################

=head2 replace_refs

 Usage     : my $out = $zd->replace_refs($in)
 Purpose   : Replaces all memory and encrypted references with
 the correct values.
 Returns   : a hashref, scalar or arrayref
 Argument  : a hashref, scalar or arrayref
 Throws    : Zymonic::Exception::Decryptor::Server::InvalidSystem
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub replace_refs
{
    my $self   = shift;
    my $in     = shift;
    my $system = shift || $self->{config}->{system_name};

    Zymonic::Exception::Decryptor::Server::InvalidSystem->throw()
      unless ref( $self->{systems}->{$system} );

    # NOTE: see SR 11160 @ 29-09-2014 10:02 for discussion on issues in this function
    # ideally it needs rewriting to do the lookups first, then do replacements
    # however as it stands it's a bit hacked together
    # it also assumes that any extra values that need looking up, e.g. css
    # have been set as system option decryptor_extra_fields

    if ( ref($in) eq 'HASH' )
    {

        # Call ourself on each key
        foreach my $key ( keys( %{$in} ) )
        {
            $in->{$key} = $self->replace_refs( $in->{$key}, $system );
        }
    }
    elsif ( ref($in) eq 'ARRAY' )
    {

        # Call ourself on each value
        foreach my $i ( 0 .. $#{$in} )
        {
            $in->[$i] = $self->replace_refs( $in->[$i], $system );
        }
    }
    elsif ( defined $in )
    {

        # Replace the encrypted references and extra lookup references
        if ( my @refs = $in =~ /ENCRYPTED([0-9]+?(?:\.[0-9a-zA-Z_]+?)?)ENCRYPTED/gm )
        {

            # parse look into hashref { id1 => { extra1 => 1, extra2 => 1, ... }, ... }
            my $id_extras = {};
            foreach my $eid_extras (@refs)
            {
                my ( $eid, $extra ) = split( /\./, $eid_extras, 2 );
                if ($extra)
                {
                    $id_extras->{$eid} = {} unless $id_extras->{$eid};
                    $id_extras->{$eid}->{$extra} = 1;

                    # added in case extra lookup is done before card lookup, to ensure
                    # the caching below doesn't cause the card lookup to not have the data needed
                    $id_extras->{$eid}->{encrypted_data} = 1;
                    $id_extras->{$eid}->{keyversion}     = 1;
                }
                else
                {
                    $id_extras->{$eid} = {} unless $id_extras->{$eid};
                    $id_extras->{$eid}->{encrypted_data} = 1;
                    $id_extras->{$eid}->{keyversion}     = 1;
                }
            }

            # iterate over ids, lookup extras and do the replacements for each extra
            foreach my $eid ( keys %{$id_extras} )
            {

                # cache the lookup so we only do it onces
                unless ( $self->{encrypted_data_cache}->{$eid} )
                {
                    $self->{encrypted_data_cache}->{$eid} =
                      $self->lookup_encrypted_data_record( $eid, [ keys %{ $id_extras->{$eid} } ], $system );
                }
                my $eid_record = $self->{encrypted_data_cache}->{$eid};

                # do any decryption replacements
                if ( $eid_record->{encrypted_data} && $eid_record->{keyversion} )
                {
                    my $decrypted_data = $self->decrypt_encrypted_data(
                        $eid_record->{encrypted_data},
                        $eid_record->{keyversion},
                        $system, $eid
                    );
                    my $rstring = 'ENCRYPTED' . $eid . 'ENCRYPTED';
                    $in =~ s/$rstring/$decrypted_data/mg;
                }

                # do any extra field replacements
                map {
                    my $rstring = 'ENCRYPTED' . $eid . '.' . $_ . 'ENCRYPTED';
                    $in =~ s/$rstring/$eid_record->{$_}/mg;
                } grep { $_ !~ /encrypted_data|keyversion/ } keys %{ $id_extras->{$eid} };
            }
        }

        # Replace the memory references
        if ( my @refs = $in =~ /MEMORY([0-9]+?)MEMORY/gm )
        {
            foreach my $ref (@refs)
            {
                my $replacement = '';
                if ( $Zymonic::SIM{ 'SR' . $ref } )
                {
                    my $expiry = 0;

                    # Don't set replacement until timeout has been checked.
                    my $pr = '';
                    ( $expiry, $pr ) = split( /###/, $Zymonic::SIM{ 'SR' . $ref } );
                    if ( $expiry > time() )
                    {
                        if ( length($pr) )
                        {
                            $replacement = $pr;
                        }
                        else
                        {
                            self->connection_log( "Requested memory ref $ref appears empty or corrupt - content is: "
                                  . $Zymonic::SIM{ 'SR' . $ref } );
                        }
                    }

                    else
                    {
                        $self->connection_log("Requested memory ref $ref expired at $expiry... deleting.");
                        my $size = length( $Zymonic::SIM{ 'SR' . $ref } );
                        $Zymonic::SIM{ 'SR' . $ref } = random_base64_string($size) for ( 1 .. 5 );
                        delete $Zymonic::SIM{ 'SR' . $ref };
                    }
                }
                else
                {
                    $self->connection_log("Memory ref $ref not found");
                }

                # Replace anyway even if we're deleting the incoming reference.
                my $toreplace = "MEMORY" . $ref . "MEMORY";
                $in =~ s/$toreplace/$replacement/mg;
            }
        }

        # Remove expired memory references every minute.
        if ( scalar( keys(%Zymonic::SIM) ) > 2 and $Zymonic::SIM{'last_check'} < ( time() + 60 ) )
        {
            $Zymonic::SIM{'last_check'} = time();
            foreach my $key ( keys(%Zymonic::SIM) )
            {
                next if $key eq 'count' or $key eq 'last_check';

                my ( $expiry, $data ) = split( /###/, $Zymonic::SIM{$key} );
                if ( $expiry < time() )
                {
                    $self->connection_log("Memory ref $key expired at $expiry... deleting.");
                    my $size = length( $Zymonic::SIM{$key} );
                    $Zymonic::SIM{$key} = random_base64_string($size) for ( 1 .. 5 );
                    delete $Zymonic::SIM{$key};
                }
            }
        }
    }

    return $in;
}

#################### subroutine header begin ####################

=head2 get_decrsa

 Usage     : my $decrsa = $zd->get_decrsa($system)
 Purpose   : Returns the decrypted version of an encrypted piece
 of data.
 Returns   : a decrsa object
 Argument  : a system name
 Throws    : 
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub get_decrsa
{
    my $self       = shift;
    my $system     = shift;
    my $keyversion = shift;
    my $key_reload = shift || 0;

    if ( $key_reload or !$self->{systems}->{$system}->{decrsa}->{$keyversion} )
    {
        if (    $Zymonic::ZKEK{ "kek." . $system . "." . $keyversion . ".1" }
            and $Zymonic::ZKEK{ "kek." . $system . "." . $keyversion . ".2" } )
        {
            $self->{systems}->{$system}->{KEK}->{$keyversion} =
                $Zymonic::ZKEK{ "kek." . $system . "." . $keyversion . ".1" }
              . $Zymonic::ZKEK{ "kek." . $system . "." . $keyversion . ".2" };
            $self->complete_system_load( $system, $keyversion );
        }
    }

    return $self->{systems}->{$system}->{decrsa}->{$keyversion};
}

#################### subroutine header begin ####################

=head2 decrypt

 Usage     : my $decrypted = $zd->decrypt($id)
 Purpose   : Returns the decrypted version of an encrypted piece
 of data.
 Returns   : a scalar
 Argument  : an id
 Throws    : Zymonic::Exception::Decryptor::Server::NoKey
 Zymonic::Exception::Decryptor::Server::MissingDB
 Zymonic::Exception::Decryptor::Server::DecryptFailed
 Zymonic::Exception::Decryptor::Server::DataNotFound
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub decrypt
{
    my $self   = shift;
    my $id     = shift;
    my $system = shift;

    my $return = shift;

    Zymonic::Exception::Decryptor::Server::MissingDB->throw( error => 'Cannot access encrypted data database.' )
      unless ref( $self->{systems}->{$system}->{db} );

    # TODO remove after M's first keychange
    my $ed_field =
      $self->{ed_table_name} eq 'encrypted_data'
      ? 'IF(encrypted_data IS NOT NULL, encrypted_data, encrypted) AS encrypted_data'
      : 'encrypted_data';
    my $enc_data = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT ' . $ed_field . ', keyversion FROM ' . $self->{ed_table_name} . ' WHERE id = ?',
            params => [$id],
        }
    );

    if ( ref($enc_data) eq 'ARRAY' and scalar( @{$enc_data} ) == 1 )
    {

        # TODO remove this after M's first key change.
        $enc_data->[0]->{keyversion} = $self->{systems}->{$system}->{config}->sys_opt( 'keyversion', undef, 'nocache' )
          unless $enc_data->[0]->{keyversion};

        $return =
          $self->decrypt_encrypted_data( $enc_data->[0]->{encrypted_data}, $enc_data->[0]->{keyversion}, $system, $id );

    }
    else
    {

        # Throw not found exception
        Zymonic::Exception::Decryptor::Server::DataNotFound->throw( encrypted_id => $id );
    }

    return $return;

}

#################### subroutine header begin ####################

=head2 decrypt_encrypted_data

 Usage     : my $decrypted = $zd->decrypt_encrypted_data($encrypted_data, $keyversion)
 Purpose   : Returns the decrypted version of an encrypted piece
 of data.
 Returns   : a scalar
 Argument  : encrypted data
 Throws    : Zymonic::Exception::Decryptor::Server::NoKey
 Zymonic::Exception::Decryptor::Server::DecryptFailed
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub decrypt_encrypted_data
{
    my $self           = shift;
    my $encrypted_data = shift;
    my $keyversion     = shift;
    my $system         = shift;
    my $id             = shift || 'no ID';

    my $return;

    my $decrsa = $self->get_decrsa( $system, $keyversion );
    Zymonic::Exception::Decryptor::Server::NoKey->throw()
      unless $decrsa;

    # Attempt decryption
    eval {
        $return = $decrsa->decrypt( decode_base64($encrypted_data) );
        1;
    }
      or do
    {
        Zymonic::Exception::Decryptor::Server::DecryptFailed->throw(
            enc_error      => $@,
            encrypted_data => substr( $encrypted_data, 0, 3 ) . "...SNIP..." . substr( $encrypted_data, -3 ),
            encrypted_id   => $id,
        );
    };

    return $return;

}

#################### subroutine header begin ####################

=head2 load_systems

 Usage     : $zd->load_systems()
 Purpose   : Loads the config, private and public keys into memory.
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : With a large number of systems and a decryptor that
 forks, having the whole system def would be very wasteful - could add 
 a method that removes the system definition after loading??

See Also   : 

=cut

#################### subroutine header end ####################

sub load_systems
{
    my $self    = shift;
    my @systems = @_;

    @systems = ( $self->{config}->{system_name}, split( /,/, $self->{config}->{decrypt_systems} || '' ) )
      unless scalar(@systems);

    $self->{systems} = {} unless ref( $self->{systems} );

    foreach my $system (@systems)
    {
        eval {

            # Load completely if not just trying to load keys.
            unless ( ref( $self->{systems}->{$system} ) )
            {

                $self->{systems}->{$system} = {
                    decrsa      => {},
                    public      => {},
                    enc_private => {},
                };

                if ( $system eq $self->{config}->{system_name} )
                {
                    $self->{systems}->{$system}->{config} = $self->{config};
                }
                else
                {

                    # Load the config
                    $self->{systems}->{$system}->{config} = Zymonic::Config->new(
                        parent      => $self,
                        system_name => $system,
                        config_dir  => $self->{config}->{config_dir},
                    );

                }
                $self->{systems}->{$system}->{config}->load_system_definition;

                $self->{systems}->{$system}->{config}->load;

                # if encdb is specified in config, decrypt the password
                # make and store connection
                if ( $self->{systems}->{$system}->{config}->{enc_db_username} )
                {

                    $self->{systems}->{$system}->{db} = Zymonic::DB->new(
                        parent     => $self,
                        config     => $self->{systems}->{$system}->{config},
                        dbusername => $self->{systems}->{$system}->{config}->{enc_db_username},
                        dbpassword => $self->{systems}->{$system}->{config}->{enc_db_password},
                    );

                }
                else
                {

                    # otherwise use main DB.
                    $self->{systems}->{$system}->{db} = $self->{systems}->{$system}->{config}->{DB};

                }

            }

            1;
        }
          or do
        {
            my $exception = $@;
            if ($exception)
            {

                # Cause death handler to record the error, but continue...
                death_handler( $exception, '', 'return_error' );
            }
          }

    }

}

#################### subroutine header begin ####################

=head2 complete_system_load

 Usage     : $zd->complete_system_load($system)
 Purpose   : Attempts to decrypt the private key and make the
 encrypted DB connection if specified.
 Returns   : nothing
 Argument  : system name
 Throws    : Zymonic::Exception::Decryptor::Server::RoundTripFailed
 Various 'dies' from Crypt modules.
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub complete_system_load
{
    my $self       = shift;
    my $system     = shift;
    my $keyversion = shift;

    # Load the keys from file
    foreach my $key ( "a", "b" )
    {
        if (    $self->{systems}->{$system}->{config}->sys_opt( clean( 'has_key_' . $key ), undef, 'nocache' )
            and $self->{systems}->{$system}->{config}->sys_opt( clean( 'has_key_' . $key ) ) eq 'YES' )
        {

            # Load the public key
            $self->{systems}->{$system}->{public}->{$key} =
              $self->load_key_file( 'public', $self->{systems}->{$system}->{config}->{keydir}, $key );

            # Load the private key
            $self->{systems}->{$system}->{enc_private}->{$key} =
              $self->load_key_file( 'private', $self->{systems}->{$system}->{config}->{keydir}, $key );
        }
    }

    # Encrypt a fake number
    my $encrsa = Crypt::OpenSSL::RSA->new_public_key( $self->{systems}->{$system}->{public}->{$keyversion} );
    $encrsa->use_pkcs1_oaep_padding();
    my $encrypted = encode_base64( $encrsa->encrypt('4111111111111111') );

    # Decrypt the private key
    my $cipher =
      Crypt::CBC->new( -key => $self->{systems}->{$system}->{KEK}->{$keyversion}, -cipher => 'OpenSSL::AES', );
    my $decrypted_key = $cipher->decrypt( $self->{systems}->{$system}->{enc_private}->{$keyversion} );

    # Decrypt
    my $decrsa = Crypt::OpenSSL::RSA->new_private_key($decrypted_key);

    # Test the result
    Zymonic::Exception::Decryptor::Server::RoundTripFailed->throw()
      unless ( $decrsa->decrypt( decode_base64($encrypted) ) eq '4111111111111111' );

    # Save the new decryption object
    $self->{systems}->{$system}->{decrsa}->{$keyversion} = $decrsa;
    $self->{systems}->{$system}->{encrsa}->{$keyversion} = $encrsa;

    $self->got_key( $system, $keyversion );

    debug("Loaded keys for $system");

}

#################### subroutine header begin ####################

=head2 all_keys_loaded 

 Usage     :  $zd->all_keys_loaded($system)
 Purpose   : Checks which keys are being used in the DB and if 
 they are loaded in this instance of the decryptor
 Returns   : nothing
 Argument  : The system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub all_keys_loaded
{
    my $self   = shift;
    my $system = shift;

    # Which keys are in use
    my $in_use_keys = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT keyversion FROM ' . $self->{ed_table_name} . ' GROUP BY keyversion',
            params => [],
        }
    );

    my $ok = 0;

    if ( ref($in_use_keys) and ref($in_use_keys) eq 'ARRAY' and scalar( @{$in_use_keys} ) > 0 )
    {
        $ok = (
            (

                # Actual keys
                scalar( @{$in_use_keys} ) ==

                  # Loaded keys
                  scalar( grep { defined( $self->get_decrsa( $system, $_->{keyversion} || 'a' ) ) } @{$in_use_keys} )
            )
            ? 1
            : 0
        );
    }
    elsif ( ref($in_use_keys) and ref($in_use_keys) eq 'ARRAY' and scalar( @{$in_use_keys} ) == 0 )
    {
        $ok = 1;
    }

    return $ok;

}

#################### subroutine header begin ####################

=head2 new_keyversion

 Usage     :  $zd->new_keyversion($system)
 Purpose   : Returns the 'version' of the new key.
 Returns   : the 'version' of the new key.
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub new_keyversion
{
    my $self = shift;
    my $system = shift || $self->{config}->{system_name};

    my $nkv = $self->{systems}->{$system}->{config}->sys_opt( 'new_keyversion', undef, 'nocache' );
    $nkv = $self->generate_new_key($system) unless $nkv and $Zymonic::ZKEK{ "nkek." . $system . "." . $nkv . ".1" };

    return $nkv;
}

#################### subroutine header begin ####################

=head2 get_kek_part

 Usage     :  $zd->get_kek_part($system, $part)
 Purpose   : Returns the 'version' of the new key.
 Returns   : the key part or 'ALREADY SENT'
 Argument  : the system, the part required.
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub get_kek_part
{
    my $self   = shift;
    my $system = shift || $self->{config}->{system_name};
    my $part   = shift || 1;

    my $nkv = $self->new_keyversion($system);

    my $kek_part =
      $Zymonic::ZKEK{ "nkr." . $system . "." . $nkv . "." . $part }
      ? 'ALREADY SENT'
      : $Zymonic::ZKEK{ "nkek." . $system . "." . $nkv . "." . $part };

    $Zymonic::ZKEK{ "nkr." . $system . "." . $nkv . "." . $part } = 1;

    return $kek_part;
}

#################### subroutine header begin ####################

=head2 generate_new_key

 Usage     :  $zd->generate_new_key($system)
 Purpose   : Creates a new key
 Returns   : the 'version' of the new key.
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub generate_new_key
{
    my $self = shift;
    my $system = shift || $self->{config}->{system_name};

    # Work out which should be the new key
    my $current_key = $self->{systems}->{$system}->{config}->sys_opt( 'keyversion', undef, 'nocache' );
    my $nkv = ( $current_key and ( $current_key eq 'b' ) ) ? 'a' : 'b';

    debug("Generating new key: $nkv");

    # Generate the new RSA Key
    my $key_length  = $self->key_length($system);
    my $rsa         = Crypt::OpenSSL::RSA->generate_key($key_length);
    my $private_key = $rsa->get_private_key_string();
    my $public_key  = $rsa->get_public_key_string();

    # Calculate KEK length to give entropy equal to key length
    my $kek_length = 2 * int( ( $key_length / ( 2 * log(62) / log(2) ) ) + 0.5 );

    # Generate KEK
    srand( time() );
    my @chars = ( ( 'A' .. 'Z' ), ( 'a' .. 'z' ), ( 0 .. 9 ) );
    my $kek = join( '', map { $chars[ rand( scalar(@chars) ) ] } ( 0 .. ( $kek_length - 1 ) ) );

    # Encrypt the private key
    my $cipher = Crypt::CBC->new( -key => $kek, -cipher => 'OpenSSL::AES' );
    my $encrypted_key = $cipher->encrypt($private_key);

    # Split the KEK
    my $format = "a" . ( $kek_length / 2 ) . "a" . ( $kek_length / 2 );
    my @kek_parts = unpack( $format, $kek );

    # If keys files already exist, archive them
    my $private_key_file = $self->{systems}->{$system}->{config}->{keydir} . "/privatekey${nkv}.base64";
    my $public_key_file  = $self->{systems}->{$system}->{config}->{keydir} . "/publickey${nkv}.txt";
    my $archive_dir      = $self->{systems}->{$system}->{config}->{keydir} . '/old_keys_' . time();
    if ( -f $private_key_file || -f $public_key_file )
    {

        # chmod the main dir so we can create the new archive dir
        chmod 0755, $self->{systems}->{$system}->{config}->{keydir};
        mkdir $archive_dir;

        move( $private_key_file, $archive_dir . "/privatekey${nkv}.base64" ) if -f $private_key_file;
        move( $public_key_file,  $archive_dir . "/publickey${nkv}.txt" )     if -f $public_key_file;
    }

    # Store the keys
    open( PRV, ">", $private_key_file )
      or Zymonic::Exception::Decryptor::Server::KeyOpen->throw( file => $private_key_file );
    print PRV encode_base64($encrypted_key);
    close(PRV);
    open( PUB, ">", $public_key_file )
      or Zymonic::Exception::Decryptor::Server::KeyOpen->throw( file => $public_key_file );
    print PUB $public_key;
    close(PUB);
    $self->{systems}->{$system}->{public}->{$nkv} = $public_key;

    # set file permissions to read-only on new key files and read/execute on dir
    chmod 0555, $self->{systems}->{$system}->{config}->{keydir};
    chmod 0444, $private_key_file, $public_key_file;

    # Store KEK Parts in memory
    $Zymonic::ZKEK{ "nkr." . $system . "." . $nkv . ".1" }  = 0;
    $Zymonic::ZKEK{ "nkek." . $system . "." . $nkv . ".1" } = $kek_parts[0];
    $Zymonic::ZKEK{ "nkr." . $system . "." . $nkv . ".2" }  = 0;
    $Zymonic::ZKEK{ "nkek." . $system . "." . $nkv . ".2" } = $kek_parts[1];

    # Clear previously sent kek parts
    delete $Zymonic::ZKEK{ "kek." . $system . "." . $nkv . ".1" };
    delete $Zymonic::ZKEK{ "kektime." . $system . "." . $nkv . ".1" };
    delete $Zymonic::ZKEK{ "kek." . $system . "." . $nkv . ".2" };
    delete $Zymonic::ZKEK{ "kektime." . $system . "." . $nkv . ".2" };

    $self->{systems}->{$system}->{config}->sys_opt( 'new_keyversion',  $nkv,  'nocache' );
    $self->{systems}->{$system}->{config}->sys_opt( 'has_key_' . $nkv, 'YES', 'nocache' );

    return $nkv;
}

#################### subroutine header begin ####################

=head2 key_length

 Usage     :  $zd->key_length($system)
 Purpose   : Returns key length for the system
 Returns   : tkey length
 Argument  : the system
 Throws    : Zymonic::Exception::Decryptor::Server::KeyLength
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub key_length
{
    my $self = shift;
    my $system = shift || $self->{config}->{system_name};

    # determine key length
    my $key_length =
         $self->{systems}->{$system}->{config}->sys_opt( 'DecryptorKeyLength', undef, 'no_cache' )
      || $self->{systems}->{$system}->{config}->{decryptor_key_length}
      || 1024;

    # docs state this value needs to be an integer greater than 48
    # source: http://search.cpan.org/~vipul/Crypt-RSA-1.99/lib/Crypt/RSA/Key.pm#generate()
    Zymonic::Exception::Decryptor::Server::KeyLength->throw( key_length => $key_length )
      unless $key_length =~ /^\d+$/ && $key_length > 48;

    debug("Key Length: $key_length");
    return $key_length;
}

#################### subroutine header begin ####################

=head2 reencrypt

 Usage     :  $zd->reencrypt($system)
 Purpose   : Starts or restarts the decryption and re-encryption 
 of stored data.
 Returns   : nothing
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub reencrypt
{
    my $self = shift;
    my $system = shift || $self->{config}->{system_name};

    # TODO call decrypt_encrypt and then clear re-encrypt PID.
    my $cmd       = "perl /usr/local/bin/zymonic_reencryptor.pl --system=$system";
    my $reenc_pid = `/usr/local/bin/process_id_wrapper $cmd`;

}

#################### subroutine header begin ####################

=head2 decrypt_encrypt

 Usage     :  $zd->decrypt_encrypt($system)
 Purpose   : Decrypts and encrypts all data with new key.
 Returns   : nothing
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub decrypt_encrypt
{
    my $self = shift;
    my $system = shift || $self->{config}->{system_name};

    # Get 100 cards encrypted with non-current key
    my $current_key = $self->{systems}->{$system}->{config}->sys_opt( 'keyversion', undef, 'nocache' );
    my $okv = ( $current_key and ( $current_key eq 'b' ) ) ? 'a' : 'b';

    my $enc_data = $self->get_enc_data_for_reencrypt( $system, $okv );

    # Decrypt, re-encrypt and then update each.
    if ( ref($enc_data) and scalar( @{$enc_data} ) )
    {

        # Ensure both keys succesfully _reload_ before continuing, i.e., pick them up from disk in case we
        # had an old version  of the new key.
        Zymonic::Exception::Decryptor::Server::NoKey->throw()
          unless $self->get_decrsa( $system, $okv, 1 )
          and $self->get_decrsa( $system, $current_key, 1 );

        foreach my $enc_data ( @{$enc_data} )
        {

            my $data = '';

            # Attempt decryption
            eval {
                $data = $self->get_decrsa( $system, $okv )->decrypt( decode_base64( $enc_data->{encrypted_data} ) );

                # check length of masked data for data less than 13 char long, should always be the same
                my $data_length = length($data);
                my $masked_data_length = length( $enc_data->{masked_card_number} || '' );
                die "length of decrypted data doesn't match masked data"
                  unless !$enc_data->{masked_card_number}
                  or $data_length >= 13
                  or $data_length eq $masked_data_length;

                # only check last for characters if not shorter then 13 chars
                die "last 4 characters of decrypted data don't match"
                  unless !$enc_data->{masked_card_number}
                  or $data_length < 13
                  or ( substr( $data, -4 ) eq substr( $enc_data->{masked_card_number}, -4 ) );

                # encrypt _AND_ decrypt the data and ensure it still matches the data
                my $enc_enc_data = encode_base64( $self->get_decrsa( $system, $current_key )->encrypt($data) );

                my $dec_check =
                  $self->get_decrsa( $system, $current_key )->decrypt( decode_base64($enc_enc_data) );

                die "re-encrypted data doesn't decrypt properly" unless $dec_check eq $data;

                # Write the checked encrypted string
                $self->{systems}->{$system}->{db}->run_statement(
                    {
                        string => 'UPDATE '
                          . $self->{ed_table_name}
                          . ' SET reenchost = NULL, reenc_pid = NULL, encrypted_data = ?, keyversion = ? WHERE id = ?',
                        params => [ $enc_enc_data, $current_key, $enc_data->{id} ],
                    }
                );
                1;
            }
              or do
            {
                my $type = ref($@) ? ref($@) : $@;

                # detect and record corruption type
                $self->{systems}->{$system}->{db}->run_statement(
                    {
                        string =>
"UPDATE $self->{ed_table_name} SET reenchost = NULL, reenc_pid = NULL, corrupt = ? WHERE id = ?",
                        params => [ $type, $enc_data->{id} ]
                    }
                );
            };

        }
    }

}

#################### subroutine header begin ####################

=head2 get_enc_data_for_reencrypt

 Usage     :  $zd->get_enc_data_for_reencrypt($system, $okv, $attempt)
 Purpose   : Counts how many pieces of data are left to re-encrypt.
 Returns   : an integer
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub get_enc_data_for_reencrypt
{
    my $self   = shift;
    my $system = shift || $self->{config}->{system_name};
    my $okv    = shift;
    my $pid    = $$;

    my $record_limit = $self->{config}->sys_opt( 'decryptor_reencrypt_batch_size', undef, 'nocache' );

    my $perl_random_failed = 0;

    my $selected_rows = [];

    my $rec_count = [ { ct => 1 } ];

    # We firstly attempt to grab random records using perls random function to avoid forcing the DB to
    # apply random over a multi-million record table.
    # If that has no hits then we let the DB do it.
    # If the DB gets no hits i.e., perl_random_failed hits 2 then we give up...
    while ( $rec_count->[0]->{ct} and !scalar( @{$selected_rows} ) and $perl_random_failed < 2 )
    {

        # Get the record count
        $rec_count = $self->{systems}->{$system}->{db}->run_query(
            {
                string =>
"SELECT  min(id) AS mn, max(id) AS mx, count(*) AS ct FROM $self->{ed_table_name} WHERE reenc_pid IS NULL AND (keyversion = ? OR keyversion IS NULL)",
                params => [$okv]
            }
        );

        my $min   = $rec_count->[0]->{mn};
        my $max   = $rec_count->[0]->{mx};
        my $count = $rec_count->[0]->{ct};

        eval {
            if ( $count < $record_limit )
            {
                #  update/select the records (all of them if less than 500 left)
                $self->{systems}->{$system}->{db}->run_statement(
                    {
                        string =>
"UPDATE $self->{ed_table_name} SET reenchost = ?, reenc_pid = ? WHERE reenc_pid IS NULL AND ( keyversion = ? OR keyversion IS NULL )",
                        params => [ $self->{hostname}, $pid, $okv ]
                    }
                );
            }
            elsif ($perl_random_failed)
            {

                my $range = $max - $min;

                my @random_ids = map { int( rand($range) ) + $min } ( 1 .. $record_limit );

                #  update/select the records
                $self->{systems}->{$system}->{db}->run_statement(
                    {
                        string =>
"UPDATE $self->{ed_table_name} SET reenchost = ?, reenc_pid = ? WHERE reenc_pid IS NULL AND ( keyversion = ? OR keyversion IS NULL ) AND id IN ( "
                          . join( ", ", map { "?" } @random_ids ) . " )",
                        params => [ $self->{hostname}, $pid, $okv, @random_ids ]
                    }
                );
            }
            else
            {
                my $random_rows = $self->{systems}->{$system}->{db}->run_query(
                    {
                        string =>
" SELECT id FROM ( SELECT id FROM $self->{ed_table_name} WHERE reenc_pid IS NULL AND ( keyversion = ? OR keyversion IS NULL ) ORDER BY "
                          . $self->{systems}->{$system}->{db}->random_function()
                          . " ) AS T LIMIT $record_limit ",
                        params => [$okv]
                    }
                );

                $self->{systems}->{$system}->{db}->run_statement(
                    {
                        string =>
                          "UPDATE zz_enc_data SET reenchost = ?, reenc_pid = ? WHERE reenc_pid IS NULL AND id IN ( "
                          . join( ", ", map { "?" } @{$random_rows} ) . " ) ",
                        params => [ $self->{hostname}, $pid, map { $_->{id} } @{$random_rows} ]
                    }
                ) if ( ( ref($random_rows) || '' ) eq 'ARRAY' and scalar( @{$random_rows} ) );
            }
            1;
        } or do
        {
            my $exception = $@;
            if (    ref($exception)
                and $exception->isa('Zymonic::Exception::Db::Query_Run')
                and $exception->{sql_err} =~ /ORA-00060/ )
            {
                print "IGNORING DEADLOCK\n";
                sleep 3;
            }
            else
            {
                rethrow_exception($exception);
            }
        };

        # TODO remove after M's first keychange
        my $ed_field =
          $self->{ed_table_name} eq 'encrypted_data'
          ? 'IF(encrypted_data IS NOT NULL, encrypted_data, encrypted) AS encrypted_data'
          : 'encrypted_data';

        $selected_rows = $self->{systems}->{$system}->{db}->run_query(
            {
                string =>
"SELECT id, $ed_field, masked_card_number FROM $self->{ed_table_name} WHERE reenc_pid = ? AND reenchost = ?",
                params => [ $pid, $self->{hostname} ]
            }
        );

        $perl_random_failed += 1;

    }

    return $selected_rows;

}

#################### subroutine header begin ####################

=head2 encrypted_with_old_key

 Usage     :  $zd->encrypted_with_old_key($system)
 Purpose   : Counts how many pieces of data are left to re-encrypt.
 Returns   : an integer
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub encrypted_with_old_key
{
    my $self = shift;
    my $system = shift || $self->{config}->{system_name};

    return undef unless $self->{systems}->{$system}->{db};

    # Select count of data encrypted with non-current key.
    my $current_key = $self->{systems}->{$system}->{config}->sys_opt( 'keyversion', undef, 'nocache' );
    my $okv = ( $current_key and ( $current_key eq 'b' ) ) ? 'a' : 'b';
    my $old_data = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT COUNT(id) AS old_key_count, COUNT(corrupt) AS corrupt_count FROM '
              . $self->{ed_table_name}
              . ' WHERE (keyversion = ? OR keyversion IS NULL)',
            params => [$okv],
        }
    );

    my $in_progress = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT COUNT(id) AS in_progress FROM '
              . $self->{ed_table_name}
              . ' WHERE reenc_pid IS NOT NULL GROUP BY reenc_pid',
            params => [],
        }
    );

    $old_data->[0]->{reencryptors} = scalar( @{$in_progress} );

    return $old_data->[0];
}

#################### subroutine header begin ####################

=head2 new_key_reset

 Usage     :  $zd->new_key_reset($system)
 Purpose   : Clears the new key flag to allow another attempt.
 Returns   : nothing
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub new_key_reset
{
    my $self = shift;
    my $system = shift || $self->{config}->{system_name};

    my $nkv = $self->{systems}->{$system}->{config}->sys_opt( 'new_keyversion', undef, 'nocache' );
    $self->{systems}->{$system}->{config}->sys_opt( 'new_keyversion',  '', 'nocache' );
    $self->{systems}->{$system}->{config}->sys_opt( 'has_key_' . $nkv, '', 'nocache' );

    debug("Resetting key $nkv");

    delete $Zymonic::ZKEK{ "nkek." . $system . "." . $nkv . ".1" };
    delete $Zymonic::ZKEK{ "nkr." . $system . "." . $nkv . ".1" };
    delete $Zymonic::ZKEK{ "kek." . $system . "." . $nkv . ".1" };
    delete $Zymonic::ZKEK{ "kektime." . $system . "." . $nkv . ".1" };
    delete $Zymonic::ZKEK{ "nkek." . $system . "." . $nkv . ".2" };
    delete $Zymonic::ZKEK{ "nkr." . $system . "." . $nkv . ".2" };
    delete $Zymonic::ZKEK{ "kek." . $system . "." . $nkv . ".2" };
    delete $Zymonic::ZKEK{ "kektime." . $system . "." . $nkv . ".2" };

    # Delete DB pass file.
    unlink( $self->{systems}->{$system}->{config}->{keydir} . "/dbpasswdkey" . $nkv . '.base64' )
      if -f $self->{systems}->{$system}->{config}->{keydir} . "/dbpasswdkey" . $nkv . '.base64';
}

#################### subroutine header begin ####################

=head2 find_id

 Usage     :  $zd->find_id($system, $card_number, $extra_keys)
 Purpose   : Clears the new key flag to allow another attempt.
 Returns   : nothing
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub find_id
{
    my $self       = shift;
    my $system     = shift || $self->{config}->{system_name};
    my $data       = shift;
    my $extra_keys = shift;

    my $id = '';

    # Search on extra keys
    # Untaint the values - they may be coming from a decryptor call
    # untainting here rather than trying to clean in the message
    # since we don't know what the extra keys are and we're using bind
    # parameters
    my $query =
        'SELECT id, IF(encrypted_data IS NOT NULL, encrypted_data, encrypted) AS encrypted_data, keyversion FROM '
      . $self->{ed_table_name}
      . ' WHERE '
      . join( " AND ", map { untaint($_); clean( $_, '_' ) . ' = ?' } keys( %{$extra_keys} ) );
    untaint($query);
    my $potential_data = $self->{systems}->{$system}->{db}->run_query(
        {
            string => $query,
            params => [ map { untaint($_); $_; } values( %{$extra_keys} ) ]
        }
    );

    # Decrypt each and test against data
    if ( ref($potential_data) eq 'ARRAY' )
    {
        foreach my $potential ( @{$potential_data} )
        {
            # TODO remove this after M's first keychange.
            $potential->{keyversion} = $self->{systems}->{$system}->{config}->sys_opt( 'keyversion', undef, 'nocache' )
              unless $potential->{keyversion};

            # Attempt decryption
            eval {
                if ( $data eq $self->get_decrsa( $system, $potential->{keyversion} )
                    ->decrypt( decode_base64( $potential->{encrypted_data} ) ) )
                {
                    $id = $potential->{id};
                    last;
                }
                1;
            }
              or do
            {
                Zymonic::Exception::Decryptor::Server::DecryptFailed->throw(
                    enc_error      => $@,
                    encrypted_id   => $potential->{id},
                    encrypted_data => substr( $potential->{encrypted_data}, 0, 3 )
                      . "...SNIP..."
                      . substr( $potential->{encrypted_data}, -3 ),
                );
            };
        }
    }

    return $id;

}

#################### subroutine header begin ####################

=head2 find_all

 Usage     :  $zd->find_all($system, $card_number, $extra_keys)
 Purpose   : Finds all matching ids in the system
 Returns   : list of encrytped ifs
 Argument  : the system, data to search on and extra keys
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub find_all
{
    my $self       = shift;
    my $system     = shift || $self->{config}->{system_name};
    my $data       = shift;
    my $extra_keys = shift;

    my @ids = ();

    # Search on extra keys
    my $potential_data = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT id, encrypted_data, keyversion FROM '
              . $self->{ed_table_name}
              . ' WHERE '
              . join( " AND ", map { $_ . ' = ?' } keys( %{$extra_keys} ) ),
            params => [ values( %{$extra_keys} ) ]
        }
    );

    # Decrypt each and test against data
    if ( ref($potential_data) eq 'ARRAY' )
    {
        foreach my $potential ( @{$potential_data} )
        {
            # TODO remove this after M's first keychange.
            $potential->{keyversion} = $self->{systems}->{$system}->{config}->sys_opt( 'keyversion', undef, 'nocache' )
              unless $potential->{keyversion};

            # Attempt decryption
            eval {
                if ( $data eq $self->get_decrsa( $system, $potential->{keyversion} )
                    ->decrypt( decode_base64( $potential->{encrypted_data} ) ) )
                {
                    push( @ids, $potential->{id} );
                }
                1;
            }
              or do
            {
                Zymonic::Exception::Decryptor::Server::DecryptFailed->throw(
                    enc_error      => $@,
                    encrypted_id   => $potential->{id},
                    encrypted_data => substr( $potential->{encrypted_data}, 0, 3 )
                      . "...SNIP..."
                      . substr( $potential->{encrypted_data}, -3 ),
                );
            };
        }
    }

    return @ids;
}

#################### subroutine header begin ####################

=head2 has_kek

 Usage     :  $zd->has_kek($system, $kek_part, )
 Purpose   : Returns whether the decryptor has the part of the key
 encrypting key.
 Returns   : nothing
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub has_kek
{
    my $self   = shift;
    my $system = shift || $self->{config}->{system_name};
    my $part   = shift || 1;

    my $nkv = $self->new_keyversion($system);

    my $has_kek_part = $Zymonic::ZKEK{ "kek." . $system . "." . $nkv . "." . $part } ? 1 : 0;

    # Be careful not to accidentally send KEK back if typo is introduced above...
    $has_kek_part =~ s/[^10]//g;

    return $has_kek_part;

}

#################### subroutine header begin ####################

=head2 set_kek

 Usage     :  $zd->set_kek($system, $key, $part, $kek_part )
 Purpose   : Sets the KEK part
 Returns   : whether the server now has both parts
 Argument  : the system
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub set_kek
{
    my $self     = shift;
    my $system   = shift || $self->{config}->{system_name};
    my $key      = shift;
    my $part     = shift || 1;
    my $kek_part = shift;

    # Set the KEK part
    $Zymonic::ZKEK{ "kek." . $system . "." . $key . "." . $part } = $kek_part;

    # Set the last updated
    $Zymonic::ZKEK{ "kektime." . $system . "." . $key . "." . $part } = $self->{db}->timestamp( '', 'display_only' );

    return (  $Zymonic::ZKEK{ "kek." . $system . "." . $key . "." . $part }
          and $Zymonic::ZKEK{ "kek." . $system . "." . $key . "." . ( $part eq '1' ? 2 : 1 ) } ) ? 1 : 0;

}

#################### subroutine header begin ####################

=head2 disconnect

 Usage     :  $zd->disconnect
 Purpose   : Does a disconnect from all DBs.
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub disconnect
{
    my $self = shift;

    # We undef the connection if its a reused connection otherwise
    # the final disconnect(s) don't work.

    # System DBs
    foreach ( values( %{ $self->{systems} } ) )
    {
        if ( $_->{db} == $self->{config}->{DB} or $_->{db} == $self->{db} )
        {
            $_->{db} = undef;
        }
        elsif ( ref( $_->{db} ) )
        {
            $_->{db}->close_db_connection;
        }
    }

    # Main DBs
    if ( $self->{db} == $self->{config}->{DB} )
    {
        $self->{db} = undef;
    }
    else
    {
        $self->{db}->close_db_connection;
    }
}

#################### subroutine header begin ####################

=head2 lookup_encrypted_data_record

 Usage     : $self->lookup_encrypted_data_record($id, $extras, $system);
 Purpose   : Looks up values of extras for given id
 Returns   : hashref contain id and extras, or undef if no match
 Argument  : encrypted id, list of extra fields, system
 Throws    : 
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub lookup_encrypted_data_record
{
    my $self         = shift;
    my $id           = shift;
    my $extra_fields = shift;
    my $system       = shift;

    Zymonic::Exception::Decryptor::Server::NoEncDB->throw( system => $system )
      unless ref( $self->{systems}->{$system}->{db} );

    my @fields = ( qw(id), @{$extra_fields}, @{ $self->{decryptor_extra_fields} } );

    # TODO remove after M's first keychange
    if ( $self->{ed_table_name} eq 'encrypted_data' )
    {
        @fields =
          map {
            $_ eq 'encrypted_data'
              ? 'IF(encrypted_data IS NOT NULL, encrypted_data, encrypted) AS encrypted_data'
              : $_
          } @fields;
    }
    my $data = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT '
              . join( ', ', map { clean( $_, "()" ) } @fields )
              . ' FROM '
              . clean( $self->{ed_table_name} )
              . ' WHERE id = ?',
            params => [ clean($id) ]
        }
    );

    # TODO remove after M's first keychange
    $data->[0]->{keyversion} = 'a' unless $data->[0]->{keyversion};

    return $data->[0];
}

#################### subroutine header begin ####################

=head2 key_status

 Usage     : $self->key_status($system, $key);
 Purpose   : Returns the key statuses suitable for the Status message
 Returns   : as per purpose
 Argument  : system, key
 Throws    : 
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub key_status
{
    my $self   = shift;
    my $system = shift;
    my $key    = shift;

    my $decoded = 'N';

    eval { $decoded = 'Y' if ( ref( $self->get_decrsa( $system, $key ) ) ); 1; }
      or do { debug( "Key not decoded: " . ( ref($@) || $@ ) ); };
    return {
        present => (
                  $self->{systems}->{$system}->{config}->sys_opt( 'has_key_' . $key, undef, 'nocache' )
              and $self->{systems}->{$system}->{config}->sys_opt( 'has_key_' . $key ) eq 'YES'
          ) ? 'Y' : 'N',
        decoded     => $decoded,
        primary_key => (
                  $self->{systems}->{$system}->{config}->sys_opt( 'keyversion', undef, 'nocache' )
              and $self->{systems}->{$system}->{config}->sys_opt('keyversion') eq $key
          )
        ? 'Y'
        : 'N',

        kek_part_1_last_sent => $Zymonic::ZKEK{ "kektime." . $system . "." . $key . ".1" },
        kek_part_2_last_sent => $Zymonic::ZKEK{ "kektime." . $system . "." . $key . ".2" },
    };

}

#################### subroutine header begin ####################

=head2 postfork

 Usage     :  $zd->postfork
 Purpose   : Does tasks need after forking e.g. database reconnect.
 Returns   : nothing
 Argument  : child pid (if from parent) or 0 if not.
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub postfork
{
    my $self      = shift;
    my $child_pid = shift;

    if ( defined $child_pid and ( $child_pid == 0 ) )
    {

        # Main DBs
        $self->{db}->child_mode;
        $self->{config}->{DB}->child_mode if $self->{db} != $self->{config}->{DB};

        # System DBs
        foreach ( values( %{ $self->{systems} } ) )
        {
            if ( ref( $_->{db} ) and ( $_->{db} != $self->{config}->{DB} ) and ( $_->{db} != $self->{db} ) )
            {
                $_->{db}->child_mode;
            }
        }
    }
}

#################### subroutine header begin ####################

=head2 store_in_mem

 Usage     :  $zd->store_in_mem($data, $timeout)
 Purpose   : Stores a value in shared memory
 Returns   : a numeric reference to the data (store_ref) and the server 
             (server)
 Argument  : data (scalar), time limit to store the data for (seconds 
             defaults to 1800)
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

#################### subroutine header end ####################

sub store_in_mem
{
    my $self    = shift;
    my $data    = shift;
    my $timeout = shift || 1800;

    # Simultaneously increment and hold the key to try and avert
    # race conditions.
    my $expiry = time() + $timeout;
    my $key = $Zymonic::SIM{'count'} += 1;
    $Zymonic::SIM{ "SR" . $key } = $expiry . '###' . $data;

    debug("Stored SR$key with expiry $expiry");

    debug( "Zymonic::SIM has " . scalar( keys(%Zymonic::SIM) ) . " keys" );

    return { store_ref => 'MEMORY' . $key . 'MEMORY', server => $self->{hostname} };

}

1;