<commit_before>## OpenXPKI::Server::API::Object.pm
##
## Written 2005 by <NAME> and <NAME> for the OpenXPKI project
## Copyright (C) 2005-2006 by The OpenXPKI Project

=head1 Name

OpenXPKI::Server::API::Object

=head1 Description

This is the object interface which should be used by all user interfaces of OpenXPKI.
A user interface MUST NOT access the server directly. The only allowed
access is via this API. Any function which is not available in this API is
not for public use.
The API gets access to the server via the 'server' context object. This
object must be set before instantiating the API.

=head1 Functions

=cut

package OpenXPKI::Server::API::Object;

use strict;
use warnings;
use utf8;
use English;

use Data::Dumper;

use Class::Std;
use Math::BigInt;
use Crypt::PKCS10 1.8;
use OpenXPKI::Debug;
use OpenXPKI::Exception;
use OpenXPKI::Server::Context qw( CTX );
use OpenXPKI::Crypto::CSR;
use OpenXPKI::Crypto::VolatileVault;
use OpenXPKI::FileUtils;
use OpenXPKI::Server::Watchdog;
use OpenXPKI::Control;
use DateTime;
use List::Util qw(first);

use Digest::SHA qw(sha1_hex);
use MIME::Base64 qw( encode_base64 decode_base64 );

use OpenXPKI::Server::Database::Legacy;

sub START {

    # somebody tried to instantiate us, but we are just an
    # utility class with static methods
    OpenXPKI::Exception->throw( message =>
          'I18N_OPENXPKI_SERVER_API_SUBCLASSES_CAN_NOT_BE_INSTANTIATED', );
}


sub generate_key {
    ##! 1: "start"
    my $self = shift;
    my $args = shift;

    my $pass = $args->{PASSWD}
        or OpenXPKI::Exception->throw( message =>
          'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_REQUIRES_PASSWORD' );

    my $key_alg = lc($args->{KEY_ALG}) || 'rsa';
    my $enc_alg = lc($args->{ENC_ALG});

    my $params = $args->{PARAMS};

    my $token = CTX('api')->get_default_token();

    # prepare command definition
    my $command = {
         COMMAND    => 'create_pkey',
         KEY_ALG    => $key_alg,
         ENC_ALG    => $enc_alg,
         PASSWD     => $pass,
    };

    # Handling of pkeyopts for standard algorithms
    if ($params->{PKEYOPT} and ref $params->{PKEYOPT} eq 'HASH') {
        $command->{PKEYOPT} = $params->{PKEYOPT};
    }
    # RSA
    elsif ($key_alg eq "rsa") {
        my $rsa_bits = ($params->{KEY_LENGTH} and $params->{KEY_LENGTH} =~ m{\A \d+ \z}xs)
            ? $params->{KEY_LENGTH}
            : 2048;
        $command->{PKEYOPT} = { rsa_keygen_bits => $rsa_bits };
    }
    # EC
    elsif ($key_alg eq "ec") {
        # With openssl <=1.0.1 you need to create EC the same way as DSA
        # means params and key in two steps
        # see http://openssl.6102.n7.nabble.com/EC-private-key-generation-problem-td47261.html
        if (!$params->{ECPARAM}) {
            OpenXPKI::Exception->throw(message =>
                'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_EC_REQUIRES_CURVE_NAME')
                unless $params->{CURVE_NAME};

            $params->{ECPARAM} = $token->command({
                COMMAND => 'create_params',
                TYPE    => 'EC',
                PKEYOPT => { ec_paramgen_curve => $params->{CURVE_NAME} }
            });
        }

        OpenXPKI::Exception->throw( message =>
            'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_DSA_UNABLE_TO_GENERATE_EC_PARAM' )
            unless $params->{ECPARAM};

        delete $command->{KEY_ALG};
        $command->{PARAM} = $params->{ECPARAM};
    }
    # DSA
    elsif ($key_alg eq "dsa") {
        if (!$params->{DSAPARAM}) {
            # Generate Parameters
            my $dsa_bits = ($params->{KEY_LENGTH} and $params->{KEY_LENGTH} =~ m{\A \d+ \z}xs)
                ? $params->{KEY_LENGTH}
                : 2048;
            $params->{DSAPARAM} = $token->command({
                COMMAND => 'create_params',
                TYPE    => 'DSA',
                PKEYOPT => { dsa_paramgen_bits => $dsa_bits }
            });
        }

        OpenXPKI::Exception->throw( message =>
            'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_DSA_UNABLE_TO_GENERATE_DSA_PARAM' )
            unless $params->{DSAPARAM};

        delete $command->{KEY_ALG};
        $command->{PARAM} = $params->{DSAPARAM};
    }

    CTX('log')->log(
        MESSAGE  => "Creating private $key_alg key with params " . Dumper $command->{PKEYOPT},
        PRIORITY => 'debug',
        FACILITY => 'application',
    );

    ##! 16: 'command: ' . Dumper $command

    my $key = $token->command( $command );

    return $key;

}

=head2 get_key_identifier_from_data

returns the key identifier (sha1 hash of the public key bit string) of the
given data as string, uppercased hex with colons.

=over

=item DATA

Data, encoded as given by FORMAT parameter.

=item FORMAT

* PKCS10: PEM encoded PKCS10 block

=back

=cut

sub get_key_identifier_from_data {
    ##! 1: "start"
    my ($self, $args) = @_;

    # as we currently only support PKCS10 and the parameter is checked
    # by the API, we dont need any ifs here.

    Crypt::PKCS10->setAPIversion(1);
    my $decoded = Crypt::PKCS10->new($args->{DATA}, ignoreNonBase64 => 1, verifySignature => 0)
        or OpenXPKI::Exception->throw(message => 'Unable to parse data in get_key_identifier_from_data');

    return uc(
        join ':', (
            unpack '(A2)*', sha1_hex(
                $decoded->{certificationRequestInfo}{subjectPKInfo}{subjectPublicKey}[0]
            )
        )
    );
}

=head2 get_csr_info_hash_from_data

return a hash reference which includes all parsed informations from
the CSR. The only accepted parameter is DATA which includes the plain CSR.

=cut

sub get_csr_info_hash_from_data {
    ##! 1: "start"
    my ($self, $args) = @_;

    my $data  = $args->{DATA};
    my $token = CTX('api')->get_default_token();
    my $obj   = OpenXPKI::Crypto::CSR->new( DATA => $data, TOKEN => $token );

    ##! 1: "finished"
    return $obj->get_info_hash();
}

=head2 get_ca_cert

returns the certificate of one CA. This is a wrapper around get_cert to make
the access control more fine granular if necessary.

=cut

sub get_ca_cert {
    ##! 1: "start, forward and finish"
    my ($self, $args) = @_;
    return $self->get_cert($args);
}


=head2 get_cert

returns the requested certificate. The supported arguments are IDENTIFIER and
FORMAT. IDENTIFIER is required whilst FORMAT is optional. FORMAT can have the
following values:

=over

=item * PEM

=item * DER

=item * TXT

=item * HASH - the default value

=item * DBINFO - information from the certificate and attributes table

=back

=cut

