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

=head1 NAME

  Zymonic::Decryptor - Zymonic Decryptor base module.

=head1 SYNOPSIS

 TODO

=head1 DESCRIPTION

 TODO

=head1 USAGE

 System options
 
 decryptor_db - decryptor database name
 decryptor_dbusername - username for decryptor database name
 decryptor_dbpassword - password for decryptor database name
 encrypted_data_store - where to store encrypted data (self or decryptor)
 keydir - The directory containing the public key.
 
=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::Client;

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 Zymonic::Utils qw(zymonic_log rethrow_exception debug_function_start debug_function_stop debug);
use Zymonic::Table;

use Crypt::OpenSSL::RSA;
use Data::Dumper;
use IO::Socket::SSL;
use MIME::Base64;

use Zymonic;
use Exception::Class (
    'Zymonic::Exception::Decryptor' => {
        isa         => 'Zymonic::Exception',
        fields      => ['decryptor'],
        description => 'Decryptor related exception'
    },
    'Zymonic::Exception::Decryptor::Client' => {
        isa         => 'Zymonic::Exception::Decryptor',
        fields      => [],
        description => 'Decryptor Client related exception'
    },
    'Zymonic::Exception::Decryptor::Client::MissingDB' => {
        isa         => 'Zymonic::Exception::Decryptor::Client',
        fields      => [],
        description => 'Decryptor Client requires DB'
    },
    'Zymonic::Exception::Decryptor::Client::NoDecryptor' => {
        isa         => 'Zymonic::Exception::Decryptor::Client',
        fields      => [],
        description => 'Failed to get a decryptor connection.'
    },
    'Zymonic::Exception::Decryptor::Client::ConnectFailed' => {
        isa         => 'Zymonic::Exception::Decryptor::Client',
        fields      => ['decryptor'],
        description => 'Failed to connect to reserved decryptor.'
    },
    'Zymonic::Exception::Decryptor::Client::Timeout' => {
        isa         => 'Zymonic::Exception::Decryptor::Client',
        fields      => [ 'decryptor', 'timeout' ],
        description => 'Connection to decryptor timed out after [[timeout]]s.'
    },
    'Zymonic::Exception::Decryptor::Client::InvalidResponse' => {
        isa         => 'Zymonic::Exception::Decryptor::Client',
        fields      => [ 'response', 'decryptor' ],
        description => 'Invalid Decryptor Response - [[response]]'
    },
    'Zymonic::Exception::Decryptor::Client::ErrorResponse' => {
        isa         => 'Zymonic::Exception::Decryptor::Client',
        fields      => [ 'response', 'decryptor' ],
        description => 'Invalid Decryptor Response - [[response]]'
    },
);

use Net::hostent;

our $timeout = 180;

#################### 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   : Currently DB type 

See Also   : Zymonic::Decryptor::new

=cut

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

sub init
{
    my $self = shift;

    $self->SUPER::init;

    # Load the decryptor DB
    if ( $self->{config}->{decryptor_db} )
    {
        $self->{decryptor_db} = Zymonic::DB->new(
            parent        => $self,
            driver_string => $self->{config}->{decryptor_db},
            config        => $self->{config},
            dbusername    => $self->{config}->{decryptor_dbusername},
            dbpassword    => $self->{config}->{decryptor_dbpassword},
        );
    }
    else
    {
        $self->{decryptor_db} = $self->{db};
    }

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

    # load enc data table object
    # Load the decryptor log table
    $self->{ed_table} = $self->get_table(
        'zz_enc_data',
        {
            ident => '',
            DB => ( $self->{config}->{encrypted_data_store} and $self->{config}->{encrypted_data_store} eq 'decryptor' )
            ? $self->{decryptor_db}
            : $self->{db},
        }
    );

    $self->{dead_servers} = [];

    $self->{timeout} = $self->{config}->{decryptor_connection_timeout} || 60;
}

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

=head2 store_in_mem

 Usage     :  my $key = $zd->store_in_mem($secret_information)
 Purpose   : This stores some information in a 'memory table'.
 Returns   : nothing
 Argument  : nothing
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub store_in_mem
{
    my $self = shift;
    my $info = shift;

    $self->{mks_table} = $self->get_table( 'zz_mks', { DB => $self->{decryptor_db}, } )
      unless ref( $self->{mks_table} );
    $self->{mks_table}->insert(
        {
            data    => { value => $info },
            timeout => { value => time() + $timeout },
        }
    );

    my $lid = $self->{decryptor_db}->last_insert_id( $self->{mks_table} );

    return $lid;
}

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

