#################### 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...

    Alfresco 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::DB;
use IO::Socket::SSL;
use Zymonic;
use Zymonic::Utils qw(zymonic_log rethrow_exception);
use Crypt::OpenSSL::RSA;
use Crypt::CBC;
use MIME::Base64;
use Net::hostent;
use Zymonic::Utils qw(death_handler);

#################### 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};

    my $error = '';
    foreach my $count ( 1 .. 10 )
    {

        # Get all the current servers
        my $servers = $self->{db}->run_query(
            {
                string => 'SELECT ' . $self->{zz_decryptor_fields} . ' FROM zz_decryptors WHERE hostname = ?',
                params => [ $self->{hostname} ],
            }
        );

        # Delete any 'dead' servers
        foreach my $server ( @{$servers} )
        {

            # check for process
            my $pexists = kill( 0, $server->{d_posix_process_id} );

            # Delete from table if not existing
            unless ($pexists)
            {
                $self->{db}->run_statement(
                    {
                        string => 'DELETE FROM zz_decryptors WHERE port = ? AND hostname = ?',
                        params => [ $server->{port}, $server->{hostname} ],
                    }
                );
                $server->{port} = 0;
            }
        }

        # Use the next highest port available (or 9599 if we're first server)
        $self->{port} = $self->{config}->{decryptor_start_port} || 9599;
        if ( ref($servers) eq 'ARRAY' and scalar( @{$servers} ) > 0 )
        {
            my $port = ( sort { $b->{port} <=> $a->{port} } @{$servers} )[0]->{port};
            $self->{port} = ( $port + 1 ) if $port;
        }

        # Write out our record to DB and check it worked
        $self->{db}->run_statement(
            {
                string => 'INSERT INTO zz_decryptors (port, hostname, d_posix_process_id, in_use) VALUES (?,?,?,0)',
                params => [ $self->{port}, $self->{hostname}, $$ ],
            }
        );

        my $server_rec = $self->{db}->run_query(
            {
                string => 'SELECT '
                  . $self->{zz_decryptor_fields}
                  . ' FROM zz_decryptors WHERE port = ? AND hostname = ? AND d_posix_process_id = ?',
                params => [ $self->{port}, $self->{hostname}, $$ ],
            }
        );

        next unless ref($server_rec) eq 'ARRAY' and scalar( @{$server_rec} ) == 1;

        # Start the server.
        $self->{server} = IO::Socket::SSL->new(
            LocalPort       => $self->{port},
            Reuse           => 1,
            Listen          => $self->{config}->{decryptor_queue_size} || 10,
            Proto           => 'tcp',
            SSL_verify_mode => 0x00,
            SSL_key_file    => $self->{config}->{decryptor_ssl_key_file},
            SSL_cert_file   => $self->{config}->{decryptor_ssl_cert_file},
        );

        last if $self->{server};

        sleep(1);
    }

    # Success? If not exception.
    Zymonic::Exception::Decryptor::Server::StartFailed->throw(
        error => 'Unable to start server: ' . &IO::Socket::SSL::errstr, )
      unless $self->{server};

    $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} = Zymonic::Table->new(
        parent => $self,
        zname  => 'zz_decryptor_log',
        ident  => '',
        config => $self->{config},
        DB     => $self->{config}->{DB},
    );

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

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

=head2 accept 

 Usage     :  $zd->accept
 Purpose   : This is just a wrapper around IO::Socket::INET's 
 accept method.
 Returns   : a client connection.
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub accept
{
    my $self = shift;

    return $self->{server}->accept();
}

#################### 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 = ? AND port = ?",
            params => [ $self->{hostname}, $self->{port} ],
        }
    ) if $has_keys;

}

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

=head2 get_from_mem

 Usage     :  $zd->get_from_mem
 Purpose   : Gets a 'memory' item.
 Returns   : the item.
 Argument  : the key.
 Throws    : Zymonic::Exception::Decryptor::Server::MemKeyNotFound
 Comment   : 

See Also   : Zymonic::Decryptor::Client::store_in_mem

=cut

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

sub get_from_mem
{
    my $self = shift;
    my $key  = shift;

    # Expire 'old' items.
    $self->{db}->run_statement(
        {
            string => 'DELETE FROM zz_mks WHERE timeout < ?',
            params => [ time() ],
        }
    );

    # Try and get the requested key.
    my $mem_item = $self->{db}->run_query(
        {
            string => 'SELECT data FROM zz_mks WHERE pk = ?',
            params => [$key],
        }
    );

    Zymonic::Exception::Decryptor::Server::MemKeyNotFound->throw()
      unless ref($mem_item) eq 'ARRAY' and scalar( @{$mem_item} ) == 1;

    return $mem_item->[0]->{data};

}