# Test: qatest/backend/nice/10_nice_signing_request.t
sub get_cert {
    ##! 1: "start"
    my ($self, $args) = @_;
    my $dbi = CTX('dbi');

    my $identifier = $args->{IDENTIFIER};
    my $format     = $args->{FORMAT} // "HASH";
    ##! 2: "Requested output format: $format"

    ##! 2: "Fetching certificate from database"
    $dbi->commit;
    my $cert = $dbi->select_one(
        columns => [ '*' ],
        from => 'certificate',
        where => { 'identifier' => $identifier },
    )
        or OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CERT_CERTIFICATE_NOT_FOUND_IN_DB',
            params => { 'IDENTIFIER' => $identifier, },
        );

    #
    # Format: "DBINFO"
    #
    if ( $format eq 'DBINFO' ) {
        ##! 2: "Preparing output for DBINFO format"
        delete $cert->{data};
        my $extended_info = {};

        # Hex Serial
        my $serial = Math::BigInt->new($cert->{cert_key});
        $extended_info->{cert_key_hex} = $serial->as_hex;
        $extended_info->{cert_key_hex} =~ s{\A 0x}{}xms;

        # Expired Status
        $cert->{status} = 'EXPIRED' if $cert->{status} eq 'ISSUED' and $cert->{notafter} < time();

        # Fetch certificate attributes
        $extended_info->{cert_attributes} = {};
        my $cert_attr = $dbi->select(
            columns => [ qw(
                attribute_contentkey
                attribute_value
            ) ],
            from => 'certificate_attributes',
            where => { identifier => $identifier },
        );
        while (my $attr = $cert_attr->fetchrow_hashref) {
            my $key = $attr->{attribute_contentkey};
            my $val = $attr->{attribute_value};
            $extended_info->{cert_attributes}->{$key} //= [];
            push @{$extended_info->{cert_attributes}->{$key}}, $val;
        }

        # TODO #legacydb Mapping for compatibility to old DB layer
        return {
            %{ OpenXPKI::Server::Database::Legacy->certificate_to_legacy($cert) },
            'CERT_ATTRIBUTES'        => $extended_info->{cert_attributes},
            'CERTIFICATE_SERIAL_HEX' => $extended_info->{cert_key_hex},
        };
    }

    ##! 2: "Requesting crypto token via API and creating X509 object"
    my $token = CTX('api')->get_default_token();
    my $obj   = OpenXPKI::Crypto::X509->new(
        TOKEN => $token,
        DATA  => $cert->{data},
    );

    #
    # Format: "HASH"
    #
    if ( $format eq 'HASH' ) {
        ##! 2: "Preparing output for HASH format"
        my $result = $obj->get_parsed_ref;

        # NOTBEFORE and NOTAFTER are DateTime objects, which we do
        # not want to be serialized, so we just send out the stringified
        # version ...
        $result->{BODY}->{NOTBEFORE} = $result->{BODY}->{NOTBEFORE}->epoch();
        $result->{BODY}->{NOTAFTER}  = $result->{BODY}->{NOTAFTER}->epoch();
        $result->{STATUS}            = $cert->{status};
        $result->{IDENTIFIER}        = $cert->{identifier};
        $result->{ISSUER_IDENTIFIER} = $cert->{issuer_identifier};
        $result->{CSR_SERIAL}        = $cert->{req_key};
        $result->{PKI_REALM}         = $cert->{pki_realm};
        return $result;
    }

    #
    # Format: "PEM", "DER", "TXT"
    #
    ##! 2: "Converting X509 object into target format"
    return $obj->get_converted($format);
}


=head2 get_cert_attributes

returns a hash with the attributes of the certificate. Requires the
IDENTIFIER of the certificate.

=cut

sub get_cert_attributes {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 2: "initialize arguments"
    my $identifier = $args->{IDENTIFIER};

    my $query = { identifier => $identifier };

    if ($args->{ATTRIBUTE}) {
        $query->{attribute_contentkey} = { -like => $args->{ATTRIBUTE} };
    }

    my $sth_attrib = CTX('dbi')->select(
        from => 'certificate_attributes',
        columns => [ 'attribute_contentkey', 'attribute_value' ],
        where => $query
    );

    my $attrib;
    while (my $item = $sth_attrib->fetchrow_hashref) {
        my $key = $item->{attribute_contentkey};
        my $val = $item->{attribute_value};
        if (!defined($attrib->{$key})) {
            $attrib->{$key} = [];
        }
        push @{$attrib->{$key}}, $val;
    }

    return $attrib;
}

=head2 get_profile_for_cert

returns the name of the profile used during the certificate request.
Supported argument is IDENTIFIER which is required.

=cut

sub get_profile_for_cert {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 2: "initialize arguments"
    my $identifier = $args->{IDENTIFIER};

    my $result = CTX('dbi')->select_one(
        from_join => 'certificate req_key=req_key csr',
        columns => [ 'csr.profile' ],
        where => { 'certificate.identifier' => $identifier },
    )
        or OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_PROFILE_FOR_CERT_CERTIFICATE_NOT_FOUND_IN_DB',
            params => { 'IDENTIFIER' => $identifier },
        );

    return $result->{'profile'};

}

=head2 get_cert_actions

Requires a certificate identifier (IDENTIFIER) and optional ROLE.
Returns a list of actions that the given role (defaults to current
session role) can do with the given certificate. The return value is a
nested hash with options available for lifecyle actions. The list of
workflows is hardcoded for now, workflows which are not present or not
accessible by the current user are remove from the result.

    {
        workflow => [
            { label => I18N_OPENXPKI_UI_CERT_ACTION_REVOKE, workflow => certificate_revocation_request_v2 },
            { label => I18N_OPENXPKI_UI_CERT_ACTION_RENEW, workflow => certificate_renewal_request_v2 },
            { label => I18N_OPENXPKI_UI_CERT_ACTION_RENEW, workflow => certificate_renewal_request_v2 }
        ]
    }

=cut

sub get_cert_actions {
    ##! 1: "start"
    my ($self, $args) = @_;

    my $role    = $args->{ROLE} || CTX('session')->get_role();
    my $cert_id = $args->{IDENTIFIER};
    my $cert    = CTX('api')->get_cert({ IDENTIFIER => $cert_id, FORMAT => 'DBINFO' });
    ##! 2: "cert $cert_id, role $role"

    # check if this is a entity certificate from the current realm
    return {} unless $cert->{CSR_SERIAL} and $cert->{PKI_REALM} eq CTX('session')->get_pki_realm();

    my $conn = CTX('config');

    my @actions;
    push @actions, { label => 'I18N_OPENXPKI_UI_DOWNLOAD_PRIVATE_KEY', workflow => 'certificate_privkey_export' }
        if CTX('api')->private_key_exists_for_cert({ IDENTIFIER => $cert_id })
        and $conn->exists([ 'workflow', 'def', 'certificate_privkey_export', 'acl', $role, 'creator' ] );

    push @actions, { label => 'I18N_OPENXPKI_UI_CERT_ACTION_RENEW', workflow => 'certificate_renewal_request' }
        if ($cert->{STATUS} eq 'ISSUED' or $cert->{STATUS} eq 'EXPIRED')
        and $conn->exists([ 'workflow', 'def', 'certificate_renewal_request', 'acl', $role, 'creator' ] );

    push @actions, { label => 'I18N_OPENXPKI_UI_CERT_ACTION_REVOKE', workflow => 'certificate_revocation_request_v2' }
        if $cert->{STATUS} eq 'ISSUED'
        and $conn->exists([ 'workflow', 'def', 'certificate_revocation_request_v2', 'acl', $role, 'creator' ]);

    push @actions, { label => 'I18N_OPENXPKI_UI_CERT_ACTION_UPDATE_METADATA', workflow => 'change_metadata' }
        if $conn->exists([ 'workflow', 'def', 'change_metadata', 'acl', $role, 'creator' ] );

    return { workflow => \@actions };
}


=head2 is_certificate_owner

Requires a certificate identifier (IDENTIFIER) and user (USER). User is
optional and will default to the session user if not given. Checks if
USER is the owner of the certificate, based on the formerly recorded meta
information.

Returns true if the user is the owner, false if not and undef if the
ownership could not be determined.

=cut

sub is_certificate_owner {
    ##! 1: "start"
    my ($self, $args) = @_;

    my $user = $args->{USER} || CTX('session')->get_user();
    my $cert_id = $args->{IDENTIFIER};

    my $result = CTX('dbi')->select_one(
        from => 'certificate_attributes',
        columns => [ 'attribute_value' ],
        where => {
            identifier => $cert_id,
            attribute_contentkey => 'system_cert_owner',
        },
    );

    return undef unless $result;

    ##! 16: "compare $user ?= " . $result->{attribute_value}
    return ($result->{attribute_value} eq $user);
}

=head2 get_crl

returns a CRL. The possible parameters are CRL_KEY, FORMAT and PKI_REALM.
CRL_KEY is the serial of the database table, the realm defaults to the
current realm and the default format is PEM. Other formats are DER, TXT
HASH, FULLHASH or DBINFO. DBINFO returns the fields directly from the
database without parsing the CRL. HASH returns the result of
OpenXPKI::Crypto::CRL::get_parsed_ref, FULLHASH also adds the list of
revocation entries (this might become a very expensive task if your CRL
is large!).

If no serial is given, the most current CRL of the active signer token is
returned.

=cut