=head2 call_decryptor

 Usage     :  my $key = $zd->call_decryptor($message, 
                                            'all decryptors', 
                                            'no key');
 Purpose   : This sends a message via the decryptor.
 Returns   : the response from the decryptor
 Argument  : the message to send via the decryptor
 an 'decryptors' parameter, all or a port number.
 a  'no key' flag
 a hostname list (array ref) - can include % as wildcard.
 Throws    : Zymonic::Exception::Decryptor::Client::NoDecryptor
 Zymonic::Exception::Decryptor::Client::InvalidResponse
 Comment   : 

See Also   : 

=cut

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

sub call_decryptor
{
    my $self       = shift;
    my $message    = shift;
    my $ports      = shift || '';
    my $no_key     = shift || '';
    my $hosts      = shift || [];
    my $sdecryptor = shift || '';

    my $ret = {};

    debug_function_start($self);

    # Add the system name to the message
    $message->{system} = $self->{config}->{system_name}
      unless ( $self->{config}->{encrypted_data_store} and $self->{config}->{encrypted_data_store} eq 'decryptor' );

    my $retry              = '';
    my @decryptors_to_call = ();
    if ( ref($sdecryptor) )
    {
        @decryptors_to_call = ($sdecryptor);
    }
    elsif ( $ports eq 'all' )
    {
        my @decryptors = $self->get_decryptors( 0, $no_key, $hosts );
        Zymonic::Exception::Decryptor::Client::NoDecryptor->throw() unless scalar(@decryptors);
        @decryptors_to_call = @decryptors;
    }
    else
    {
        my $decryptor = $self->get_decryptors( 0, $no_key, $hosts, $ports );
        Zymonic::Exception::Decryptor::Client::NoDecryptor->throw() unless $decryptor;
        @decryptors_to_call = ($decryptor);
        $retry              = 'true';
    }

    my $last_decryptor;
    foreach my $decryptor (@decryptors_to_call)
    {
        $last_decryptor = $decryptor;
        eval {
            $ret = $self->send( $decryptor, $message );
            1;
        } or do
        {
            my $exception = $@;
            if ($exception)
            {
                if ( ref($exception) && $exception->isa('Zymonic::Exception::Decryptor::Client::ConnectFailed') )
                {

                    # attempt cleanup
                    push( @{ $self->{dead_servers} }, $decryptor->{id} );
                    my $response = $self->call_decryptor( { messagetype => 'CleanUp', remove_dead => 'true' } );

                    # make sure we cleaned up this decryptor
                    if (   ref($response) eq 'HASH'
                        && ref( $response->{dead_servers} ) eq 'ARRAY'
                        && grep { $_->{id} eq $decryptor->{id} } @{ $response->{dead_servers} } )
                    {

                        # try again if we need to on a different decryptor
                        if ($retry)
                        {
                            debug_function_stop($self);
                            return $self->call_decryptor( $message, $ports, $no_key, $hosts );
                        }
                    }
                    else
                    {

                        # we didn't clean up this decryptor, so its some other problem, rethrow exception
                        rethrow_exception($exception);
                    }
                }
                else
                {
                    rethrow_exception($exception);
                }
            }

        };
    }

    # check if response is valid
    Zymonic::Exception::Decryptor::Client::InvalidResponse->throw(
        response  => Dumper($ret),
        decryptor => $last_decryptor
    ) unless ref($ret) eq 'HASH' && keys %{$ret} > 0;

    Zymonic::Exception::Decryptor::Client::ErrorResponse->throw(
        response  => $ret->{DSO_error},
        decryptor => $last_decryptor
    ) if $ret->{DSO_error};

    debug_function_stop($self);
    return $ret;
}

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

=head2 get_decryptors

 Usage     :  my $decryptor = $self->get_decryptors(1,'',[]);
 Purpose   : This returns the next available decryptor.
 Returns   : a hashref containing details of the decryptor.
 Argument  : how many decryptors to get (0 for all),
 get decryptors without a key flag,
 hosts to get decryptors on (array ref) - empty for all hosts.
 decryptor_port - empty for least busy.
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub get_decryptors
{
    my $self   = shift;
    my $count  = shift || 0;
    my $no_key = shift || '';
    my $hosts  = shift || [];
    my $port   = shift || '';

    my @clauses       = ();
    my @clause_params = ();

    unless ($no_key)
    {
        push( @clauses, "has_key = 'Y'" );
    }

    if ( ( ref($hosts) eq 'ARRAY' ) and ( scalar( @{$hosts} ) > 0 ) )
    {
        push( @clauses, "hostname IN(" . join( ",", map { "?" } @{$hosts} ) . ")" );
        push( @clause_params, @{$hosts} );
    }

    if ($port)
    {
        push( @clauses,       "port = ?" );
        push( @clause_params, $port );
    }

    if ( ref( $self->{dead_servers} ) eq 'ARRAY' && @{ $self->{dead_servers} } > 0 )
    {
        push( @clauses, 'id NOT IN (' . join( ', ', map { '?' } @{ $self->{dead_servers} } ) . ')' );
        push( @clause_params, @{ $self->{dead_servers} } );
    }

    my $decryptors = $self->{decryptor_db}->run_query(
        {
            string => 'SELECT '
              . $self->{zz_decryptor_fields}
              . ' FROM zz_decryptors '
              . (
                scalar(@clauses)
                ? 'WHERE (' . join( " ) AND ( ", @clauses ) . ")"
                : ''
              )
              . ' ORDER BY in_use ASC '
              . ( $count ? 'LIMIT ' . $count : '' ),
            params => [@clause_params],
        }
    );

    return ( ref($decryptors) eq 'ARRAY' and scalar( @{$decryptors} ) > 0 )
      ? ( wantarray ? @{$decryptors} : $decryptors->[0] )
      : '';

}

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

