## OpenXPKI::Crypto::Backend::OpenSSL::Engine
## Copyright (C) 2003-2005 Michael Bell

use strict;
use warnings;

package OpenXPKI::Crypto::Backend::OpenSSL::Engine;

use File::Basename;
use OpenXPKI::FileUtils;
use OpenXPKI::Debug;
use OpenXPKI::Exception;
use English;
use OpenXPKI::Server::Context qw( CTX );


sub new {
    my $that = shift;
    my $class = ref($that) || $that;

    my $self = {};

    my $keys = { @_ };

    bless ($self, $class);
    ##! 2: "new: class instantiated"

    ## token mode will be ignored
    foreach my $key (qw{OPENSSL
                        NAME
                        KEY
                        PASSWD
                        SECRET
                        CERT
                        INTERNAL_CHAIN
                        ENGINE_SECTION
                        ENGINE_USAGE
                        KEY_STORE
                        TMP
			            WRAPPER
                       }) {

    if (exists $keys->{$key}) {
        ##! 128: 'setting key ' . $key . ' to value ' . Dumper $keys->{$key}
        $self->{$key} = $keys->{$key};
        }
    }

    # use this instance ONLY for files that need to stay alive for the
    # lifetime of the instance of this token
    $self->{FU} = OpenXPKI::FileUtils->new({ TMP => $self->{TMP} });

    $self->__set_engine_params( $keys );
    $self->__check_engine_usage();
    $self->__check_key_store();

    return $self;
}

sub __set_engine_params {
    # set special engine parameters in child classes
    my $self = shift;
    my $keys = shift;
    return 1;
}