#################### 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 = ? AND port = ?',
            params => [ $self->{hostname}, $self->{port} ],
        }
    );

    $self->{db}->run_statement(
        {
            string => 'INSERT INTO zz_decryptor_log (hostname, port, d_posix_process_id, client, start_time) '
              . 'VALUES (?,?,?,?, '
              . $self->{db}->timestamp_function . ')',
            params => [ $self->{hostname}, $self->{port}, $$, $client_ip ],
        }
    );

    $self->{log_id} = $self->{db}->last_insert_id( $self->{log_table} );

    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 = ();

    my $current_log = $self->{db}->run_query(
        {
            string => 'SELECT misc_info FROM zz_decryptor_log WHERE id = ?',
            params => [$log_id],
        }
    );

    push( @messages, $current_log->[0]->{misc_info} ) if $current_log->[0]->{misc_info};

    push( @messages, $self->{db}->timestamp( '', 'display_only' ) . " - " . $message );

    $self->{db}->run_statement(
        {
            string => 'UPDATE zz_decryptor_log SET misc_info = ? WHERE id = ?',
            params => [ join( "\n", @messages ), $log_id ],
        }
    );

}

#################### 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};

    $self->{db}->run_statement(
        {
            string => 'UPDATE zz_decryptor_log SET end_time = ' . $self->{db}->timestamp_function . ' WHERE id = ?',
            params => [$log_id],
        }
    );

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

}

#################### 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;

    $self->{db}->run_statement(
        {
            string => 'DELETE FROM zz_decryptors WHERE hostname = ? AND port = ?',
            params => [ $self->{hostname}, $self->{port} ],
        }
    );

}

#################### 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 $handle = shift;

    my $in = $self->unpack_and_thaw($handle);

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

    # replace references
    my $ret = {};
    eval {

        $ret = $self->replace_refs( $in, $in->{system} || '' );
        1;
      } or do
    {
        my $exception = $@;
        if ( ref($exception) and $exception->isa('Zymonic::Exception::Decryptor::Server::NoKey') )
        {
            $self->connection_log('Replacement failed - no key.');
            return { message => 'Decryptor has no Key.' };
        }
        elsif ( ref($exception) and $exception->isa('Zymonic::Exception::Decryptor::Server::DataNotFound') )
        {
            $self->connection_log( 'Replacement failed - not found (id ' . $exception->encrypted_id() . ')' );
            return { message => 'Encrypted Data not Found' };
        }
        elsif ( ref($exception) and $exception->isa('Zymonic::Exception::Decryptor::Server::DecryptFailed') )
        {
            $self->connection_log( 'Replacement failed - decrypt failed (id ' . $exception->encrypted_id() . ')' );
            return { message => 'Encrypted Data not decrypted' };
        }
        elsif ( ref($exception) and $exception->isa('Zymonic::Exception::Decryptor::Server::InvalidSystem') )
        {
            $self->connection_log('Replacement failed - system not recognised.');
            return { message => 'System not Recognised' };
        }
        else
        {
            rethrow_exception($exception);
        }
    };

    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} );

    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 );
        }
    }
    else
    {

        # Replace the encrypted references
        if ( my @refs = $in =~ /ENCRYPTED([0-9]*?)ENCRYPTED/gm )
        {
            foreach my $eid (@refs)
            {
                my $decryp = $self->decrypt( $eid, $system );
                my $rstring = 'ENCRYPTED' . $eid . 'ENCRYPTED';
                $in =~ s/$rstring/$decryp/mg;
            }
        }

        # TODO Replace the memory references
    }

    return $in;
}