=head2 send

 Usage     :  my $res = $self->send($decryptor, $message)
 Purpose   : This stores some information in a 'memory table'.
 Returns   : the response from the decryptor
 Argument  : a hashref of decryptor information
 a hashref of information to send
 Throws    : nothing
 Comment   : Notice that we force array on XML Simple
 and then convert any non-array elements back. This
 worked around a number of inconsistencies that occurred
 when converting back and forth.

See Also   : 

=cut

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

sub send
{
    my $self      = shift;
    my $decryptor = shift;
    my $message   = shift;

    my $response;

    debug( "Sending to decryptor : " . $decryptor->{hostname} . ":" . $decryptor->{port}, 'error' );

    # do the socket send and read in an eval so we can time it out with signals/alarams
    eval {

        # set the alarm to go off in $self->{timeout} seconds and throw exception
        local $SIG{ALRM} = sub {
            Zymonic::Exception::Decryptor::Client::Timeout->throw(
                decryptor => $decryptor,
                timeout   => $self->{timeout},
            );
        };
        alarm $self->{timeout};

        # connect to the socket
        my $sock = IO::Socket::SSL->new(
            PeerAddr        => $decryptor->{hostname},
            PeerPort        => $decryptor->{port},
            Proto           => 'tcp',
            SSL_use_cert    => 0,
            SSL_verify_mode => 0x00,
        );
        Zymonic::Exception::Decryptor::Client::ConnectFailed->throw(
            error     => 'Couldn\'t connect to Decryptor: ' . &IO::Socket::SSL::errstr,
            decryptor => $decryptor,
        ) unless $sock;

        # Log
        zymonic_log( $self->{config}, $self->{auth},
            'Connected to Decryptor - message type: ' . ( $message->{messagetype} || '' ),
            'Decryptor', 'yes', 'information' );

        # Send the data
        print $sock $self->freeze_and_pack($message);

        # Read the response
        $response = $self->unpack_and_thaw($sock);

        # stop the alarm
        alarm 0;
    } or do
    {
        my $exception = $@;
        rethrow_exception($exception);
    };

    # stop the alarm (in case not done in the eval)
    alarm 0;

    return $response;

}

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

=head2 encrypt_card_number

 Usage     :  my $result = $self->encrypt_card_number($card_number, 
                                        $attempt_find, 
                                        $extras,
                                        $extra_keys);
 Purpose   : Encrypts a card number.
 Returns   : a hashref with a reference number (encrypted_ref)
 and a masked card number (first 6 digits + last 4) 
 Argument  : a card number, a flag indicating whether an 
 attempt should be made to find the card number in the DB,
 any extra fields to store against the card number and
 any extra keys to use when finding the ID.
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub encrypt_card_number
{
    my $self         = shift;
    my $card_number  = shift;
    my $attempt_find = shift || 0;
    my $extras       = shift || {};
    my $extra_keys   = shift || {};

    my $result = {};

    # Strip spaces
    $card_number =~ s/\s*//g;

    if ( $attempt_find and !$result->{encrypted_ref} )
    {

        # Add the masked card number to extras
        $extra_keys->{masked_card_number} =
          substr( $card_number, 0, 6 ) . ( "X" x ( length($card_number) - 10 ) ) . substr( $card_number, -4 );

        # Send an a find id request to the server
        $result = $self->call_decryptor(
            {
                messagetype => 'FindId',
                extra_keys  => $extra_keys,
                data        => $card_number,
            }
        );
    }

    unless ( $result->{encrypted_ref} )
    {

        # Add the masked card number to extras
        $extras->{masked_card_number} =
          substr( $card_number, 0, 6 ) . ( "X" x ( length($card_number) - 10 ) ) . substr( $card_number, -4 );

        # Encrypt it...
        $result = $self->encrypt( $card_number, $extras );
    }

    return $result;
}

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

