package Crypt::Perl::PKCS10;

use strict;
use warnings;

=encoding utf-8

=head1 NAME

Crypt::Perl::PKCS10 - Certificate Signing Request (CSR) creation

=head1 SYNOPSIS

    my $pkcs10 = Crypt::Perl::PKCS10->new(

        key => $key_obj,

        subject => [
            commonName => 'foo.com',
            localityName => 'somewhere',
            #...
        ],
        attributes => [
            [ 'extensionRequest',
                [ 'subjectAltName',
                    dNSName => 'foo.com',
                    dNSName => 'bar.com',
                ],
            ],
        ],
    );

    my $der = $pkcs10->to_der();
    my $pem = $pkcs10->to_pem();

=head1 DESCRIPTION

This module is for creation of (PKCS #10) certificate signing requests (CSRs).
Right now it supports only a
subset of what L<OpenSSL|http://openssl.org> can create; however, it’s
useful enough for use with many certificate authorities, including
L<ACME|https://ietf-wg-acme.github.io/acme/> services like
L<Let’s Encrypt|http://letsencrypt.org>.

It’s also a good deal easier to use!

I believe this is the only L<CPAN|http://search.cpan.org> module that
can create CSRs for either RSA or ECDSA keys. Other encryption schemes would
not be difficult to integrate—but do any CAs accept them?

=head1 ECDSA KEY FORMAT

As of version 0.13, this module produces CSRs with explicit ECDSA curve
parameters rather than
merely indicating the curve parameters by the name of the curve. This makes
the resulting CSR bigger, but it also prevents compatibility issues with ECDSA
implementations (e.g., old OpenSSL versions) that don’t know about newer
curves.

If you need to produce CSRs with a named curve, let me know.

=head1 SIGNATURE DIGEST ALGORITHMS

The signature digest algorithm is
determined based on the passed-in key: for RSA it’s always SHA-512, and for
ECDSA it’s the strongest SHA digest algorithm that the key allows
(e.g., SHA-224 for a 239-bit key, etc.)

If you need additional flexibility, let me know.

=head1 CLASS METHODS

=head2 new( NAME => VALUE, ... );

Create an instance of this class. Parameters are:

=over 4

=item C<key>: An instance of either
C<Crypt::Perl::RSA::PrivateKey> or C<Crypt::Perl::ECDSA::PrivateKey>.
If you’ve got a DER- or PEM-encoded key string, use L<Crypt::Perl::PK>
(included in this distribution) to create an appropriate object.

=item C<subject>: An array reference of arguments into
L<Crypt::Perl::X509::Name>’s constructor.

=item C<attributes>: An array reference of arguments into
L<Crypt::Perl::PKCS10::Attrbutes>’s constructor.

=back

=head1 TODO

Let me know what features you would find useful, ideally with
a representative sample CSR that demonstrates the requested feature.
(Or, better yet, send me a pull request!)

=head1 SEE ALSO

=over 4

=item * L<Crypt::PKCS10> - Parse CSRs, in pure Perl.

=item * L<Crypt::OpenSSL::PKCS10> - Create CSRs using OpenSSL via XS.
Currently this only seems to support RSA.

=back

=cut

use Crypt::Format ();
use Digest::SHA ();

use Crypt::Perl::ASN1 ();
use Crypt::Perl::PKCS10::Attributes ();
use Crypt::Perl::PKCS10::ASN1 ();
use Crypt::Perl::PKCS10::Attributes ();
use Crypt::Perl::X509::Name ();

use parent qw( Crypt::Perl::ASN1::Encodee );

*to_der = __PACKAGE__->can('encode');

sub to_pem {
    my ($self) = @_;

    return Crypt::Format::der2pem( $self->to_der(), 'CERTIFICATE REQUEST' );
}

use constant ASN1 => <<END;
    AlgorithmIdentifier ::= SEQUENCE {
      algorithm  OBJECT IDENTIFIER,
      parameters ANY
    }

    CertificationRequestInfo ::= SEQUENCE {
      version       INTEGER,
      subject       ANY,
      subjectPKInfo ANY,
      attributes    ANY OPTIONAL
    }

    CertificationRequest ::= SEQUENCE {
      certificationRequestInfo  CertificationRequestInfo,
      signatureAlgorithm        AlgorithmIdentifier,
      signature                 BIT STRING
    }
END

use constant asn1_macro => 'CertificationRequest';

sub new {
    my ($class, %opts) = @_;

    my ($key, $attrs, $subject, $sigalg) = @opts{'key', 'attributes', 'subject', 'signature_algorithm'};

    $subject = Crypt::Perl::X509::Name->new( @$subject );
    $attrs = Crypt::Perl::PKCS10::Attributes->new( @$attrs );

    my $self = {
        _key => $key,
        _subject => $subject,
        _attributes => $attrs,
        _sigalg => $sigalg,
    };

    return bless $self, $class;
}

sub _encode_params {
    my ($self) = @_;

    my $key = $self->{'_key'};

    my ($pk_der);
    my ($sig_alg, $sig_param, $sig_func);

    if ($key->isa('Crypt::Perl::ECDSA::PrivateKey')) {

        my $bits = $key->max_sign_bits();

        if ($bits < 224) {
            die "This key is too weak ($bits bits) to make a secure PKCS #10 CSR.";
        }
        elsif ($bits < 256) {
            $bits = 224;
        }
        elsif ($bits < 384) {
            $bits = 256;
        }
        elsif ($bits < 512) {
            $bits = 384;
        }
        else {
            $bits = 512;
        }

        $sig_alg = "ecdsa-with-SHA$bits";

        $sig_func = sub {
            my ($key, $msg) = @_;

            return $key->sign( Digest::SHA->can("sha$bits")->($msg) );
        };

        $pk_der = $key->get_public_key()->to_der_with_explicit_curve();
    }
    elsif ($key->isa('Crypt::Perl::RSA::PrivateKey')) {
        $sig_alg = 'sha512WithRSAEncryption';
        $sig_param = q<>;
        $sig_func = $key->can('sign_RS512');

        $pk_der = $key->to_subject_public_der();
    }
    else {
        die "Key ($key) is not a recognized private key class instance!";
    }

    $sig_alg = $Crypt::Perl::PKCS10::ASN1::OID{$sig_alg} || do {
        die "Unrecognized signature algorithm OID: “$sig_alg”";
    };

    my $asn1_reqinfo = Crypt::Perl::ASN1->new()->prepare( $self->ASN1() );
    $asn1_reqinfo = $asn1_reqinfo->find('CertificationRequestInfo');

    my $subj_enc = $self->{'_subject'}->encode();

    my $attr_enc = $self->{'_attributes'}->encode();

    #We need the attributes not to be a SET, but CONTEXT [0].
    #That means the first byte needs to be 0xa0, not 0x31.
    #This is a detail germane to the PKCS10 structure, not to the
    #Attributes itself (right??), so it makes sense to do the change here
    #rather than to put “[0] SET” into the ASN1 template for Attributes.
    substr($attr_enc, 0, 1) = chr 0xa0;

    my %reqinfo = (
        version => 0,
        subject => $subj_enc,
        subjectPKInfo => $pk_der,
        attributes => $attr_enc,
    );

    my $reqinfo_enc = $asn1_reqinfo->encode(\%reqinfo);

    my $signature = $sig_func->( $key, $reqinfo_enc );

    return {
        certificationRequestInfo => \%reqinfo,
        signatureAlgorithm => {
            algorithm => $sig_alg,
            parameters => $sig_param || Crypt::Perl::ASN1::NULL(),
        },
        signature => $signature,
    };
}

1;