#################### 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} );

    my $enc_data = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT encrypted_data, keyversion FROM zz_enc_data WHERE id = ?',
            params => [$id],
        }
    );

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

        Zymonic::Exception::Decryptor::Server::NoKey->throw()
          unless ref( $self->{systems}->{$system}->{decrsa} )
              and ref( $self->{systems}->{$system}->{'decrsa'}->{ $enc_data->[0]->{keyversion} } );

        # Attempt decryption
        eval {
            $return =
              $self->{systems}->{$system}->{'decrsa'}->{ $enc_data->[0]->{keyversion} }
              ->decrypt( decode_base64( $enc_data->[0]->{encrypted_data} ) );
            1;
          }
          or do
        {
            Zymonic::Exception::Decryptor::Server::DecryptFailed->throw(
                error        => $@,
                encrypted_id => $id,
            );
        };

    }
    else
    {

        # Throw not found exception
        Zymonic::Exception::Decryptor::Server::DataNotFound->throw( 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;

            }

            foreach my $key (qw(a b))
            {
                if (    $self->{systems}->{$system}->{config}->sys_opt( 'has_key_' . $key )
                    and $self->{systems}->{$system}->{config}->sys_opt( '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 );
                }
            }
            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;

    # 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;

    # 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};

    }

    # If we're here and the keyversion is a 'new' key then
    # unset our nofork flag.
    my $nkv = $self->{systems}->{$system}->{config}->sys_opt('new_keyversion');
    if ( $nkv and $nkv eq $keyversion )
    {

        $self->{db}->run_statement(
            {
                string => "UPDATE zz_decryptors SET nofork = 'N'",
                params => [],
            }
        );

    }

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

}

#################### 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 zz_enc_data GROUP BY keyversion',
            params => [],
        }
    );

    my $ok = 0;

    if ( ref($in_use_keys) and ref($in_use_keys) eq 'ARRAY' )
    {
        $ok = (
            (

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

                  # Loaded keys
                  scalar(
                    grep { defined( $self->{systems}->{$system}->{decrsa}->{ $_->{keyversion} } ) } @{$in_use_keys}
                  )
            )
            ? 1
            : 0
        );
    }

    return $ok;

}

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

=head2 nofork

 Usage     :  $zd->nofork
 Purpose   : Returns whether the decryptor is in nofork mode.
 Returns   : whether decryptor is in nofork mode.
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub nofork
{
    my $self = shift;

    my $nofork = 0;

    my $decryptor_rec = $self->{db}->run_query(
        {
            string => 'SELECT has_key, nofork FROM zz_decryptors WHERE hostname = ? AND port = ?',
            params => [ $self->{hostname}, $self->{port} ],
        }
    );

    $nofork = 1
      unless ( $decryptor_rec->[0]->{has_key} and $decryptor_rec->[0]->{has_key} eq 'Y' );
    $nofork = 1 if ( $decryptor_rec->[0]->{nofork} and $decryptor_rec->[0]->{nofork} eq 'Y' );

    return $nofork;

}

#################### 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');
    $nkv = $self->generate_new_key($system) unless $nkv and ref( $self->{new_kek_parts} );

    # Initiate non-forking mode
    $self->{db}->run_statement(
        {
            string => "UPDATE zz_decryptors SET nofork = 'Y'",
            params => [],
        }
    );

    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 =
      $self->{new_kek_parts}->{$part}->{retrieved}
      ? 'ALREADY SENT'
      : $self->{new_kek_parts}->{$part}->{content};

    $self->{new_kek_parts}->{$part}->{retrieved} = 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');
    my $nkv = ( $current_key and ( $current_key eq 'b' ) ) ? 'a' : 'b';

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

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

    # 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 @kek_parts = unpack( "a6a6", $kek );

    # Store the keys
    open( PRV, ">", $self->{systems}->{$system}->{config}->{keydir} . "/privatekey" . $nkv . '.base64' );
    print PRV encode_base64($encrypted_key);
    close(PRV);

    open( PUB, ">", $self->{systems}->{$system}->{config}->{keydir} . "/publickey" . $nkv . '.txt' );
    print PUB $public_key;
    close(PUB);
    $self->{systems}->{$system}->{public}->{$nkv} = $public_key;

    # Store KEK Parts in memory
    $self->{new_kek_parts} = {
        '1' => { content => $kek_parts[0], retrieved => 0 },
        '2' => { content => $kek_parts[1], retrieved => 0 },
    };

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

    return $nkv;
}