=head2 encrypt

 Usage     :  my $result = $self->encrypt($data, $extras);
 Purpose   : Encrypts and stores data
 Returns   : a hashref with a reference number (encrypted_ref)
 and the extras.
 Argument  : a string to encrypt
 any extra fields to store against the card number
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub encrypt
{
    my $self   = shift;
    my $data   = shift;
    my $extras = shift;

    my $db =
      ( $self->{config}->{encrypted_data_store} and $self->{config}->{encrypted_data_store} eq 'decryptor' )
      ? $self->{decryptor_db}
      : $self->{db};

    # encrypt the data
    my $encrypted = encode_base64( $self->encrsa($db)->encrypt($data) );

    # store in the DB
    $self->{ed_table}->insert(
        {
            encrypted_data => { value => $encrypted },
            keyversion     => { value => $self->{keyversion} },
            map { $_ => { value => $extras->{$_} } } keys %{$extras}
        }
    );
    return {
        encrypted_ref => $db->last_insert_id( $self->{ed_table} ),
        %{$extras},
    };
}

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

=head2 encrsa

 Usage     :  my $encrypted = $self->encrsa()->encrypt($data);
 Purpose   : Returns an RSA encryption object with the current
 key.
 Returns   : a n RSA encryption object
 Argument  : DB object where data is to be stored.
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub encrsa
{
    my $self = shift;
    my $db   = shift;

    my $keyversion_rec = $db->run_query(
        {
            string => 'SELECT option_value FROM zz_system_options WHERE option_name = \'keyversion\'',
            params => [],
        }
    );

    $self->{keyversion} = $keyversion_rec->[0]->{option_value};

    unless ( ref( $self->{ 'encrsa' . $self->{keyversion} } ) )
    {

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

        # Load the encryptor
        $self->{ 'encrsa' . $self->{keyversion} } = Crypt::OpenSSL::RSA->new_public_key($public_key);
        $self->{ 'encrsa' . $self->{keyversion} }->use_pkcs1_oaep_padding();
    }
    return $self->{ 'encrsa' . $self->{keyversion} };
}

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

=head2 remove_encrypted_data

 Usage     : my $result = $self->remove_encrypted_data($encrypted_ref, $extras);
 Purpose   : Securly removes encrypted data from the decryptor
 Returns   : nothing
 Argument  : a string reference to the encrypted data
 any extra fields to lookup the data using
 Throws    : Zymonic::Exception::Decryptor::Client
 Comment   : 

See Also   : 

=cut

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

sub remove_encrypted_data
{
    my $self          = shift;
    my $encrypted_ref = shift;
    my $extras        = shift || {};

    my $db = (
        ( $self->{config}->{encrypted_data_store} && $self->{config}->{encrypted_data_store} eq 'decryptor' )
        ? $self->{decryptor_db}
        : $self->{db}
    );

    # secure delete the data
    $db->secure_delete(
        'zz_enc_data',
        [ 'zz_df_encrypted_data', 'zz_df_masked_number' ],
        {
            clause => 'id = ?'
              . ( keys %{$extras} > 0 ? ' AND ' . join( ' AND ', map { $_ . ' = ?' } keys %{$extras} ) : '' ),
            params => [ $encrypted_ref, ( keys %{$extras} > 0 ? values %{$extras} : () ) ]
        }
    );
}

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

=head2 clear_encrypted_data_fields

 Usage     : $self->clear_encrypted_data_fields($fields, $where);
 Purpose   : Clears the fields with the given where clause.
 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 clear_encrypted_data_fields
{
    my $self   = shift;
    my $fields = shift;
    my $where  = shift;

    # log it
    $self->connection_log( 'Clearing encrypted data fields ('
          . join( ', ', @{$fields} )
          . ") where '$where->{clause}' (PARAMS: "
          . join( ', ', @{ $where->{params} } )
          . ')' );

    my $db = (
        ( $self->{config}->{encrypted_data_store} && $self->{config}->{encrypted_data_store} eq 'decryptor' )
        ? $self->{decryptor_db}
        : $self->{db}
    );

    # secure delete the data
    debug( "Clearing decryptor encrypted data fields: " . Dumper($fields) );
    $db->secure_delete( 'zz_enc_data', $fields, $where, 'no_delete' );
}

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

=head2 connection_log

 Usage     :  $zdc->connection_log('log message')
 Purpose   : Adds information to the log from this client, 
 i.e. it will have no server informatio in it.
 Returns   : nothing
 Argument  : a message
 Throws    : nothing
 Comment   : 

See Also   : 

=cut

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

sub connection_log
{
    my $self    = shift;
    my $message = shift;

    return unless $message;

    $self->{log_table} = $self->get_table(
        'zz_decryptor_log',
        {
            ident => '',
            DB    => $self->{config}->{DB},
        }
    ) unless $self->{log_table};

    $self->{log_table}->insert(
        {
            start_time => { value => $self->{db}->timestamp_function(), direct_sql => 'true' },
            misc_info  => { value => $message }
        }
    );
}

1;