sub get_crl {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 2: "initialize arguments"
    my $serial    = $args->{SERIAL}; # deprecates, use crl_key instead!
    my $crl_key    = $args->{CRL_KEY};
    my $pki_realm = $args->{PKI_REALM};
    my $format   = "PEM";

    $format = $args->{FORMAT} if exists $args->{FORMAT};
    $pki_realm =  CTX('session')->get_pki_realm() unless $args->{PKI_REALM};

    my $db_results;

    my $columns = ($format eq 'DBINFO') ?
        [ 'pki_realm', 'last_update', 'next_update', 'crl_key', 'publication_date', 'issuer_identifier' ] :
        [ 'pki_realm', 'data','crl_key' ];

    if ($serial) {
        $crl_key = $serial;

        CTX('log')->log(
            MESSAGE  => "Call to get_crl using deprecated parameter 'serial', please use 'crl_key'!",
            PRIORITY => 'warn',
            FACILITY => 'application',
        );
    }

    if ($crl_key) {
        ##! 16: 'Load crl by serial ' . $serial
        $db_results = CTX('dbi')->select_one(
            from => 'crl',
            columns => $columns,
            where => {
                'crl_key' => $crl_key,
            },
        );

    } else {

        my $ca_alias = CTX('api')->get_token_alias_by_type({ TYPE => 'certsign' });
        ##! 16: 'Load crl by date, ca alias ' . $ca_alias
        my $ca_hash = CTX('api')->get_certificate_for_alias({ ALIAS => $ca_alias });

        $db_results = CTX('dbi')->select_one(
            from => 'crl',
            columns => $columns,
            where => {
                issuer_identifier => $ca_hash->{IDENTIFIER}
            },
            order_by => '-last_update'
        );
    }

    ##! 32: 'DB Result ' . Dumper $db_results

    if ( not $db_results ) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_NOT_FOUND', );
    }

    if ($pki_realm ne $db_results->{pki_realm}) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_NOT_IN_REALM', );
    }

    # Is this really useful ?
    #OpenXPKI::Exception->throw( message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_NOT_PUBLIC' );

    my $pem_crl = $db_results->{data};

    my $output;
    if ($format eq 'DBINFO') {
        $output = $db_results;
    }
    elsif ( $format eq 'DER' or $format eq 'TXT' ) {
        # convert the CRL
        my $default_token = CTX('api')->get_default_token();
        $output = $default_token->command({
            COMMAND => 'convert_crl',
            OUT     => $format,
            IN      => 'PEM',
            DATA    => $pem_crl,
        });
        if (!$output) {
            OpenXPKI::Exception->throw(
                message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_UNABLE_TO_CONVERT',
            );
        }
    }
    elsif ( $format eq 'HASH' or $format eq 'FULLHASH' ) {
        # parse CRL using OpenXPKI::Crypto::CRL
        my $default_token = CTX('api')->get_default_token();
        my $crl_obj = OpenXPKI::Crypto::CRL->new(
            TOKEN => $default_token,
            DATA  => $pem_crl,
            REVOKED => ($format eq 'FULLHASH') ,
        );
        $output = $crl_obj->get_parsed_ref();
        $output->{ISSUER_IDENTIFIER} = $db_results->{issuer_identifier};
        $output->{crl_key} = $db_results->{crl_key};

    } else {
        $output = $pem_crl;
    }
    ##! 16: 'output: ' . Dumper $output
    return $output;
}

=head2 get_crl_list( { PKI_REALM, ISSUER, FORMAT, LIMIT, VALID_AT } )

List all CRL issued in the given realm. If no realm is given, use the
realm of the current session. You can add an ISSUER (cert_identifier)
in which case you get only the CRLs issued by this issuer.
The result is an arrayref of matching entries ordered by last_update,
newest first. LIMIT has a default of 25.
VALID_AT accepts a single timestamp and will match all crl which have been
valid at this moment.
(this might crash your server if used together with a FORMAT!)

The FORMAT parameter determines the return format:

=over

=item RAW

Bare lines from the database

=item HASH

The result of OpenXPKI::Crypto::CRL::get_parsed_ref

=item TXT|PEM|DER

The data blob in the requested format.

=back

=cut

sub get_crl_list {
    ##! 1: "start"
    my ($self, $keys) = @_;

    my $pki_realm = $keys->{PKI_REALM};
    $pki_realm = CTX('session')->get_pki_realm() unless($pki_realm);


    my $format = $keys->{FORMAT};

    my $limit = $keys->{LIMIT} || 25;

    my %where = ();

    if ($keys->{VALID_AT}) {
        $where{'last_update'} = { '<', $keys->{VALID_AT} };
        $where{'next_update'} = {  '>', $keys->{VALID_AT} };
    }

    if ($keys->{ISSUER}) {
        $where{'issuer_identifier'} = $keys->{ISSUER};
    } else {
        $where{'pki_realm'} = $pki_realm;
    }

    my $db_results = CTX('dbi')->select(
        from => 'crl',
        columns => ['issuer_identifier','data','last_update','next_update','publication_date','crl_key'],
        where => \%where,
        order_by => '-last_update',
        limit => $limit,
    );

    my @result;

    if ($format eq 'HASH') {
        my $default_token = CTX('api')->get_default_token();

        while (my $entry = $db_results->fetchrow_hashref) {
            my $crl_obj = OpenXPKI::Crypto::CRL->new(
                TOKEN => $default_token,
                DATA  => $entry->{data},
            );
            push @result, { %{$crl_obj->get_parsed_ref()}, 'crl_key' => $entry->{crl_key} };
        }

    } elsif ( $format eq 'DER' or $format eq 'TXT' ) {
        my $default_token = CTX('api')->get_default_token();
        while (my $entry = $db_results->fetchrow_hashref) {
            my $output = $default_token->command({
                COMMAND => 'convert_crl',
                OUT     => $format,
                IN      => 'PEM',
                DATA    => $entry->{data},
            });
            if (!$output) {
                OpenXPKI::Exception->throw(
                    message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_MISSING_CA_CONFIG',
                    params => { DATA => $entry->{DATA}, SERIAL => $entry->{SERIAL} }

                );
            }
            push @result, $output;
        }

    } elsif($format eq 'PEM') {
        while (my $entry = $db_results->fetchrow_hashref) {
            push @result, $entry->{data};
        }

    } else {
        while (my $entry = $db_results->fetchrow_hashref) {
            # TODO Remove after SQL Layer migration is complete
            %{$entry} = map { uc($_) => $entry->{$_} }  keys %{$entry};
            push @result, $entry;
        }
    }


    ##! 32: "Found crl " . Dumper @result

    ##! 1: 'Finished'
    return \@result;
}

=head2 import_crl( { DATA } )

Import a CRL into the current realm. This should be used only within
realms that work as a proxy to external CA system or use external CRL
signer tokens. Expects the PEM formated CRL in the DATA parameter.
The issuer is extracted from the CRL. Note that the issuer must be
defined as alias in the certsign group!

A duplicate check is done based on issuer, last_update and next_update.

The content of the CRL is NOT parsed, therefore the certificate status
of revoked certificates is NOT changed in the database!

=over

=item DATA

PEM formated CRL

=back

=cut

sub import_crl {
    ##! 1: "start"
    my ($self, $keys) = @_;

    my $pki_realm = CTX('session')->get_pki_realm();

    my $dbi = CTX('dbi');

    my $crl = $keys->{DATA};

    my $crl_obj = OpenXPKI::Crypto::CRL->new(
        TOKEN => CTX('api')->get_default_token(),
        DATA  => $crl,
        EXTENSIONS => 1,
    );

    my $data = { $crl_obj->to_db_hash() };

    # Find the issuer certificate
    my $issuer_aik = $crl_obj->{PARSED}->{BODY}->{EXTENSIONS}->{AUTHORITY_KEY_IDENTIFIER};
    my $issuer_dn = $crl_obj->{PARSED}->{BODY}->{ISSUER};

    # We need the group name for the alias group
    my $group = CTX('config')->get(['crypto', 'type', 'certsign']);

    ##! 16: 'Look for issuer ' . $issuer_aik . '/' . $issuer_dn . ' in group ' . $group

    my $where = {
        'certificate.pki_realm' => $pki_realm,
        'aliases.group_id' => $group
    };

    if ($issuer_aik) {
        $where->{'certificate.subject_key_identifier'} = $issuer_aik;
    } else {
        $where->{'certificate.subject'} = $issuer_dn;
    }

    my $issuer = $dbi->select_one(
        from_join => 'certificate  identifier=identifier,pki_realm=pki_realm aliases',
        columns => [ 'certificate.identifier' ],
        where => $where
    ) or OpenXPKI::Exception->throw(
        message => 'I18N_OPENXPKI_UI_IMPORT_CRL_ISSUER_NOT_FOUND',
        params => { 'ISSUER_DN' => $issuer_dn , 'GROUP' => $group, 'ISSUER_AIK' => $issuer_aik },
    );

    ##! 32: 'Issuer ' . Dumper $issuer

    $dbi->start_txn;

    my $serial = $dbi->next_id('crl');

    my $ca_identifier = $issuer->{identifier};
    $data = {
        # FIXME #legacydb Change upper to lower case in OpenXPKI::Crypto::CRL->to_db_hash(), not here
        ( map { lc($_) => $data->{$_} } keys %$data ),
        pki_realm         => $pki_realm,
        issuer_identifier => $ca_identifier,
        crl_key           => $serial,
        publication_date  => 0,
    };

    my $duplicate = $dbi->select_one(
        from => 'crl',
        columns => [ 'crl_key' ],
        where => {
            'pki_realm' => $pki_realm,
            'issuer_identifier' => $ca_identifier,
            'last_update' => $data->{last_update},
            'next_update' => $data->{next_update},
        },
    );

    if ($duplicate) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_UI_IMPORT_CRL_DUPLICATE',
            params => {
                'issuer_identifier' => $ca_identifier,
                'last_update' => $data->{last_update},
                'next_update' => $data->{next_update},
                'crl_key' => $duplicate->{crl_key},
            },
        );
    }

    ##! 32: 'CRL Data ' . Dumper $data

    $dbi->insert( into => 'crl', values => $data );

    $dbi->commit;

    CTX('log')->log(
        MESSAGE  => "Imported CRL for issuer $issuer_dn",
        PRIORITY => 'info',
        FACILITY => 'application',
    );

    delete $data->{data};
    return $data;

}