#################### 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};

    # Check if there is a new keyversion set
    my $nkv = $self->{systems}->{$system}->{config}->sys_opt('new_keyversion');

    if ($nkv)
    {

        # If so fork, swap the keyversion  sys opt, record our PID as
        # the re-encrypt and clear the new version flag
        $self->{systems}->{$system}->{config}->sys_opt( 'new_keyversion', '' );

        my $cpid = fork();
        Zymonic::Exception::Decryptor::Server::ForkingFailed->throw() unless defined $cpid;

        if ($cpid)
        {

            $self->postfork($cpid);

            # Record the PID
            $self->{systems}->{$system}->{config}->sys_opt( 'reencrypt PID', $cpid );
        }
        else
        {

            $self->postfork($cpid);

            # call decrypt_encrypt and then clear re-encrypt PID.
            $self->decrypt_encrypt($system);
            $self->{systems}->{$system}->{config}->sys_opt( 'reencrypt PID', '' );
            exit(0);

        }

    }
    else
    {

        # Otherwise, check if there is a re-encrypt PID and if the
        # process is running - if not fork(), call decrypt_encrypt
        # then clear re-encrypt PID.
        my $pexists = kill( 0, $self->{systems}->{$system}->{config}->sys_opt('reencrypt PID') );
        unless ($pexists)
        {
            my $cpid = fork();
            Zymonic::Exception::Decryptor::Server::ForkingFailed->throw() unless defined $cpid;

            if ($cpid)
            {

                $self->postfork($cpid);

                # Record the PID
                $self->{systems}->{$system}->{config}->sys_opt( 'reencrypt PID', $cpid );
            }
            else
            {

                $self->postfork($cpid);

                # call decrypt_encrypt and then clear re-encrypt PID.
                $self->decrypt_encrypt($system);
                $self->{systems}->{$system}->{config}->sys_opt( 'reencrypt PID', '' );
                exit(0);

            }

        }

    }
}

#################### 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');
    my $okv = ( $current_key and ( $current_key eq 'b' ) ) ? 'a' : 'b';

    my $done = 0;
    while ( !$done )
    {
        my $enc_data = $self->{systems}->{$system}->{db}->run_query(
            {
                string => 'SELECT id, encrypted_data FROM zz_enc_data WHERE keyversion = ? LIMIT 100',
                params => [$okv],
            }
        );

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

                my $data = '';

                Zymonic::Exception::Decryptor::Server::NoKey->throw()
                  unless ref( $self->{systems}->{$system}->{decrsa} )
                      and ref( $self->{systems}->{$system}->{'decrsa'}->{$okv} );

                # Attempt decryption
                eval {
                    $data =
                      $self->{systems}->{$system}->{'decrsa'}->{$okv}
                      ->decrypt( decode_base64( $enc_data->{encrypted_data} ) );
                    $self->{systems}->{$system}->{db}->run_query(
                        {
                            string => 'UPDATE zz_enc_data SET encrypted_data = ?, keyversion = ? WHERE id = ?',
                            params => [
                                encode_base64(
                                    $self->{systems}->{$system}->{'encrsa'}->{$current_key}->encrypt($data)
                                ),
                                $current_key,
                                $enc_data->{id}
                            ],
                        }
                    );
                    1;
                  }
                  or do
                {
                    Zymonic::Exception::Decryptor::Server::DecryptFailed->throw(
                        error        => $@,
                        encrypted_id => $enc_data->{id},
                    );
                };

            }
        }
        elsif ( ref($enc_data) and ( scalar( @{$enc_data} == 0 ) ) )
        {
            $done = 1;
        }
        else
        {
            Zymonic::Exception::Decryptor::Server::ReEncryptFailed->throw();
        }

    }

}

#################### 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};

    # Select count of data encrypted with non-current key.
    my $current_key = $self->{systems}->{$system}->{config}->sys_opt('keyversion');
    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 FROM zz_enc_data WHERE keyversion = ? LIMIT 100',
            params => [$okv],
        }
    );

    return $old_data->[0]->{old_key_count} if ( ref($old_data) and scalar( @{$old_data} ) );
}

#################### 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');
    $self->{systems}->{$system}->{config}->sys_opt( 'new_keyversion',  '' );
    $self->{systems}->{$system}->{config}->sys_opt( 'has_key_' . $nkv, '' );

    $self->{new_kek_parts} = '';

    # 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
    my $potential_data = $self->{systems}->{$system}->{db}->run_query(
        {
            string => 'SELECT id, encrypted_data, keyversion FROM zz_enc_data 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} )
        {

            # Attempt decryption
            eval {
                if ( $data eq $self->{systems}->{$system}->{'decrsa'}->{ $potential->{keyversion} }
                    ->decrypt( decode_base64( $potential->{encrypted_data} ) ) )
                {
                    $id = $potential->{id};
                    last;
                }
                1;
              }
              or do
            {
                Zymonic::Exception::Decryptor::Server::DecryptFailed->throw(
                    error        => $@,
                    encrypted_id => $potential->{id},
                );
            };
        }
    }

    return $id;

}

#################### 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 = $self->{systems}->{$system}->{ 'kek_part_' . $part }->{$nkv} ? 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 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 postfork

 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;
    }
}

1;