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

    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::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);
use IO::Socket::SSL;
use Net::hostent;
use Crypt::OpenSSL::RSA;
use MIME::Base64;

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} = Zymonic::Table->new(
        parent => $self,
        zname  => 'zz_enc_data',
        ident  => '',
        config => $self->{config},
        DB     => ( $self->{config}->{encrypted_data_store} and $self->{config}->{encrypted_data_store} eq 'decryptor' )
        ? $self->{decryptor_db}
        : $self->{db},
    );

}

#################### 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->{decryptor_db}->run_statement(
        {
            string => 'INSERT INTO zz_mks (data, timeout) VALUES (?, ?)',
            params => [ $info, time() + $timeout ],
        }
    );

    my $lid = $self->{decryptor_db}->run_query(
        {
            string => 'SELECT last_insert_id() AS lid',
            params => [],
        }
    );

    return $lid->[0]->{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
 Comment   : 

See Also   : 

=cut

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

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

    my $ret = {};

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

    if ( $decryptors eq 'all' )
    {
        my @decryptors = $self->get_decryptors( 0, $no_key, $hosts );
        Zymonic::Exception::Decryptor::Client::NoDecryptor->throw() unless scalar(@decryptors);

        foreach my $decryptor (@decryptors)
        {
            $ret = $self->send( $decryptor, $message );

        }

    }
    else
    {
        my $decryptor = $self->get_decryptors( 0, $no_key, $hosts, $decryptors );

        Zymonic::Exception::Decryptor::Client::NoDecryptor->throw() unless $decryptor;

        $ret = $self->send( $decryptor, $message );

    }

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

    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 $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
    return $self->unpack_and_thaw($sock);

}

#################### 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
    $db->run_statement(
        {
            string => 'INSERT INTO zz_enc_data (encrypted_data, keyversion '
              . ( ( scalar( keys( %{$extras} ) ) > 0 ) ? ', ' . join( ', ', keys( %{$extras} ) ) : '' )
              . ') VALUES ( ?, ? '
              . ( ( scalar( keys( %{$extras} ) ) > 0 ) ? ', ' . join( ', ', map { '?' } keys( %{$extras} ) ) : '' )
              . ')',
            params => [ $encrypted, $self->{keyversion}, values( %{$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} };
}

1;