=head2 search_cert

supports a facility to search certificates. It supports the following parameters:

=over

=item * CERT_SERIAL

=item * LIMIT

=item * LAST

=item * FIRST

=item * CSR_SERIAL

=item * SUBJECT

=item * ISSUER_DN

=item * ISSUER_IDENTIFIER

=item * PKI_REALM (default is the sessions realm, _any for global search)

=item * PROFILE

=item * VALID_AT

=item * NOTBEFORE/NOTAFTER (with SCALAR searches "other side" of validity or pass HASH with operator)

=item * CERT_ATTRIBUTES list of conditions to search in attributes (KEY, VALUE, OPERATOR)

=item * ENTITY_ONLY (show only certificates issued by this ca)

=item * SUBJECT_KEY_IDENTIFIER

=item * AUTHORITY_KEY_IDENTIFIER

=back

The result is an array of hashes. The hashes do not contain the data field
of the database to reduce the transport costs an avoid parser implementations
on the client.

=cut
sub search_cert {
    my ($self, $args) = @_;

    my $params = $self->__search_cert( $args );

    ##! 16: 'certificate search arguments: ' . Dumper $params

    my $result = CTX('dbi_backend')->select(%{$params});
    if ( ref $result ne 'ARRAY' ) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_SEARCH_CERT_SELECT_RESULT_NOT_ARRAY',
            params => { 'TYPE' => ref $result, },
        );
    }

    ##! 1: 'Result ' . Dumper $result

    foreach my $item ( @{$result} ) {

        # remove leading table name from result columns
        map {
            my $col = substr( $_, index( $_, '.' ) + 1 );
            $item->{$col} = $item->{$_};
            delete $item->{$_};
        } keys %{$item};
    }

    ##! 1: "finished"
    return $result;

}

=head2 search_cert_count

Same as cert_search, returns the number of matching rows

=cut
sub search_cert_count {
    ##! 1: 'start'
    my ($self, $args) = @_;

    my $params = $self->__search_cert( $args );

    $params->{COLUMNS} = [{ COLUMN   => 'CERTIFICATE.IDENTIFIER', AGGREGATE => 'COUNT' }];

    my $result = CTX('dbi_backend')->select(%{$params});

    unless (defined $result and ref $result eq 'ARRAY' and scalar @{$result} == 1) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_SEARCH_CERT_COUNT_SELECT_RESULT_NOT_ARRAY',
            params => { 'TYPE' => ref $result, },
        );
    }

    return $result->[0]->{'CERTIFICATE.IDENTIFIER'};

}