sub __check_engine_usage {
    my $self = shift;
    my @engine_usage_parts = split (m{\|}, $self->{ENGINE_USAGE});

    # if ENGINE_USAGE is defined
    if ($#{engine_usage_parts} >= 0) {
        foreach my $part(@engine_usage_parts) {
            if ($part !~ m{( \A ALWAYS \z )|( \A NEVER \z )|( \A NEW_ALG \z )|( \A PRIV_KEY_OPS \z )|( \A RANDOM \z ) }xms) {
                OpenXPKI::Exception->throw (
                    message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_WRONG_ENGINE_USAGE",
                    params  => { "ATTRIBUTE" => $part},
                    );
            }
            # if NEVER is not the only one value
            if (($part =~ m{ \A NEVER \z }xms) and
                ($#{engine_usage_parts} >= 1)) {
                OpenXPKI::Exception->throw (
                    message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_WRONG_NEVER_ENGINE_USAGE" );
            } # if NEVER is not the only one value
        } # foreach $part
    } # if ENGINE_USAGE is defined

    return 1;
}

sub __check_key_store {
    my $self = shift;
    if ($self->{KEY_STORE} !~ m{\A ( ENGINE|OPENXPKI|DATAPOOL) \z}xms) {
        OpenXPKI::Exception->throw (
            message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_WRONG_KEY_STORE",
            params  => { "ATTRIBUTE" => $self->{KEY_STORE}},
            );
    }

    return 1;
}

sub login {
    my $self = shift;
    my $keys = shift;

    ## check the supplied parameter
    if (not $self->{SECRET}->is_complete())
    {
        ## enforce passphrases
        OpenXPKI::Exception->throw (
            message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_OPENSSL_LOGIN_INCOMPLETE_SECRET");
    }
    $self->{PASSWD} = $self->{SECRET}->get_secret();
    if (length $self->{PASSWD} < 4)
    {
        ## enforce OpenSSL default passphrase length
        OpenXPKI::Exception->throw (
            message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_OPENSSL_LOGIN_PASSWD_TOO_SHORT");
    }

    ## test the passphrase
    eval
    {
        # looks like this is never used and the password test code is broken!
        #$self->{OPENSSL}->command ({COMMAND => "convert_key", OUTFORM=>"PKCS8"});
    };
    if (my $exc = OpenXPKI::Exception->caught())
    {
        OpenXPKI::Exception->throw (
            message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_OPENSSL_LOGIN_FAILED");
    } elsif ($EVAL_ERROR) {
        OpenXPKI::Exception->throw (
            message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_OPENSSL_LOGIN_FAILED_EVAL_ERROR",
        params => {
        EVAL_ERROR => $EVAL_ERROR,
        },
    );
    }

    $self->{ONLINE} = 1;
    return 1;
}

sub logout {
    my $self = shift;
    delete $self->{PASSWD};
    $self->{ONLINE} = 0;
    return 1;
}

sub online {
    my $self = shift;
    return 1;
}

sub get_engine
{
    return "";
}

sub get_engine_section
{
    my $self = shift;

    if (length ($self->get_engine()) and
        exists $self->{ENGINE_SECTION} and
        length ($self->{ENGINE_SECTION}))
    {
        return $self->{ENGINE_SECTION};
    } else {
        return "";
    }
}

sub get_engine_usage
{
    my $self = shift;

    if (length ($self->get_engine()) and
        exists $self->{ENGINE_USAGE} and
        length ($self->{ENGINE_USAGE}))
    {
        return $self->{ENGINE_USAGE};
    } else {
        return "";
    }
}

sub get_key_info
{
    my $self = shift;
    return {
        'key_name' => $self->{KEY},
        'key_cert' => $self->{CERT},
        'key_engine' => $self->get_engine() || 'none',
        'key_store' => $self->{KEY_STORE},
        'key_secret' => ($self->get_passwd() ? 1 : 0),
        'key_usable' => ($self->key_usable()  ? 1 : 0),
    }
}

sub get_key_store
{
    my $self = shift;
    return $self->{KEY_STORE};
}

sub get_keyfile
{
    my $self = shift;

    if ($self->get_key_store() eq "DATAPOOL") {
        ##! 16: 'Get key from datapool ' . $self->{KEY}
        if (!$self->{'tmp_keyfile'} || ! -e $self->{'tmp_keyfile'}) {
            my $dp = CTX('api2')->get_data_pool_entry(
                namespace => 'sys.crypto.keys',
                key => $self->{KEY},
            );

            if (!$dp || !$dp->{value}) {
                OpenXPKI::Exception->throw (
                    message => "Unable to load key from datapool",
                    params => { KEY => $self->{KEY} }
                );
            }
            my $dir = $self->{FU}->get_tmp_dirhandle();
            $self->{'tmp_keyfile'} = $dir.'/'.$self->{KEY};

            ##! 16: 'Writing keyfile ' . $self->{'tmp_keyfile'}
            $self->{FU}->write_file({
                FILENAME => $self->{'tmp_keyfile'},
                CONTENT => $dp->{value}
            });
        }
        return $self->{'tmp_keyfile'};
    }

    return $self->{KEY};
}

# New method to get internal key object for token layer migration
# to keep it easy we just return undef here if this is not supported
sub get_key_object
{
    return;
}

sub get_passwd
{
    ##! 16: 'start'
    my $self = shift;

    if (defined $self->{SECRET} && $self->{SECRET}->is_complete()) {
    ##! 16: 'secret is_complete: ' . $self->{SECRET}->is_complete()
    return $self->{SECRET}->get_secret();
    }

    return $self->{PASSWD} if (exists $self->{PASSWD});
    OpenXPKI::Exception->throw (
        message => "I18N_OPENXPKI_CRYPTO_OPENSSL_ENGINE_GET_PASSWD_UNDEF");
}

sub get_certfile
{
    my $self = shift;
    if (!$self->{'tmp_certfile'} || ! -e $self->{'tmp_certfile'}) {
        my $cert_filename = $self->{FU}->write_temp_file($self->{CERT});
        $self->{'tmp_certfile'} = $cert_filename;
        ##! 16: 'Writing out certfile ' . $self->{'tmp_certfile'}
    }
    return $self->{'tmp_certfile'};
}

sub get_chainfile
{
    my $self = shift;
    return $self->{INTERNAL_CHAIN};
}

sub get_keyform
{
    ## do not return something with a leading "e"
    ## if you don't use an engine
    return "";
}

sub get_wrapper
{
    my $self = shift;
    if (defined $self->{WRAPPER}){
        return $self->{WRAPPER};
    }
    return '';
}

sub get_engine_params
{
    return "";
}

sub filter_stderr
{
    my $self = shift;
    return $_[0];
}

sub filter_stdout
{
    my $self = shift;
    return $_[0];
}

sub key_usable {
    my $self = shift;

    eval {
        $self->get_passwd();
    };
    if ($EVAL_ERROR) {
        # we could not get the password, so the key is not usable
        return 0;
    }
    return 1;
}

1;
__END__

=head1 Name

OpenXPKI::Crypto::Backend::OpenSSL::Engine

=head1 Description

This class is the base class and the interface of all other engines.
This defines the interface how HSMs are supported by OpenXPKI.

=head1 Functions

=head2 new

The constructor supports the following parameters:

=over

=item * OPENSSL (the OpenSSL binary)

=item * NAME (a symbolic name for the token)

=item * KEY (filename of the key)

=item * PASSWD (sometimes keys are passphrase protected)

=item * CERT (filename of the certificate)

=item * INTERNAL_CHAIN (filename of the certificate chain)

=back

=head2 login

tries to set the passphrase for the used token and checks the passphrase for its
correctness. If the passhrase is missing, shorter than 4 characters or
simply wrong then an exception is thrown. There is no parameters because
we get the passphrase from the OpenXPKI::Crypto::Secret object.

Examples: $engine->login ();

=head2 logout

enforces the logout form the token.

=head2 online

returns true if the token is usable for non-pivate-key
operations.

=head2 key_usable

returns true if the private key is usable.

=head2 get_mode

returns the operational mode of the engine (standby, session or daemon).

=head2 get_engine

returns the used OpenSSL engine or the empty string if no engine
is used.

=head2 get_engine_section

returns the OpenSSL engine section from the configuration or the empty string if no engine
is used or the engine section is empty.

=head2 get_engine_usage

returns the OpenSSL engine_usage section from the configuration or the empty string if no engine
is used or the engine_usage section is empty.

=head2 get_key_store

returns the OpenSSL key_store section from the configuration.

=head2 get_key_info

returns as hash with some information on the key (name, storage, secret avail)

=head2 get_keyfile

returns the name of the private key. In case the key is stored in the
datapool, this returns the name of a tempfile holding the key blob.

=head2 get_passwd

returns the passphrase if one is present.

=head2 get_certfile

returns the filename of the certificate.

=head2 get_chainfile

returns the filename of the internal (CA specific) certificate chain.

=head2 get_keyform

returns "e" or "engine" if the key is stored in an OpenSSL engine.

=head2 get_wrapper

returns the wrapper around the OpenSSL binary if such a
wrapper is used (e.g. nCipher's chil engine). Otherwise the empty string
is returned.

=head2 get_engine_params

returns the parameters for the engine which are needed for the
initialization. This is a simple string.

=head2 filter_stderr

expects a scalar with the complete error log inside. It returns
the error log but without all normal stuff which is generated by
the used engine. The function is used to filter false error
messages from STDERR.

=head2 filter_stdout

expects a scalar with the complete output inside. It returns
the output but without the noise which is generated by
the used engine. The function is used to filter engine specific
messages from STDOUT.