sub __search_cert {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 16: 'search_cert arguments: ' . Dumper $args

    my %params;
    $params{TABLE} = [ 'CERTIFICATE', ];

    $params{COLUMNS} = [
        'CERTIFICATE.ISSUER_DN',
        'CERTIFICATE.CERTIFICATE_SERIAL',
        'CERTIFICATE.ISSUER_IDENTIFIER',
        'CERTIFICATE.IDENTIFIER',
        'CERTIFICATE.SUBJECT',
        'CERTIFICATE.STATUS',
        'CERTIFICATE.PUBKEY',
        'CERTIFICATE.SUBJECT_KEY_IDENTIFIER',
        'CERTIFICATE.AUTHORITY_KEY_IDENTIFIER',
        'CERTIFICATE.NOTAFTER',
        'CERTIFICATE.LOA',
        'CERTIFICATE.NOTBEFORE',
        'CERTIFICATE.CSR_SERIAL',
    ];
    $params{JOIN} = [ ['IDENTIFIER'] ];

    ##! 2: "fix arguments"
    foreach my $key (qw( EMAIL SUBJECT ISSUER )) {
        if ( defined $args->{$key} ) {
            $args->{$key} =~ s/\*/%/g;

            # sanitize wildcards (don't overdo it...)
            $args->{$key} =~ s/%%+/%/g;
        }
    }

    ##! 2: "initialize arguments"

    if ( $args->{CERT_SERIAL} ) {
        my $serial = $args->{CERT_SERIAL};
        # autoconvert hexadecimal serial, needs to have 0x as prefix!
        if (substr($serial,0,2) eq '0x') {
            my $sn = Math::BigInt->new( $serial );
            $serial = $sn->bstr();
        }
        $params{SERIAL} = $serial;
    }

    if ( defined $args->{LIMIT} and !defined $args->{START} ) {
        $params{'LIMIT'} = $args->{LIMIT};
    }
    elsif ( defined $args->{LIMIT} and defined $args->{START} ) {
        $params{'LIMIT'} = {
            AMOUNT => $args->{LIMIT},
            START  => $args->{START},
        };
    }

    # only list entities issued by this ca
    if ($args->{ENTITY_ONLY}) {
        $params{DYNAMIC}->{'CERTIFICATE.CSR_SERIAL'} = { VALUE => undef, OPERATOR => 'NOT_EQUAL' };
    }

    # pki realm
    if (!$args->{PKI_REALM}) {
        $params{DYNAMIC}->{'CERTIFICATE.PKI_REALM'} = { VALUE => CTX('session')->get_pki_realm() };
    } elsif ($args->{PKI_REALM} !~ /_any/i) {
        $params{DYNAMIC}->{'CERTIFICATE.PKI_REALM'} = { VALUE => $args->{PKI_REALM} };
    }

    # Custom ordering
    $params{ORDER}   = ['CERTIFICATE.CERTIFICATE_SERIAL'];
    if ($args->{ORDER}) {
       $params{ORDER} = [ $args->{ORDER} ];
    }

    $params{REVERSE} = 1;
    if (defined $args->{REVERSE}) {
       $params{REVERSE} = $args->{REVERSE};
    }

    # Handle status =
    if ($args->{'STATUS'} and $args->{'STATUS'} eq 'EXPIRED') {
        $args->{'STATUS'} = 'ISSUED',
        $params{DYNAMIC}->{ 'CERTIFICATE.NOTAFTER' } =
              { VALUE => time(), OPERATOR => "LESS_THAN" };
    }


    foreach my $key (qw( IDENTIFIER ISSUER_IDENTIFIER CSR_SERIAL STATUS SUBJECT_KEY_IDENTIFIER AUTHORITY_KEY_IDENTIFIER )) {
        if ( $args->{$key} ) {
            $params{DYNAMIC}->{ 'CERTIFICATE.' . $key } =
              { VALUE => $args->{$key} };
        }
    }
    foreach my $key (qw( EMAIL SUBJECT ISSUER_DN )) {
        if ( $args->{$key} ) {
            $params{DYNAMIC}->{ 'CERTIFICATE.' . $key } =
              { VALUE => $args->{$key}, OPERATOR => "LIKE" };
        }
    }

    if ( defined $args->{VALID_AT} ) {
        $params{VALID_AT} = $args->{VALID_AT};
        if (!ref $params{VALID_AT}) {
            $params{VALID_AT} = [ $params{VALID_AT} ];
        }
    }

    # notbefore/notafter should only be used for timestamps outside
    # the validity interval, therefore the operators are fixed
    if ( defined $args->{NOTBEFORE} ) {

        if (ref $args->{NOTBEFORE} eq 'HASH') {<commit_msg>Fix "search_cert" API method (searching by ISSUER_DN)<commit_after>## OpenXPKI::Server::API::Object.pm
##
## Written 2005 by <NAME> and <NAME> for the OpenXPKI project
## Copyright (C) 2005-2006 by The OpenXPKI Project

=head1 Name

OpenXPKI::Server::API::Object

=head1 Description

This is the object interface which should be used by all user interfaces of OpenXPKI.
A user interface MUST NOT access the server directly. The only allowed
access is via this API. Any function which is not available in this API is
not for public use.
The API gets access to the server via the 'server' context object. This
object must be set before instantiating the API.

=head1 Functions

=cut

package OpenXPKI::Server::API::Object;

use strict;
use warnings;
use utf8;
use English;

use Data::Dumper;

use Class::Std;
use Math::BigInt;
use Crypt::PKCS10 1.8;
use OpenXPKI::Debug;
use OpenXPKI::Exception;
use OpenXPKI::Server::Context qw( CTX );
use OpenXPKI::Crypto::CSR;
use OpenXPKI::Crypto::VolatileVault;
use OpenXPKI::FileUtils;
use OpenXPKI::Server::Watchdog;
use OpenXPKI::Control;
use DateTime;
use List::Util qw(first);

use Digest::SHA qw(sha1_hex);
use MIME::Base64 qw( encode_base64 decode_base64 );

use OpenXPKI::Server::Database::Legacy;

sub START {

    # somebody tried to instantiate us, but we are just an
    # utility class with static methods
    OpenXPKI::Exception->throw( message =>
          'I18N_OPENXPKI_SERVER_API_SUBCLASSES_CAN_NOT_BE_INSTANTIATED', );
}


sub generate_key {
    ##! 1: "start"
    my $self = shift;
    my $args = shift;

    my $pass = $args->{PASSWD}
        or OpenXPKI::Exception->throw( message =>
          'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_REQUIRES_PASSWORD' );

    my $key_alg = lc($args->{KEY_ALG}) || 'rsa';
    my $enc_alg = lc($args->{ENC_ALG});

    my $params = $args->{PARAMS};

    my $token = CTX('api')->get_default_token();

    # prepare command definition
    my $command = {
         COMMAND    => 'create_pkey',
         KEY_ALG    => $key_alg,
         ENC_ALG    => $enc_alg,
         PASSWD     => <PASSWORD>,
    };

    # Handling of pkeyopts for standard algorithms
    if ($params->{PKEYOPT} and ref $params->{PKEYOPT} eq 'HASH') {
        $command->{PKEYOPT} = $params->{PKEYOPT};
    }
    # RSA
    elsif ($key_alg eq "rsa") {
        my $rsa_bits = ($params->{KEY_LENGTH} and $params->{KEY_LENGTH} =~ m{\A \d+ \z}xs)
            ? $params->{KEY_LENGTH}
            : 2048;
        $command->{PKEYOPT} = { rsa_keygen_bits => $rsa_bits };
    }
    # EC
    elsif ($key_alg eq "ec") {
        # With openssl <=1.0.1 you need to create EC the same way as DSA
        # means params and key in two steps
        # see http://openssl.6102.n7.nabble.com/EC-private-key-generation-problem-td47261.html
        if (!$params->{ECPARAM}) {
            OpenXPKI::Exception->throw(message =>
                'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_EC_REQUIRES_CURVE_NAME')
                unless $params->{CURVE_NAME};

            $params->{ECPARAM} = $token->command({
                COMMAND => 'create_params',
                TYPE    => 'EC',
                PKEYOPT => { ec_paramgen_curve => $params->{CURVE_NAME} }
            });
        }

        OpenXPKI::Exception->throw( message =>
            'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_DSA_UNABLE_TO_GENERATE_EC_PARAM' )
            unless $params->{ECPARAM};

        delete $command->{KEY_ALG};
        $command->{PARAM} = $params->{ECPARAM};
    }
    # DSA
    elsif ($key_alg eq "dsa") {
        if (!$params->{DSAPARAM}) {
            # Generate Parameters
            my $dsa_bits = ($params->{KEY_LENGTH} and $params->{KEY_LENGTH} =~ m{\A \d+ \z}xs)
                ? $params->{KEY_LENGTH}
                : 2048;
            $params->{DSAPARAM} = $token->command({
                COMMAND => 'create_params',
                TYPE    => 'DSA',
                PKEYOPT => { dsa_paramgen_bits => $dsa_bits }
            });
        }

        OpenXPKI::Exception->throw( message =>
            'I18N_OPENXPKI_SERVER_API_OBJECT_GENERATE_KEY_DSA_UNABLE_TO_GENERATE_DSA_PARAM' )
            unless $params->{DSAPARAM};

        delete $command->{KEY_ALG};
        $command->{PARAM} = $params->{DSAPARAM};
    }

    CTX('log')->log(
        MESSAGE  => "Creating private $key_alg key with params " . Dumper $command->{PKEYOPT},
        PRIORITY => 'debug',
        FACILITY => 'application',
    );

    ##! 16: 'command: ' . Dumper $command

    my $key = $token->command( $command );

    return $key;

}

=head2 get_key_identifier_from_data

returns the key identifier (sha1 hash of the public key bit string) of the
given data as string, uppercased hex with colons.

=over

=item DATA

Data, encoded as given by FORMAT parameter.

=item FORMAT

* PKCS10: PEM encoded PKCS10 block

=back

=cut

sub get_key_identifier_from_data {
    ##! 1: "start"
    my ($self, $args) = @_;

    # as we currently only support PKCS10 and the parameter is checked
    # by the API, we dont need any ifs here.

    Crypt::PKCS10->setAPIversion(1);
    my $decoded = Crypt::PKCS10->new($args->{DATA}, ignoreNonBase64 => 1, verifySignature => 0)
        or OpenXPKI::Exception->throw(message => 'Unable to parse data in get_key_identifier_from_data');

    return uc(
        join ':', (
            unpack '(A2)*', sha1_hex(
                $decoded->{certificationRequestInfo}{subjectPKInfo}{subjectPublicKey}[0]
            )
        )
    );
}

=head2 get_csr_info_hash_from_data

return a hash reference which includes all parsed informations from
the CSR. The only accepted parameter is DATA which includes the plain CSR.

=cut

sub get_csr_info_hash_from_data {
    ##! 1: "start"
    my ($self, $args) = @_;

    my $data  = $args->{DATA};
    my $token = CTX('api')->get_default_token();
    my $obj   = OpenXPKI::Crypto::CSR->new( DATA => $data, TOKEN => $token );

    ##! 1: "finished"
    return $obj->get_info_hash();
}

=head2 get_ca_cert

returns the certificate of one CA. This is a wrapper around get_cert to make
the access control more fine granular if necessary.

=cut

sub get_ca_cert {
    ##! 1: "start, forward and finish"
    my ($self, $args) = @_;
    return $self->get_cert($args);
}


=head2 get_cert

returns the requested certificate. The supported arguments are IDENTIFIER and
FORMAT. IDENTIFIER is required whilst FORMAT is optional. FORMAT can have the
following values:

=over

=item * PEM

=item * DER

=item * TXT

=item * HASH - the default value

=item * DBINFO - information from the certificate and attributes table

=back

=cut

# Test: qatest/backend/nice/10_nice_signing_request.t
sub get_cert {
    ##! 1: "start"
    my ($self, $args) = @_;
    my $dbi = CTX('dbi');

    my $identifier = $args->{IDENTIFIER};
    my $format     = $args->{FORMAT} // "HASH";
    ##! 2: "Requested output format: $format"

    ##! 2: "Fetching certificate from database"
    $dbi->commit;
    my $cert = $dbi->select_one(
        columns => [ '*' ],
        from => 'certificate',
        where => { 'identifier' => $identifier },
    )
        or OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CERT_CERTIFICATE_NOT_FOUND_IN_DB',
            params => { 'IDENTIFIER' => $identifier, },
        );

    #
    # Format: "DBINFO"
    #
    if ( $format eq 'DBINFO' ) {
        ##! 2: "Preparing output for DBINFO format"
        delete $cert->{data};
        my $extended_info = {};

        # Hex Serial
        my $serial = Math::BigInt->new($cert->{cert_key});
        $extended_info->{cert_key_hex} = $serial->as_hex;
        $extended_info->{cert_key_hex} =~ s{\A 0x}{}xms;

        # Expired Status
        $cert->{status} = 'EXPIRED' if $cert->{status} eq 'ISSUED' and $cert->{notafter} < time();

        # Fetch certificate attributes
        $extended_info->{cert_attributes} = {};
        my $cert_attr = $dbi->select(
            columns => [ qw(
                attribute_contentkey
                attribute_value
            ) ],
            from => 'certificate_attributes',
            where => { identifier => $identifier },
        );
        while (my $attr = $cert_attr->fetchrow_hashref) {
            my $key = $attr->{attribute_contentkey};
            my $val = $attr->{attribute_value};
            $extended_info->{cert_attributes}->{$key} //= [];
            push @{$extended_info->{cert_attributes}->{$key}}, $val;
        }

        # TODO #legacydb Mapping for compatibility to old DB layer
        return {
            %{ OpenXPKI::Server::Database::Legacy->certificate_to_legacy($cert) },
            'CERT_ATTRIBUTES'        => $extended_info->{cert_attributes},
            'CERTIFICATE_SERIAL_HEX' => $extended_info->{cert_key_hex},
        };
    }

    ##! 2: "Requesting crypto token via API and creating X509 object"
    my $token = CTX('api')->get_default_token();
    my $obj   = OpenXPKI::Crypto::X509->new(
        TOKEN => $token,
        DATA  => $cert->{data},
    );

    #
    # Format: "HASH"
    #
    if ( $format eq 'HASH' ) {
        ##! 2: "Preparing output for HASH format"
        my $result = $obj->get_parsed_ref;

        # NOTBEFORE and NOTAFTER are DateTime objects, which we do
        # not want to be serialized, so we just send out the stringified
        # version ...
        $result->{BODY}->{NOTBEFORE} = $result->{BODY}->{NOTBEFORE}->epoch();
        $result->{BODY}->{NOTAFTER}  = $result->{BODY}->{NOTAFTER}->epoch();
        $result->{STATUS}            = $cert->{status};
        $result->{IDENTIFIER}        = $cert->{identifier};
        $result->{ISSUER_IDENTIFIER} = $cert->{issuer_identifier};
        $result->{CSR_SERIAL}        = $cert->{req_key};
        $result->{PKI_REALM}         = $cert->{pki_realm};
        return $result;
    }

    #
    # Format: "PEM", "DER", "TXT"
    #
    ##! 2: "Converting X509 object into target format"
    return $obj->get_converted($format);
}


=head2 get_cert_attributes

returns a hash with the attributes of the certificate. Requires the
IDENTIFIER of the certificate.

=cut

sub get_cert_attributes {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 2: "initialize arguments"
    my $identifier = $args->{IDENTIFIER};

    my $query = { identifier => $identifier };

    if ($args->{ATTRIBUTE}) {
        $query->{attribute_contentkey} = { -like => $args->{ATTRIBUTE} };
    }

    my $sth_attrib = CTX('dbi')->select(
        from => 'certificate_attributes',
        columns => [ 'attribute_contentkey', 'attribute_value' ],
        where => $query
    );

    my $attrib;
    while (my $item = $sth_attrib->fetchrow_hashref) {
        my $key = $item->{attribute_contentkey};
        my $val = $item->{attribute_value};
        if (!defined($attrib->{$key})) {
            $attrib->{$key} = [];
        }
        push @{$attrib->{$key}}, $val;
    }

    return $attrib;
}

=head2 get_profile_for_cert

returns the name of the profile used during the certificate request.
Supported argument is IDENTIFIER which is required.

=cut

sub get_profile_for_cert {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 2: "initialize arguments"
    my $identifier = $args->{IDENTIFIER};

    my $result = CTX('dbi')->select_one(
        from_join => 'certificate req_key=req_key csr',
        columns => [ 'csr.profile' ],
        where => { 'certificate.identifier' => $identifier },
    )
        or OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_PROFILE_FOR_CERT_CERTIFICATE_NOT_FOUND_IN_DB',
            params => { 'IDENTIFIER' => $identifier },
        );

    return $result->{'profile'};

}

=head2 get_cert_actions

Requires a certificate identifier (IDENTIFIER) and optional ROLE.
Returns a list of actions that the given role (defaults to current
session role) can do with the given certificate. The return value is a
nested hash with options available for lifecyle actions. The list of
workflows is hardcoded for now, workflows which are not present or not
accessible by the current user are remove from the result.

    {
        workflow => [
            { label => I18N_OPENXPKI_UI_CERT_ACTION_REVOKE, workflow => certificate_revocation_request_v2 },
            { label => I18N_OPENXPKI_UI_CERT_ACTION_RENEW, workflow => certificate_renewal_request_v2 },
            { label => I18N_OPENXPKI_UI_CERT_ACTION_RENEW, workflow => certificate_renewal_request_v2 }
        ]
    }

=cut

sub get_cert_actions {
    ##! 1: "start"
    my ($self, $args) = @_;

    my $role    = $args->{ROLE} || CTX('session')->get_role();
    my $cert_id = $args->{IDENTIFIER};
    my $cert    = CTX('api')->get_cert({ IDENTIFIER => $cert_id, FORMAT => 'DBINFO' });
    ##! 2: "cert $cert_id, role $role"

    # check if this is a entity certificate from the current realm
    return {} unless $cert->{CSR_SERIAL} and $cert->{PKI_REALM} eq CTX('session')->get_pki_realm();

    my $conn = CTX('config');

    my @actions;
    push @actions, { label => 'I18N_OPENXPKI_UI_DOWNLOAD_PRIVATE_KEY', workflow => 'certificate_privkey_export' }
        if CTX('api')->private_key_exists_for_cert({ IDENTIFIER => $cert_id })
        and $conn->exists([ 'workflow', 'def', 'certificate_privkey_export', 'acl', $role, 'creator' ] );

    push @actions, { label => 'I18N_OPENXPKI_UI_CERT_ACTION_RENEW', workflow => 'certificate_renewal_request' }
        if ($cert->{STATUS} eq 'ISSUED' or $cert->{STATUS} eq 'EXPIRED')
        and $conn->exists([ 'workflow', 'def', 'certificate_renewal_request', 'acl', $role, 'creator' ] );

    push @actions, { label => 'I18N_OPENXPKI_UI_CERT_ACTION_REVOKE', workflow => 'certificate_revocation_request_v2' }
        if $cert->{STATUS} eq 'ISSUED'
        and $conn->exists([ 'workflow', 'def', 'certificate_revocation_request_v2', 'acl', $role, 'creator' ]);

    push @actions, { label => 'I18N_OPENXPKI_UI_CERT_ACTION_UPDATE_METADATA', workflow => 'change_metadata' }
        if $conn->exists([ 'workflow', 'def', 'change_metadata', 'acl', $role, 'creator' ] );

    return { workflow => \@actions };
}


=head2 is_certificate_owner

Requires a certificate identifier (IDENTIFIER) and user (USER). User is
optional and will default to the session user if not given. Checks if
USER is the owner of the certificate, based on the formerly recorded meta
information.

Returns true if the user is the owner, false if not and undef if the
ownership could not be determined.

=cut

sub is_certificate_owner {
    ##! 1: "start"
    my ($self, $args) = @_;

    my $user = $args->{USER} || CTX('session')->get_user();
    my $cert_id = $args->{IDENTIFIER};

    my $result = CTX('dbi')->select_one(
        from => 'certificate_attributes',
        columns => [ 'attribute_value' ],
        where => {
            identifier => $cert_id,
            attribute_contentkey => 'system_cert_owner',
        },
    );

    return undef unless $result;

    ##! 16: "compare $user ?= " . $result->{attribute_value}
    return ($result->{attribute_value} eq $user);
}

=head2 get_crl

returns a CRL. The possible parameters are CRL_KEY, FORMAT and PKI_REALM.
CRL_KEY is the serial of the database table, the realm defaults to the
current realm and the default format is PEM. Other formats are DER, TXT
HASH, FULLHASH or DBINFO. DBINFO returns the fields directly from the
database without parsing the CRL. HASH returns the result of
OpenXPKI::Crypto::CRL::get_parsed_ref, FULLHASH also adds the list of
revocation entries (this might become a very expensive task if your CRL
is large!).

If no serial is given, the most current CRL of the active signer token is
returned.

=cut

sub get_crl {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 2: "initialize arguments"
    my $serial    = $args->{SERIAL}; # deprecates, use crl_key instead!
    my $crl_key    = $args->{CRL_KEY};
    my $pki_realm = $args->{PKI_REALM};
    my $format   = "PEM";

    $format = $args->{FORMAT} if exists $args->{FORMAT};
    $pki_realm =  CTX('session')->get_pki_realm() unless $args->{PKI_REALM};

    my $db_results;

    my $columns = ($format eq 'DBINFO') ?
        [ 'pki_realm', 'last_update', 'next_update', 'crl_key', 'publication_date', 'issuer_identifier' ] :
        [ 'pki_realm', 'data','crl_key' ];

    if ($serial) {
        $crl_key = $serial;

        CTX('log')->log(
            MESSAGE  => "Call to get_crl using deprecated parameter 'serial', please use 'crl_key'!",
            PRIORITY => 'warn',
            FACILITY => 'application',
        );
    }

    if ($crl_key) {
        ##! 16: 'Load crl by serial ' . $serial
        $db_results = CTX('dbi')->select_one(
            from => 'crl',
            columns => $columns,
            where => {
                'crl_key' => $crl_key,
            },
        );

    } else {

        my $ca_alias = CTX('api')->get_token_alias_by_type({ TYPE => 'certsign' });
        ##! 16: 'Load crl by date, ca alias ' . $ca_alias
        my $ca_hash = CTX('api')->get_certificate_for_alias({ ALIAS => $ca_alias });

        $db_results = CTX('dbi')->select_one(
            from => 'crl',
            columns => $columns,
            where => {
                issuer_identifier => $ca_hash->{IDENTIFIER}
            },
            order_by => '-last_update'
        );
    }

    ##! 32: 'DB Result ' . Dumper $db_results

    if ( not $db_results ) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_NOT_FOUND', );
    }

    if ($pki_realm ne $db_results->{pki_realm}) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_NOT_IN_REALM', );
    }

    # Is this really useful ?
    #OpenXPKI::Exception->throw( message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_NOT_PUBLIC' );

    my $pem_crl = $db_results->{data};

    my $output;
    if ($format eq 'DBINFO') {
        $output = $db_results;
    }
    elsif ( $format eq 'DER' or $format eq 'TXT' ) {
        # convert the CRL
        my $default_token = CTX('api')->get_default_token();
        $output = $default_token->command({
            COMMAND => 'convert_crl',
            OUT     => $format,
            IN      => 'PEM',
            DATA    => $pem_crl,
        });
        if (!$output) {
            OpenXPKI::Exception->throw(
                message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_UNABLE_TO_CONVERT',
            );
        }
    }
    elsif ( $format eq 'HASH' or $format eq 'FULLHASH' ) {
        # parse CRL using OpenXPKI::Crypto::CRL
        my $default_token = CTX('api')->get_default_token();
        my $crl_obj = OpenXPKI::Crypto::CRL->new(
            TOKEN => $default_token,
            DATA  => $pem_crl,
            REVOKED => ($format eq 'FULLHASH') ,
        );
        $output = $crl_obj->get_parsed_ref();
        $output->{ISSUER_IDENTIFIER} = $db_results->{issuer_identifier};
        $output->{crl_key} = $db_results->{crl_key};

    } else {
        $output = $pem_crl;
    }
    ##! 16: 'output: ' . Dumper $output
    return $output;
}

=head2 get_crl_list( { PKI_REALM, ISSUER, FORMAT, LIMIT, VALID_AT } )

List all CRL issued in the given realm. If no realm is given, use the
realm of the current session. You can add an ISSUER (cert_identifier)
in which case you get only the CRLs issued by this issuer.
The result is an arrayref of matching entries ordered by last_update,
newest first. LIMIT has a default of 25.
VALID_AT accepts a single timestamp and will match all crl which have been
valid at this moment.
(this might crash your server if used together with a FORMAT!)

The FORMAT parameter determines the return format:

=over

=item RAW

Bare lines from the database

=item HASH

The result of OpenXPKI::Crypto::CRL::get_parsed_ref

=item TXT|PEM|DER

The data blob in the requested format.

=back

=cut

sub get_crl_list {
    ##! 1: "start"
    my ($self, $keys) = @_;

    my $pki_realm = $keys->{PKI_REALM};
    $pki_realm = CTX('session')->get_pki_realm() unless($pki_realm);


    my $format = $keys->{FORMAT};

    my $limit = $keys->{LIMIT} || 25;

    my %where = ();

    if ($keys->{VALID_AT}) {
        $where{'last_update'} = { '<', $keys->{VALID_AT} };
        $where{'next_update'} = {  '>', $keys->{VALID_AT} };
    }

    if ($keys->{ISSUER}) {
        $where{'issuer_identifier'} = $keys->{ISSUER};
    } else {
        $where{'pki_realm'} = $pki_realm;
    }

    my $db_results = CTX('dbi')->select(
        from => 'crl',
        columns => ['issuer_identifier','data','last_update','next_update','publication_date','crl_key'],
        where => \%where,
        order_by => '-last_update',
        limit => $limit,
    );

    my @result;

    if ($format eq 'HASH') {
        my $default_token = CTX('api')->get_default_token();

        while (my $entry = $db_results->fetchrow_hashref) {
            my $crl_obj = OpenXPKI::Crypto::CRL->new(
                TOKEN => $default_token,
                DATA  => $entry->{data},
            );
            push @result, { %{$crl_obj->get_parsed_ref()}, 'crl_key' => $entry->{crl_key} };
        }

    } elsif ( $format eq 'DER' or $format eq 'TXT' ) {
        my $default_token = CTX('api')->get_default_token();
        while (my $entry = $db_results->fetchrow_hashref) {
            my $output = $default_token->command({
                COMMAND => 'convert_crl',
                OUT     => $format,
                IN      => 'PEM',
                DATA    => $entry->{data},
            });
            if (!$output) {
                OpenXPKI::Exception->throw(
                    message => 'I18N_OPENXPKI_SERVER_API_OBJECT_GET_CRL_MISSING_CA_CONFIG',
                    params => { DATA => $entry->{DATA}, SERIAL => $entry->{SERIAL} }

                );
            }
            push @result, $output;
        }

    } elsif($format eq 'PEM') {
        while (my $entry = $db_results->fetchrow_hashref) {
            push @result, $entry->{data};
        }

    } else {
        while (my $entry = $db_results->fetchrow_hashref) {
            # TODO Remove after SQL Layer migration is complete
            %{$entry} = map { uc($_) => $entry->{$_} }  keys %{$entry};
            push @result, $entry;
        }
    }


    ##! 32: "Found crl " . Dumper @result

    ##! 1: 'Finished'
    return \@result;
}

=head2 import_crl( { DATA } )

Import a CRL into the current realm. This should be used only within
realms that work as a proxy to external CA system or use external CRL
signer tokens. Expects the PEM formated CRL in the DATA parameter.
The issuer is extracted from the CRL. Note that the issuer must be
defined as alias in the certsign group!

A duplicate check is done based on issuer, last_update and next_update.

The content of the CRL is NOT parsed, therefore the certificate status
of revoked certificates is NOT changed in the database!

=over

=item DATA

PEM formated CRL

=back

=cut

sub import_crl {
    ##! 1: "start"
    my ($self, $keys) = @_;

    my $pki_realm = CTX('session')->get_pki_realm();

    my $dbi = CTX('dbi');

    my $crl = $keys->{DATA};

    my $crl_obj = OpenXPKI::Crypto::CRL->new(
        TOKEN => CTX('api')->get_default_token(),
        DATA  => $crl,
        EXTENSIONS => 1,
    );

    my $data = { $crl_obj->to_db_hash() };

    # Find the issuer certificate
    my $issuer_aik = $crl_obj->{PARSED}->{BODY}->{EXTENSIONS}->{AUTHORITY_KEY_IDENTIFIER};
    my $issuer_dn = $crl_obj->{PARSED}->{BODY}->{ISSUER};

    # We need the group name for the alias group
    my $group = CTX('config')->get(['crypto', 'type', 'certsign']);

    ##! 16: 'Look for issuer ' . $issuer_aik . '/' . $issuer_dn . ' in group ' . $group

    my $where = {
        'certificate.pki_realm' => $pki_realm,
        'aliases.group_id' => $group
    };

    if ($issuer_aik) {
        $where->{'certificate.subject_key_identifier'} = $issuer_aik;
    } else {
        $where->{'certificate.subject'} = $issuer_dn;
    }

    my $issuer = $dbi->select_one(
        from_join => 'certificate  identifier=identifier,pki_realm=pki_realm aliases',
        columns => [ 'certificate.identifier' ],
        where => $where
    ) or OpenXPKI::Exception->throw(
        message => 'I18N_OPENXPKI_UI_IMPORT_CRL_ISSUER_NOT_FOUND',
        params => { 'ISSUER_DN' => $issuer_dn , 'GROUP' => $group, 'ISSUER_AIK' => $issuer_aik },
    );

    ##! 32: 'Issuer ' . Dumper $issuer

    $dbi->start_txn;

    my $serial = $dbi->next_id('crl');

    my $ca_identifier = $issuer->{identifier};
    $data = {
        # FIXME #legacydb Change upper to lower case in OpenXPKI::Crypto::CRL->to_db_hash(), not here
        ( map { lc($_) => $data->{$_} } keys %$data ),
        pki_realm         => $pki_realm,
        issuer_identifier => $ca_identifier,
        crl_key           => $serial,
        publication_date  => 0,
    };

    my $duplicate = $dbi->select_one(
        from => 'crl',
        columns => [ 'crl_key' ],
        where => {
            'pki_realm' => $pki_realm,
            'issuer_identifier' => $ca_identifier,
            'last_update' => $data->{last_update},
            'next_update' => $data->{next_update},
        },
    );

    if ($duplicate) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_UI_IMPORT_CRL_DUPLICATE',
            params => {
                'issuer_identifier' => $ca_identifier,
                'last_update' => $data->{last_update},
                'next_update' => $data->{next_update},
                'crl_key' => $duplicate->{crl_key},
            },
        );
    }

    ##! 32: 'CRL Data ' . Dumper $data

    $dbi->insert( into => 'crl', values => $data );

    $dbi->commit;

    CTX('log')->log(
        MESSAGE  => "Imported CRL for issuer $issuer_dn",
        PRIORITY => 'info',
        FACILITY => 'application',
    );

    delete $data->{data};
    return $data;

}

=head2 search_cert

supports a facility to search certificates. It supports the following parameters:

=over

=item * CERT_SERIAL

=item * LIMIT

=item * LAST

=item * FIRST

=item * CSR_SERIAL

=item * SUBJECT

=item * ISSUER_DN

=item * ISSUER_IDENTIFIER

=item * PKI_REALM (default is the sessions realm, _any for global search)

=item * PROFILE

=item * VALID_AT

=item * NOTBEFORE/NOTAFTER (with SCALAR searches "other side" of validity or pass HASH with operator)

=item * CERT_ATTRIBUTES list of conditions to search in attributes (KEY, VALUE, OPERATOR)

=item * ENTITY_ONLY (show only certificates issued by this ca)

=item * SUBJECT_KEY_IDENTIFIER

=item * AUTHORITY_KEY_IDENTIFIER

=back

The result is an array of hashes. The hashes do not contain the data field
of the database to reduce the transport costs an avoid parser implementations
on the client.

=cut
sub search_cert {
    my ($self, $args) = @_;

    my $params = $self->__search_cert( $args );

    ##! 16: 'certificate search arguments: ' . Dumper $params

    my $result = CTX('dbi_backend')->select(%{$params});
    if ( ref $result ne 'ARRAY' ) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_SEARCH_CERT_SELECT_RESULT_NOT_ARRAY',
            params => { 'TYPE' => ref $result, },
        );
    }

    ##! 1: 'Result ' . Dumper $result

    foreach my $item ( @{$result} ) {

        # remove leading table name from result columns
        map {
            my $col = substr( $_, index( $_, '.' ) + 1 );
            $item->{$col} = $item->{$_};
            delete $item->{$_};
        } keys %{$item};
    }

    ##! 1: "finished"
    return $result;

}

=head2 search_cert_count

Same as cert_search, returns the number of matching rows

=cut
sub search_cert_count {
    ##! 1: 'start'
    my ($self, $args) = @_;

    my $params = $self->__search_cert( $args );

    $params->{COLUMNS} = [{ COLUMN   => 'CERTIFICATE.IDENTIFIER', AGGREGATE => 'COUNT' }];

    my $result = CTX('dbi_backend')->select(%{$params});

    unless (defined $result and ref $result eq 'ARRAY' and scalar @{$result} == 1) {
        OpenXPKI::Exception->throw(
            message => 'I18N_OPENXPKI_SERVER_API_OBJECT_SEARCH_CERT_COUNT_SELECT_RESULT_NOT_ARRAY',
            params => { 'TYPE' => ref $result, },
        );
    }

    return $result->[0]->{'CERTIFICATE.IDENTIFIER'};

}

sub __search_cert {
    ##! 1: "start"
    my ($self, $args) = @_;

    ##! 16: 'search_cert arguments: ' . Dumper $args

    my %params;
    $params{TABLE} = [ 'CERTIFICATE', ];

    $params{COLUMNS} = [
        'CERTIFICATE.ISSUER_DN',
        'CERTIFICATE.CERTIFICATE_SERIAL',
        'CERTIFICATE.ISSUER_IDENTIFIER',
        'CERTIFICATE.IDENTIFIER',
        'CERTIFICATE.SUBJECT',
        'CERTIFICATE.STATUS',
        'CERTIFICATE.PUBKEY',
        'CERTIFICATE.SUBJECT_KEY_IDENTIFIER',
        'CERTIFICATE.AUTHORITY_KEY_IDENTIFIER',
        'CERTIFICATE.NOTAFTER',
        'CERTIFICATE.LOA',
        'CERTIFICATE.NOTBEFORE',
        'CERTIFICATE.CSR_SERIAL',
    ];
    $params{JOIN} = [ ['IDENTIFIER'] ];

    ##! 2: "fix arguments"
    foreach my $key (qw( SUBJECT ISSUER_DN )) {
        if ( defined $args->{$key} ) {
            $args->{$key} =~ s/\*/%/g;

            # sanitize wildcards (don't overdo it...)
            $args->{$key} =~ s/%%+/%/g;
        }
    }

    ##! 2: "initialize arguments"

    if ( $args->{CERT_SERIAL} ) {
        my $serial = $args->{CERT_SERIAL};
        # autoconvert hexadecimal serial, needs to have 0x as prefix!
        if (substr($serial,0,2) eq '0x') {
            my $sn = Math::BigInt->new( $serial );
            $serial = $sn->bstr();
        }
        $params{SERIAL} = $serial;
    }

    if ( defined $args->{LIMIT} and !defined $args->{START} ) {
        $params{'LIMIT'} = $args->{LIMIT};
    }
    elsif ( defined $args->{LIMIT} and defined $args->{START} ) {
        $params{'LIMIT'} = {
            AMOUNT => $args->{LIMIT},
            START  => $args->{START},
        };
    }

    # only list entities issued by this ca
    if ($args->{ENTITY_ONLY}) {
        $params{DYNAMIC}->{'CERTIFICATE.CSR_SERIAL'} = { VALUE => undef, OPERATOR => 'NOT_EQUAL' };
    }

    # pki realm
    if (!$args->{PKI_REALM}) {
        $params{DYNAMIC}->{'CERTIFICATE.PKI_REALM'} = { VALUE => CTX('session')->get_pki_realm() };
    } elsif ($args->{PKI_REALM} !~ /_any/i) {
        $params{DYNAMIC}->{'CERTIFICATE.PKI_REALM'} = { VALUE => $args->{PKI_REALM} };
    }

    # Custom ordering
    $params{ORDER}   = ['CERTIFICATE.CERTIFICATE_SERIAL'];
    if ($args->{ORDER}) {
       $params{ORDER} = [ $args->{ORDER} ];
    }

    $params{REVERSE} = 1;
    if (defined $args->{REVERSE}) {
       $params{REVERSE} = $args->{REVERSE};
    }

    # Handle status =
    if ($args->{'STATUS'} and $args->{'STATUS'} eq 'EXPIRED') {
        $args->{'STATUS'} = 'ISSUED',
        $params{DYNAMIC}->{ 'CERTIFICATE.NOTAFTER' } =
              { VALUE => time(), OPERATOR => "LESS_THAN" };
    }


    foreach my $key (qw( IDENTIFIER ISSUER_IDENTIFIER CSR_SERIAL STATUS SUBJECT_KEY_IDENTIFIER AUTHORITY_KEY_IDENTIFIER )) {
        if ( $args->{$key} ) {
            $params{DYNAMIC}->{ 'CERTIFICATE.' . $key } =
              { VALUE => $args->{$key} };
        }
    }
    foreach my $key (qw( SUBJECT ISSUER_DN )) {
        if ( $args->{$key} ) {
            $params{DYNAMIC}->{ 'CERTIFICATE.' . $key } =
              { VALUE => $args->{$key}, OPERATOR => "LIKE" };
        }
    }

    if ( defined $args->{VALID_AT} ) {
        $params{VALID_AT} = $args->{VALID_AT};
        if (!ref $params{VALID_AT}) {
            $params{VALID_AT} = [ $params{VALID_AT} ];
        }
    }

    # notbefore/notafter should only be used for timestamps outside
    # the validity interval, therefore the operators are fixed
    if ( defined $args->{NOTBEFORE} ) {

        if (ref $args->{NOTBEFORE} eq 'HASH') {
{'fraction_non_alphanumeric': 0.14593617355761673, 'fraction_numerical': 0.006634177016192422, 'mean_word_length': 2.5871538938701857, 'pattern_counts': {'":': 0, '<': 14, '<?xml version=': 0, '>': 912, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2637526', 'n_tokens_mistral': 22500, 'n_tokens_neox': 21565, 'n_words': 5142}