File Coverage

blib/lib/Crypt/PKCS10.pm

Criterion	Covered	Total	%
statement	568	717	79.2
branch	252	410	61.4
condition	74	143	51.7
subroutine	55	59	93.2
pod	24	26	92.3
total	973	1355	71.8

#
# Crypt::PKCS10
#
# ABSTRACT: parse PKCS #10 certificate requests
#
# This software is copyright (c) 2014 by Gideon Knocke.
# Copyright (c) 2016 Gideon Knocke, Timothe Litt
#
# See LICENSE for details.
#

package Crypt::PKCS10;

use strict;
use warnings;
use Carp;

use overload( q("") => 'as_string' );

use Convert::ASN1( qw/:tag :const/ );
use Encode ();
use MIME::Base64;
use Scalar::Util ();

our $VERSION = '2.004';

my $apiVersion = undef;  # 0 for compatibility.  1 for prefered
my $error;

# N.B. Names are exposed in the API.
#      %shortnames follows & depends on (some) values.
# When adding OIDs, re-generate the documentation (see "for MAINTAINER" below)
#
# New OIDs don't need the [ ] syntax, which is [ prefered name, deprecated name ]
# Some of the deprecated names are used in the ASN.1 definition. and in the $self
# structure, which unfortunately is exposed with the attributes() method.
# Dealing with the deprecated names causes some messy code.

my %oids = (
    '2.5.4.6'                       => 'countryName',
    '2.5.4.8'                       => 'stateOrProvinceName',
    '2.5.4.10'                      => 'organizationName',
    '2.5.4.11'                      => 'organizationalUnitName',
    '2.5.4.3'                       => 'commonName',
    '1.2.840.113549.1.9.1'          => 'emailAddress',
    '1.2.840.113549.1.9.2'          => 'unstructuredName',
    '1.2.840.113549.1.9.7'          => 'challengePassword',
    '1.2.840.113549.1.9.8'          => 'unstructuredAddress',
    '1.2.840.113549.1.1.1'          => [ 'rsaEncryption', 'RSA encryption' ],
    '1.2.840.113549.1.1.5'          => [ 'sha1WithRSAEncryption', 'SHA1 with RSA encryption' ],
    '1.2.840.113549.1.1.4'          => [ 'md5WithRSAEncryption', 'MD5 with RSA encryption' ],
    '1.2.840.113549.1.1.10'         => 'rsassaPss',
    '1.2.840.113549.1.9.14'         => 'extensionRequest',
    '1.3.6.1.4.1.311.13.2.3'        => 'OS_Version',                   # Microsoft
    '1.3.6.1.4.1.311.13.2.2'        => 'EnrollmentCSP',                # Microsoft
    '1.3.6.1.4.1.311.21.20'         => 'ClientInformation',            # Microsoft REQUEST_CLIENT_INFO
    '1.3.6.1.4.1.311.21.7'          => 'certificateTemplate',          # Microsoft
    '2.5.29.37'                     => [ 'extKeyUsage', 'EnhancedKeyUsage' ],
    '2.5.29.15'                     => [ 'keyUsage', 'KeyUsage' ],
    '1.3.6.1.4.1.311.21.10'         => 'ApplicationCertPolicies',      # Microsoft APPLICATION_CERT_POLICIES
    '2.5.29.14'                     => [ 'subjectKeyIdentifier', 'SubjectKeyIdentifier' ],
    '2.5.29.17'                     => 'subjectAltName',
    '1.3.6.1.4.1.311.20.2'          => 'certificateTemplateName',      # Microsoft
    '2.16.840.1.113730.1.1'         => 'netscapeCertType',
    '2.16.840.1.113730.1.2'         => 'netscapeBaseUrl',
    '2.16.840.1.113730.1.4'         => 'netscapeCaRevocationUrl',
    '2.16.840.1.113730.1.7'         => 'netscapeCertRenewalUrl',
    '2.16.840.1.113730.1.8'         => 'netscapeCaPolicyUrl',
    '2.16.840.1.113730.1.12'        => 'netscapeSSLServerName',
    '2.16.840.1.113730.1.13'        => 'netscapeComment',

    #untested
    '2.5.29.19'                     => [ 'basicConstraints', 'Basic Constraints' ],
    '1.2.840.10040.4.1'             => [ 'dsa', 'DSA' ],
    '1.2.840.10040.4.3'             => [ 'dsaWithSha1', 'DSA with SHA1' ],
    '1.2.840.10045.2.1'             => 'ecPublicKey',
    '1.2.840.10045.4.3.1'           => 'ecdsa-with-SHA224',
    '1.2.840.10045.4.3.2'           => 'ecdsa-with-SHA256',
    '1.2.840.10045.4.3.3'           => 'ecdsa-with-SHA384',
    '1.2.840.10045.4.3.4'           => 'ecdsa-with-SHA512',
    '1.3.36.3.3.2.8.1.1.1'          => 'brainpoolP160r1',
    '1.3.36.3.3.2.8.1.1.2'          => 'brainpoolP160t1',
    '1.3.36.3.3.2.8.1.1.3'          => 'brainpoolP192r1',
    '1.3.36.3.3.2.8.1.1.4'          => 'brainpoolP192t1',
    '1.3.36.3.3.2.8.1.1.5'          => 'brainpoolP224r1',
    '1.3.36.3.3.2.8.1.1.6'          => 'brainpoolP224t1',
    '1.3.36.3.3.2.8.1.1.7'          => 'brainpoolP256r1',
    '1.3.36.3.3.2.8.1.1.8'          => 'brainpoolP256t1',
    '1.3.36.3.3.2.8.1.1.9'          => 'brainpoolP320r1',
    '1.3.36.3.3.2.8.1.1.10'         => 'brainpoolP320t1',
    '1.3.36.3.3.2.8.1.1.11'         => 'brainpoolP384r1',
    '1.3.36.3.3.2.8.1.1.12'         => 'brainpoolP384t1',
    '1.3.36.3.3.2.8.1.1.13'         => 'brainpoolP512r1',
    '1.3.36.3.3.2.8.1.1.14'         => 'brainpoolP512t1',
    '1.2.840.10045.3.1.1'           => 'secp192r1',
    '1.3.132.0.1'                   => 'sect163k1',
    '1.3.132.0.15'                  => 'sect163r2',
    '1.3.132.0.33'                  => 'secp224r1',
    '1.3.132.0.26'                  => 'sect233k1',
    '1.3.132.0.27'                  => 'sect233r1',
    '1.3.132.0.16'                  => 'sect283k1',
    '1.3.132.0.17'                  => 'sect283r1',
    '1.2.840.10045.3.1.7'           => 'secp256r1',
    '1.3.132.0.34'                  => 'secp384r1',
    '1.3.132.0.36'                  => 'sect409k1',
    '1.3.132.0.37'                  => 'sect409r1',
    '1.3.132.0.35'                  => 'secp521r1',
    '1.3.132.0.38'                  => 'sect571k1',
    '1.3.132.0.39'                  => 'sect571r1',
#not std yet    '1.3.6.1.4.1.3029.1.5.1'        => 'curve25519', # GNU TLS
#   '1.3.6.1.4.1.11591.7'           => 'curve25519', #ID josefsson-pkix-newcurves-00
#   '1.3.6.1.4.1.11591.8'           => 'curve448', #ID josefsson-pkix-newcurves-00
    '0.9.2342.19200300.100.1.25'    => 'domainComponent',
    '0.9.2342.19200300.100.1.1'     => 'userID',
    '2.5.4.7'                       => 'localityName',
    '1.2.840.113549.1.1.11'         => [ 'sha256WithRSAEncryption', 'SHA-256 with RSA encryption' ],
    '1.2.840.113549.1.1.12'         => 'sha384WithRSAEncryption',
    '1.2.840.113549.1.1.13'         => [ 'sha512WithRSAEncryption', 'SHA-512 with RSA encryption' ],
    '1.2.840.113549.1.1.14'         => 'sha224WithRSAEncryption',
    '1.2.840.113549.1.1.2'          => [ 'md2WithRSAEncryption', 'MD2 with RSA encryption' ],
    '1.2.840.113549.1.1.3'          => 'md4WithRSAEncryption',
    '1.2.840.113549.1.1.6'          => 'rsaOAEPEncryptionSET',
    '1.2.840.113549.1.1.7'          => 'RSAES-OAEP',
    '1.2.840.113549.1.9.15'         => [ 'smimeCapabilities', 'SMIMECapabilities' ],
    '1.3.14.3.2.26'                 => 'sha1',
    '1.3.14.3.2.29'                 => [ 'sha1WithRSAEncryption', 'SHA1 with RSA signature' ],
    '1.3.6.1.4.1.311.13.1'          => 'RENEWAL_CERTIFICATE',          # Microsoft
    '1.3.6.1.4.1.311.13.2.1'        => 'ENROLLMENT_NAME_VALUE_PAIR',   # Microsoft
    '1.3.6.1.4.1.311.13.2.2'        => 'ENROLLMENT_CSP_PROVIDER',      # Microsoft
    '1.3.6.1.4.1.311.2.1.14'        => 'CERT_EXTENSIONS',              # Microsoft
    '1.3.6.1.5.2.3.5'               => [ 'keyPurposeKdc', 'KDC Authentication' ],
    '1.3.6.1.5.5.7.9.5'             => 'countryOfResidence',
    '2.16.840.1.101.3.4.2.1'        => [ 'sha256', 'SHA-256' ],
    '2.16.840.1.101.3.4.2.2'        => [ 'sha384', 'SHA-384' ],
    '2.16.840.1.101.3.4.2.3'        => [ 'sha512', 'SHA-512' ],
    '2.16.840.1.101.3.4.2.4'        => [ 'sha224', 'SHA-224' ],
    '2.16.840.1.101.3.4.3.1'        => 'dsaWithSha224',
    '2.16.840.1.101.3.4.3.2'        => 'dsaWithSha256',
    '2.16.840.1.101.3.4.3.3'        => 'dsaWithSha384',
    '2.16.840.1.101.3.4.3.4'        => 'dsaWithSha512',
    '2.5.4.12'                      => [ 'title', 'Title' ],
    '2.5.4.13'                      => [ 'description', 'Description' ],
    '2.5.4.14'                      => 'searchGuide',
    '2.5.4.15'                      => 'businessCategory',
    '2.5.4.16'                      => 'postalAddress',
    '2.5.4.17'                      => 'postalCode',
    '2.5.4.18'                      => 'postOfficeBox',
    '2.5.4.19',                     => 'physicalDeliveryOfficeName',
    '2.5.4.20',                     => 'telephoneNumber',
    '2.5.4.23',                     => 'facsimileTelephoneNumber',
    '2.5.4.4'                       => [ 'surname', 'Surname' ],
    '2.5.4.41'                      => [ 'name', 'Name' ],
    '2.5.4.42'                      => 'givenName',
    '2.5.4.43'                      => 'initials',
    '2.5.4.44'                      => 'generationQualifier',
    '2.5.4.45'                      => 'uniqueIdentifier',
    '2.5.4.46'                      => 'dnQualifier',
    '2.5.4.51'                      => 'houseIdentifier',
    '2.5.4.65'                      => 'pseudonym',
    '2.5.4.5'                       => 'serialNumber',
    '2.5.4.9'                       => 'streetAddress',
    '2.5.29.32'                     => 'certificatePolicies',
    '2.5.29.32.0'                   => 'anyPolicy',
    '1.3.6.1.5.5.7.2.1'             => 'CPS',
    '1.3.6.1.5.5.7.2.2'             => 'userNotice',
);

my %variantNames;

foreach (keys %oids) {
    my $val = $oids{$_};
    if( ref $val ) {
	$variantNames{$_} = $val;                   # OID to [ new, trad ]
	$variantNames{$val->[0]} = $val->[1];       # New name to traditional for lookups
	$variantNames{'$' . $val->[1]} = $val->[0]; # \$Traditional to new
	$oids{$_} = $val->[!$apiVersion || 0];
    }
}

my %oid2extkeyusage = (
    '1.3.6.1.5.5.7.3.1'        => 'serverAuth',
    '1.3.6.1.5.5.7.3.2'        => 'clientAuth',
    '1.3.6.1.5.5.7.3.3'        => 'codeSigning',
    '1.3.6.1.5.5.7.3.4'        => 'emailProtection',
    '1.3.6.1.5.5.7.3.8'        => 'timeStamping',
    '1.3.6.1.5.5.7.3.9'        => 'OCSPSigning',

    '1.3.6.1.5.5.7.3.21'       => 'sshClient',
    '1.3.6.1.5.5.7.3.22'       => 'sshServer',

    # Microsoft usages
    '1.3.6.1.4.1.311.10.3.1'   => 'msCTLSign',
    '1.3.6.1.4.1.311.10.3.2'   => 'msTimeStamping',
    '1.3.6.1.4.1.311.10.3.3'   => 'msSGC',
    '1.3.6.1.4.1.311.10.3.4'   => 'msEFS',
    '1.3.6.1.4.1.311.10.3.4.1' => 'msEFSRecovery',
    '1.3.6.1.4.1.311.10.3.5'   => 'msWHQLCrypto',
    '1.3.6.1.4.1.311.10.3.6'   => 'msNT5Crypto',
    '1.3.6.1.4.1.311.10.3.7'   => 'msOEMWHQLCrypto',
    '1.3.6.1.4.1.311.10.3.8'   => 'msEmbeddedNTCrypto',
    '1.3.6.1.4.1.311.10.3.9'   => 'msRootListSigner',
    '1.3.6.1.4.1.311.10.3.10'  => 'msQualifiedSubordination',
    '1.3.6.1.4.1.311.10.3.11'  => 'msKeyRecovery',
    '1.3.6.1.4.1.311.10.3.12'  => 'msDocumentSigning',
    '1.3.6.1.4.1.311.10.3.13'  => 'msLifetimeSigning',
    '1.3.6.1.4.1.311.10.3.14'  => 'msMobileDeviceSoftware',

    '1.3.6.1.4.1.311.2.1.21'   => 'msCodeInd',
    '1.3.6.1.4.1.311.2.1.22'   => 'msCodeCom',
    '1.3.6.1.4.1.311.20.2.2'   => 'msSmartCardLogon',


    # Netscape
    '2.16.840.1.113730.4.1'    => 'nsSGC',
);

my %shortnames = (
    countryName            => 'C',
    stateOrProvinceName    => 'ST',
    organizationName       => 'O',
    organizationalUnitName => 'OU',
    commonName             => 'CN',
#		  emailAddress           => 'E', # Deprecated & not recognized by some software
    domainComponent        => 'DC',
    localityName           => 'L',
    userID                 => 'UID',
    surname                => 'SN',
    givenName              => 'GN',
);

our $schema = <
    DirectoryString ::= CHOICE {
      teletexString   TeletexString,
      printableString PrintableString,
      bmpString       BMPString,
      universalString UniversalString,
      utf8String      UTF8String,
      ia5String       IA5String,
      integer         INTEGER}

    Algorithms ::= ANY

    Name ::= SEQUENCE OF RelativeDistinguishedName
    RelativeDistinguishedName ::= SET OF AttributeTypeAndValue
    AttributeTypeAndValue ::= SEQUENCE {
      type  OBJECT IDENTIFIER,
      value DirectoryString}

    Attributes ::= SET OF Attribute
    Attribute ::= SEQUENCE {
      type   OBJECT IDENTIFIER,
      values SET OF ANY}


    AlgorithmIdentifier ::= SEQUENCE {
      algorithm  OBJECT IDENTIFIER,
      parameters Algorithms OPTIONAL}

    SubjectPublicKeyInfo ::= SEQUENCE {
      algorithm        AlgorithmIdentifier,
      subjectPublicKey BIT STRING}

    --- Certificate Request ---

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

    CertificationRequestInfo ::= SEQUENCE {
      version       INTEGER ,
      subject       Name OPTIONAL,
      subjectPKInfo SubjectPublicKeyInfo,
      attributes    [0] Attributes OPTIONAL}

    --- Extensions ---

    BasicConstraints ::= SEQUENCE {
        cA                  BOOLEAN OPTIONAL, -- DEFAULT FALSE,
        pathLenConstraint   INTEGER OPTIONAL}

    OS_Version ::= IA5String
    emailAddress ::= IA5String

    EnrollmentCSP ::= SEQUENCE {
        KeySpec     INTEGER,
        Name        BMPString,
        Signature   BIT STRING}

    ENROLLMENT_CSP_PROVIDER ::= SEQUENCE { -- MSDN
        keySpec     INTEGER,
        cspName     BMPString,
        signature   BIT STRING}

    ENROLLMENT_NAME_VALUE_PAIR ::= EnrollmentNameValuePair -- MSDN: SEQUENCE OF

    EnrollmentNameValuePair ::= SEQUENCE { -- MSDN
         name       BMPString,
         value      BMPString}

    ClientInformation ::= SEQUENCE { -- MSDN
        clientId       INTEGER,
        MachineName    UTF8String,
        UserName       UTF8String,
        ProcessName    UTF8String}

    extensionRequest ::= SEQUENCE OF Extension
    Extension ::= SEQUENCE {
      extnID    OBJECT IDENTIFIER,
      critical  BOOLEAN OPTIONAL,
      extnValue OCTET STRING}

    SubjectKeyIdentifier ::= OCTET STRING

    certificateTemplate ::= SEQUENCE {
       templateID              OBJECT IDENTIFIER,
       templateMajorVersion    INTEGER OPTIONAL, -- (0..4294967295)
       templateMinorVersion    INTEGER OPTIONAL} -- (0..4294967295)

    EnhancedKeyUsage ::= SEQUENCE OF OBJECT IDENTIFIER
    KeyUsage ::= BIT STRING
    netscapeCertType ::= BIT STRING

    ApplicationCertPolicies ::= SEQUENCE OF PolicyInformation -- Microsoft

    PolicyInformation ::= SEQUENCE {
        policyIdentifier   OBJECT IDENTIFIER,
        policyQualifiers   SEQUENCE OF PolicyQualifierInfo OPTIONAL}

    PolicyQualifierInfo ::= SEQUENCE {
       policyQualifierId    OBJECT IDENTIFIER,
       qualifier            ANY}

    certificatePolicies ::= SEQUENCE OF certPolicyInformation -- RFC 3280

    certPolicyInformation ::= SEQUENCE {
        policyIdentifier    CertPolicyId,
        policyQualifier     SEQUENCE OF certPolicyQualifierInfo OPTIONAL}

    CertPolicyId ::= OBJECT IDENTIFIER

    certPolicyQualifierInfo ::= SEQUENCE {
        policyQualifierId CertPolicyQualifierId,
        qualifier         ANY DEFINED BY policyQualifierId}

    CertPolicyQualifierId ::= OBJECT IDENTIFIER

    CertPolicyQualifier ::= CHOICE {
        cPSuri     CPSuri,
        userNotice UserNotice }

    CPSuri ::= IA5String

    UserNotice ::= SEQUENCE {
        noticeRef     NoticeReference OPTIONAL,
        explicitText  DisplayText OPTIONAL}

    NoticeReference ::= SEQUENCE {
        organization     DisplayText,
        noticeNumbers    SEQUENCE OF INTEGER }

    DisplayText ::= CHOICE {
        ia5String        IA5String,
        visibleString    VisibleString,
        bmpString        BMPString,
        utf8String       UTF8String }

    unstructuredName ::= CHOICE {
        Ia5String       IA5String,
        directoryString DirectoryString}

    challengePassword ::= DirectoryString

    subjectAltName ::= SEQUENCE OF GeneralName

    GeneralName ::= CHOICE {
         otherName                       [0]     AnotherName,
         rfc822Name                      [1]     IA5String,
         dNSName                         [2]     IA5String,
         x400Address                     [3]     ANY, --ORAddress,
         directoryName                   [4]     Name,
         ediPartyName                    [5]     EDIPartyName,
         uniformResourceIdentifier       [6]     IA5String,
         iPAddress                       [7]     OCTET STRING,
         registeredID                    [8]     OBJECT IDENTIFIER}

    AnotherName ::= SEQUENCE {
         type           OBJECT IDENTIFIER,
         value      [0] EXPLICIT ANY }

    EDIPartyName ::= SEQUENCE {
         nameAssigner            [0]     DirectoryString OPTIONAL,
         partyName               [1]     DirectoryString }

    certificateTemplateName ::= CHOICE {
        octets          OCTET STRING,
        directoryString DirectoryString}

    rsaKey ::= SEQUENCE {
        modulus         INTEGER,
        publicExponent  INTEGER}

    dsaKey  ::= INTEGER

    dsaPars ::= SEQUENCE {
        P               INTEGER,
        Q               INTEGER,
        G               INTEGER}

    eccName ::= OBJECT IDENTIFIER

    ecdsaSigValue ::= SEQUENCE {
        r               INTEGER,
        s               INTEGER}

    rsassaPssParam ::= SEQUENCE {
        digestAlgorithm     [0] EXPLICIT AlgorithmIdentifier OPTIONAL,
        maskGenAlgorithm    [1] EXPLICIT AlgorithmIdentifier OPTIONAL,
        saltLength          [2] EXPLICIT INTEGER OPTIONAL,
        trailerField        [3] EXPLICIT INTEGER OPTIONAL}
ASN1
;

my %name2oid;

# For generating documentation, not part of API

sub _cmpOID {
    my @a = split( /\./, $a );
    my @b = split( /\./, $b );

    while( @a && @b ) {
        my $c = shift @a <=> shift @b;
        return $c if( $c );
    }
    return @a <=> @b;
}

sub __listOIDs {
    my $class = shift;
    my ( $hash ) = @_;

    my @max = (0) x 3;
    foreach my $oid ( keys %$hash ) {
	my $len;

	$len = length $oid;
	$max[0] = $len if( $len > $max[0] );
	if( exists $variantNames{$oid} ) {
	    $len = length $variantNames{$oid}[0];
	    $max[1] = $len if( $len > $max[1] );
	    $len = length $variantNames{$oid}[1];
	    $max[2] = $len if( $len > $max[2] );
	} else {
	    $len = length $hash->{$oid};
	    $max[1] = $len if( $len > $max[1] );
	}
    }

    printf( " %-*s %-*s %s\n %s %s %s\n", $max[0], 'OID',
	                                  $max[1], 'Name (API v1)', 'Old Name (API v0)',
	                                  '-' x $max[0], '-' x $max[1], '-' x $max[2] );

    foreach my $oid ( sort _cmpOID keys %$hash ) {
	printf( " %-*s %-*s", $max[0], $oid, $max[1], (exists $variantNames{$oid})?
		                                         $variantNames{$oid}[0]: $hash->{$oid} );
	printf( " (%-s)", $variantNames{$oid}[1] ) if( exists $variantNames{$oid} );
	print( "\n" );
    }
    return;
}

sub _listOIDs {
    my $class = shift;

    $class->setAPIversion(1);
    $class-> __listOIDs( { %oids, %oid2extkeyusage } );

    return;
}

sub setAPIversion {
    my( $class, $version ) = @_;

    croak( substr(($error = "Wrong number of arguments\n"), 0, -1) ) unless( @_ == 2 && defined $class && !ref $class );
    $version = 0 unless( defined $version );
    croak( substr(($error = "Unsupported API version $version\n"), 0, -1) ) unless( $version >= 0 && $version <= 1 );
    $apiVersion = $version;

    $version = !$version || 0;

    foreach (keys %variantNames) {
	$oids{$_} = $variantNames{$_}[$version] if( /^\d/ ); # Map OID to selected name
    }
    %name2oid = reverse (%oids, %oid2extkeyusage);

    return 1;
}

sub getAPIversion {
    my( $class ) = @_;

    croak( "Class not specified for getAPIversion()" ) unless( defined $class );

    return $class->{_apiVersion} if( ref $class && $class->isa( __PACKAGE__ ) );

    return $apiVersion;
}

sub name2oid {
    my $class = shift;
    my( $oid ) = @_;

    croak( "Class not specifed for name2oid()" ) unless( defined $class );

    return unless( defined $oid && defined $apiVersion && $apiVersion > 0 );

    return $name2oid{$oid};
}

sub oid2name {
    my $class = shift;
    my( $oid ) = @_;

    croak( "Class not specifed for oid2name()" ) unless( defined $class );

    return $oid unless( defined $apiVersion && $apiVersion > 0 );

    return $class->_oid2name( @_ );
}

# Should not be exported, as overloading may break ASN lookups

sub _oid2name {
    my $class = shift;
    my( $oid ) = @_;

    return unless($oid);

    if( exists $oids{$oid} ) {
	$oid = $oids{$oid};
    }elsif( exists $oid2extkeyusage{$oid} ) {
	$oid = $oid2extkeyusage{$oid};
    }
    return $oid;
}

# registerOID( $oid ) => true if $oid is registered, false if not
# registerOID( $oid, $longname ) => Register an OID with its name
# registerOID( $oid, $longname, $shortname ) => Register an OID with an abbreviation for RDNs.
# registerOID( $oid, undef, $shortname ) => Register an abbreviation for RDNs for an existing OID

sub registerOID {
    my( $class, $oid, $longname, $shortname ) = @_;

    croak( "Class not specifed for registerOID()" ) unless( defined $class );

    unless( defined $apiVersion ) {
	carp( "${class}::setAPIversion MUST be called before registerOID().  Defaulting to legacy mode" );
	$class->setAPIversion(0);
    }

    return exists $oids{$oid} || exists $oid2extkeyusage{$oid} if( @_ == 2 && defined $oid );

    croak( "Not enough arguments" )              unless( @_ >= 3 && defined $oid && ( defined $longname || defined $shortname ) );
    croak( "Invalid OID $oid" )                  unless( defined $oid && $oid =~ /^\d+(?:\.\d+)*$/ );

    if( defined $longname ) {
        croak( "$oid already registered" )       if( exists $oids{$oid} || exists $oid2extkeyusage{$oid} );
        croak( "$longname already registered" )  if( grep /^$longname$/, values %oids );
    } else {
        croak( "$oid not registered" )           unless( exists $oids{$oid} || exists $oid2extkeyusage{$oid} );
    }
    croak( "$shortname already registered" )     if( defined $shortname && grep /^\U$shortname\E$/,
						                                          values %shortnames );

    if( defined $longname ) {
        $oids{$oid} = $longname;
        $name2oid{$longname} = $oid;
    } else {
        $longname = $class->_oid2name( $oid );
    }
    $shortnames{$longname} = uc $shortname       if( defined $shortname );
    return 1;
}

sub new {
    my $class = shift;

    undef $error;

    $class = ref $class if( defined $class && ref $class && $class->isa( __PACKAGE__ ) );

    unless( defined $apiVersion ) {
	carp( "${class}::setAPIversion MUST be called before new().  Defaulting to legacy mode" );
	$class->setAPIversion(0);
    }

    my( $void, $die ) = ( !defined wantarray, 0 );
    my $self = eval {
        die( "Insufficient arguments for new\n" ) unless( defined $class && @_ >= 1 );
        die( "Value of Crypt::PKCS10->new ignored\n" ) if( $void );
	return $class->_new( \$die, @_ );
    }; if( $@ ) {
	$error = $@;
        if( !$apiVersion || $die || !defined wantarray ) {
            1 while( chomp $@ );
            croak( $@ );
        }
	return;
    }

    return $self;
}

sub error {
    my $class = shift;

    croak( "Class not specifed for error()" ) unless( defined $class );

    if( ref $class && $class->isa( __PACKAGE__ ) ) {
        return $class->{_error};
    }
    return $error;
}

my $pemre = qr/(?ms:^\r?-----BEGIN\s(?:NEW\s)?CERTIFICATE\sREQUEST-----\s*\r?\n\s*(.*?)\s*^\r?-----END\s(?:NEW\s)?CERTIFICATE\sREQUEST-----\r?$)/;

sub _new {
    my( $class, $die, $der ) = splice( @_, 0, 3 );

    my %options = (
                   acceptPEM       => 1,
                   PEMonly         => 0,
                   escapeStrings   => 1,
                   readFile        => 0,
                   ignoreNonBase64 => 0,
                   verifySignature => ($apiVersion >= 1),
                   dieOnError      => 0,
                  );

    %options = ( %options, %{ shift @_ } ) if( @_ >= 1 && ref( $_[0] ) eq 'HASH' );

    die( "Every option to new() must have a value\n" ) unless( @_ % 2 == 0 );

    %options = ( %options, @_ ) if( @_ );

    my $self = { _apiVersion => $apiVersion };

    my $keys = join( '|', qw/escapeStrings acceptPEM PEMonly binaryMode readFile verifySignature ignoreNonBase64 warnings dieOnError/ );

    $self->{"_$_"} = delete $options{$_} foreach (grep { /^(?:$keys)$/ } keys %options);

    $$die = $self->{_dieOnError} &&= $apiVersion >= 1;

    die( "\$csr argument to new() is not defined\n" ) unless( defined $der );

    if( keys %options ) {
	die( "Invalid option(s) specified: " . join( ', ', sort keys %options ) . "\n" );
    }

    $self->{_binaryMode} = !$self->{_acceptPEM} unless( exists $self->{_binaryMode} );

    my $parser;

    # malformed requests can produce various warnings; don't proceed in that case.

    local $SIG{__WARN__} = sub { my $msg = $_[0]; $msg =~ s/\A(.*?) at .*\Z/$1/s; 1 while( chomp $msg ); die "$msg\n" };

    if( $self->{_readFile} ) {
        open( my $fh, '<', $der ) or die( "Failed to open $der: $!\n" );
        $der = $fh;
    }

    if( Scalar::Util::openhandle( $der ) ) {
	local $/;

	binmode $der if( $self->{_binaryMode} );

	$der = <$der>;          # Note: this closes files opened by readFile
	die( "Failed to read request: $!\n" ) unless( defined $der );
    }

    my $isPEM;

    if( $self->{_PEMonly} ) {
        if( $der =~ $pemre ) {
            $der = $1;
            $isPEM = 1;
        } else {
            die( "No certificate request found\n" );
        }
    } elsif( $self->{_acceptPEM} && $der =~ $pemre ) {
        $der = $1;
        $isPEM = 1;
    }
    if( $isPEM ) {
	# Some versions of MIME::Base64 check the input.  Some don't.  Those that do
	# seem to obey -w, but not 'use warnings'.  So we'll check here.

	$der =~ s/\s+//g; # Delete whitespace, which is legal but meaningless
        $der =~ tr~A-Za-z0-9+=/~~cd if( $self->{_ignoreNonBase64} );

	unless( $der =~ m{\A[A-Za-z0-9+/]+={0,2}\z} && ( length( $der ) % 4 == 0 ) ) {
	    warn( "Invalid base64 encoding\n" ); # Invalid character or length
	}
        $der = decode_base64( $der );
    }

    # some requests may contain information outside of the regular ASN.1 structure.
    # This padding must be removed.

    $der = eval { # Catch out of range errors caused by bad DER & report as format errors.
        # SEQUENCE  -- CertificationRequest

        my( $tlen, undef, $tag ) = asn_decode_tag2( $der );
        die( "SEQUENCE not present\n" ) unless( $tlen && $tag == ASN_SEQUENCE );

        my( $llen, $len ) = asn_decode_length( substr( $der, $tlen ) );
        die( "Invalid SEQUENCE length\n" ) unless( $llen && $len );

        $len += $tlen + $llen;
        $tlen = length $der;
        die( "DER too short to contain request\n" ) if( $tlen < $len );

        if( $tlen != $len && $self->{_warnings} ) { # Debugging
            local $SIG{__WARN__};
            carp( sprintf( "DER length of %u contains %u bytes of padding",
                           $tlen, $tlen - $len ) );
        }
        return substr( $der, 0, $len );
    }; if( $@ ) {
        1 while( chomp $@ );
        die( "Invalid format for request: $@\n" );
    }

    $self->{_der} = $der;

    bless( $self, $class );

    $self->{_bmpenc} = Encode::find_encoding('UCS2-BE');

    my $asn = Convert::ASN1->new;
    $self->{_asn} = $asn;
    $asn->prepare($schema) or die( "Internal error in " . __PACKAGE__ . ": " . $asn->error );

    $asn->registertype( 'qualifier', '1.3.6.1.5.5.7.2.1', $self->_init('CPSuri') );
    $asn->registertype( 'qualifier', '1.3.6.1.5.5.7.2.2', $self->_init('UserNotice') );

    $parser = $self->_init( 'CertificationRequest' );

    my $top =
	$parser->decode( $der ) or
	  confess( "decode: " . $parser->error .
		   "Cannot handle input or missing ASN.1 definitions" );

    $self->{certificationRequestInfo}{subject_raw}
        = $top->{certificationRequestInfo}{subject};

    $self->{certificationRequestInfo}{subject}
        = $self->_convert_rdn( $top->{certificationRequestInfo}{subject} );

    $self->{certificationRequestInfo}{version}
        = $top->{certificationRequestInfo}{version};

    $self->{certificationRequestInfo}{attributes} = $self->_convert_attributes(
        $top->{certificationRequestInfo}{attributes} );

    $self->{_pubkey} = "-----BEGIN PUBLIC KEY-----\n" .
      _encode_PEM( $self->_init('SubjectPublicKeyInfo')->
                   encode( $top->{certificationRequestInfo}{subjectPKInfo} ) ) .
                     "-----END PUBLIC KEY-----\n";

    $self->{certificationRequestInfo}{subjectPKInfo} = $self->_convert_pkinfo(
        $top->{certificationRequestInfo}{subjectPKInfo} );

    $self->{signature} = $top->{signature};

    $self->{signatureAlgorithm}
        = $self->_convert_signatureAlgorithm( $top->{signatureAlgorithm} );

    # parse parameters for RSA PSS
    if ($self->{signatureAlgorithm}{algorithm} eq 'rsassaPss') {
        my $params = $self->_init('rsassaPssParam')
            ->decode($self->{signatureAlgorithm}{parameters});

        my $sigInfo = {
            'saltLength' => ($params->{saltLength} || 20),
            'digestAlgorithm' => 'sha1',
        };
        $sigInfo->{digestAlgorithm} = $self->_oid2name($params->{digestAlgorithm}{algorithm})
            if($params->{digestAlgorithm}{algorithm});

        $sigInfo->{maskGenAlgorithm} = $self->_oid2name($params->{maskGenAlgorithm}{algorithm})
            if($params->{maskGenAlgorithm}{algorithm});

        $self->{signatureAlgorithm}{parameters} = $sigInfo;
    }

    # Extract bundle of bits that is signed
    # The DER is SEQUENCE -- CertificationRequest
    #              SEQUENCE -- CertificationRequestInfo [SIGNED]

    my( $CRtaglen, $CRtag, $CRllen, $CRlen );
    ($CRtaglen, undef, $CRtag) = asn_decode_tag2( $der );
    die( "Invalid CSR format: missing SEQUENCE 1\n" ) unless( $CRtag == ASN_SEQUENCE );
    ($CRllen, $CRlen) = asn_decode_length( substr( $der, $CRtaglen ) );

    my( $CItaglen, $CItag, $CIllen, $CIlen );
    ($CItaglen, undef, $CItag) = asn_decode_tag2( substr( $der, $CRtaglen + $CRllen ) );
    die( "Invalid CSR format: missing SEQUENCE 2\n" ) unless( $CItag == ASN_SEQUENCE );
    ($CIllen, $CIlen) = asn_decode_length( substr( $der, $CRtaglen + $CRllen + $CItaglen ) );

    $self->{_signed} = substr( $der, $CRtaglen +  $CRllen, $CItaglen + $CIllen + $CIlen );

    die( $error ) if( $self->{_verifySignature} && !$self->checkSignature );

    return $self;
}

# Convert::ASN1 returns BMPStrings as 16-bit fixed-width characters, e.g. UCS2-BE

sub _bmpstring {
    my $self = shift;

    my $enc = $self->{_bmpenc};

    $_ = $enc->decode( $_ ) foreach (@_);

    return;
}

# Find the obvious BMPStrings in a value and convert them
# This doesn't catch direct values, but does find them in hashes
# (generally as a result of a CHOICE)
#
# Convert iPAddresses as well

sub _scanvalue {
    my $self = shift;

    my( $value ) = @_;

    return unless( ref $value );
    if( ref $value eq 'ARRAY' ) {
	foreach (@$value) {
	    $self->_scanvalue( $_ );
	}
	return;
    }
    if( ref $value eq 'HASH' ) {
	foreach my $k (keys %$value) {
	    if( $k eq 'bmpString' ) {
		$self->_bmpstring( $value->{bmpString} );
		next;
	    }
	    if( $k eq 'iPAddress' ) {
		use bytes;
		my $addr = $value->{iPAddress};
		if( length $addr == 4 ) {
		    $value->{iPAddress} = sprintf( '%vd', $addr );
		} else {
		    $addr = sprintf( '%*v02X', ':', $addr );
		    $addr =~ s/([[:xdigit:]]{2}):([[:xdigit:]]{2})/$1$2/g;
		    $value->{iPAddress} = $addr;
		}
		next;
	    }
	    $self->_scanvalue( $value->{$k} );
	}
	return;
    }
    return;
}

sub _convert_signatureAlgorithm {
    my $self = shift;

    my $signatureAlgorithm = shift;
    $signatureAlgorithm->{algorithm}
        = $oids{$signatureAlgorithm->{algorithm}}
	  if( defined $signatureAlgorithm->{algorithm}
	    && exists $oids{$signatureAlgorithm->{algorithm}} );

    return $signatureAlgorithm;
}

sub _convert_pkinfo {
    my $self = shift;

    my $pkinfo = shift;

    $pkinfo->{algorithm}{algorithm}
        = $oids{$pkinfo->{algorithm}{algorithm}}
	  if( defined $pkinfo->{algorithm}{algorithm}
	    && exists $oids{$pkinfo->{algorithm}{algorithm}} );
    return $pkinfo;
}

# OIDs requiring some sort of special handling
#
# Called with decoded value, returns updated value.
# Key is ASN macro name

my %special;
%special =
(
 EnhancedKeyUsage => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     foreach (@{$value}) {
	 $_ = $oid2extkeyusage{$_} if(defined $oid2extkeyusage{$_});
     }
     return $value;
 },
 KeyUsage => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     my $bit =  unpack('C*', @{$value}[0]); #get the decimal representation
     my $length = int(log($bit) / log(2) + 1); #get its bit length
     my @usages = reverse( $id eq 'KeyUsage'? # Following are in order from bit 0 upwards
			   qw(digitalSignature nonRepudiation keyEncipherment dataEncipherment
                              keyAgreement keyCertSign cRLSign encipherOnly decipherOnly) :
			   qw(client server email objsign reserved sslCA emailCA objCA) );
     my $shift = ($#usages + 1) - $length; # computes the unused area in @usages

     @usages = @usages[ grep { $bit & (1 << $_ - $shift) } 0 .. $#usages ]; #transfer bitmap to barewords

     return [ @usages ] if( $self->{_apiVersion} >= 1 );

     return join( ', ', @usages );
 },
 netscapeCertType => sub {
     goto &{$special{KeyUsage}};
 },
 SubjectKeyIdentifier => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     return unpack( "H*", $value );
 },
 ApplicationCertPolicies => sub {
     goto &{$special{certificatePolicies}} if( $_[0]->{_apiVersion} > 0 );

     my $self = shift;
     my( $value, $id ) = @_;

     foreach my $entry (@{$value}) {
	 $entry->{policyIdentifier} = $self->_oid2name( $entry->{policyIdentifier} );
     }

     return $value;
 },
 certificateTemplate => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     $value->{templateID} = $self->_oid2name( $value->{templateID} ) if( $self->{_apiVersion} > 0 );
     return $value;
 },
 EnrollmentCSP => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     $self->_bmpstring( $value->{Name} );

     return $value;
 },
 ENROLLMENT_CSP_PROVIDER => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     $self->_bmpstring( $value->{cspName} );

     return $value;
 },
 certificatePolicies => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     foreach my $policy (@$value) {
	 $policy->{policyIdentifier} = $self->_oid2name( $policy->{policyIdentifier} );
	 if( exists $policy->{policyQualifier} ) {
	     foreach my $qualifier (@{$policy->{policyQualifier}}) {
		 $qualifier->{policyQualifierId} = $self->_oid2name( $qualifier->{policyQualifierId} );
		 my $qv = $qualifier->{qualifier};
		 if( ref $qv eq 'HASH' ) {
		     foreach my $qt (keys %$qv) {
			 if( $qt eq 'explicitText' ) {
			     $qv->{$qt} = (values %{$qv->{$qt}})[0];
			 } elsif( $qt eq 'noticeRef' ) {
			     my $userNotice = $qv->{$qt};
			     $userNotice->{organization} = (values %{$userNotice->{organization}})[0];
			 }
		     }
		     $qv->{userNotice} = delete $qv->{noticeRef}
		       if( exists $qv->{noticeRef} );
		 }
	     }
	 }
     }
     return $value;
 },
 CERT_EXTENSIONS => sub {
     my $self = shift;
     my( $value, $id, $entry ) = @_;

     return $self->_convert_extensionRequest( [ $value ] ) if( $self->{_apiVersion} > 0 ); # Untested
 },
 BasicConstraints => sub {
     my $self = shift;
     my( $value, $id, $entry ) = @_;

     my $r = {
	      CA => $value->{cA}? 'TRUE' : 'FALSE',
	     };
     my $string = "CA:$r->{CA}";

     if( exists $value->{pathLenConstraint} ) {
	 $r->{pathlen} = $value->{pathLenConstraint};
	 $string .= sprintf( ',pathlen:%u', $value->{pathLenConstraint} );
     }
     $entry->{_FMT} = [ $r, $string ]; # [ Raw, formatted ]
     return $value;
 },
 unstructuredName => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     return $self->_hash2string( $value );
 },
 challengePassword => sub {
     my $self = shift;
     my( $value, $id ) = @_;

     return $self->_hash2string( $value );
 },
); # %special

sub _convert_attributes {
    my $self = shift;
    my( $typeandvalues ) = @_;

    foreach my $entry ( @{$typeandvalues} ) {
    my $oid = $entry->{type};
    my $name = $oids{$oid};
    $name = $variantNames{$name} if( defined $name && exists $variantNames{$name} );

    next unless( defined $name );

    $entry->{type} = $name;

    if ($name eq 'extensionRequest') {
        $entry->{values} = $self->_convert_extensionRequest($entry->{values}[0]);

    } elsif ($name eq 'ENROLLMENT_NAME_VALUE_PAIR') {
        my $parser = $self->_init( $name );
        my @values;
        foreach my $der (@{$entry->{values}}) {
            my $pair = $parser->decode( $der ) or
                confess( "Looks like damaged input parsing attribute $name" );
                $self->_bmpstring( $pair->{name}, $pair->{value} );
            push @values, $pair;
        };
        $entry->{values} = \@values;

    } else {
        my $parser = $self->_init( $name, 1 ) or next; # Skip unknown attributes

        if($entry->{values}[1]) {
            confess( "Incomplete parsing of attribute type: $name" );
        }
        my $value = $entry->{values} = $parser->decode( $entry->{values}[0] ) or
        confess( "Looks like damaged input parsing attribute $name" );

        if( exists $special{$name} ) {
        my $action = $special{$name};
        $entry->{values} = $action->( $self, $value, $name, $entry );
        }
    }
    }
    return $typeandvalues;
}

sub _convert_extensionRequest {
    my $self = shift;
    my( $extensionRequest ) = @_;

    my $parser = $self->_init('extensionRequest');
    my $decoded = $parser->decode($extensionRequest) or return [];

    foreach my $entry (@{$decoded}) {
	my $name = $oids{ $entry->{extnID} };
	$name = $variantNames{$name} if( defined $name && exists $variantNames{$name} );
        if (defined $name) {
	    my $asnName = $name;
	    $asnName =~ tr/ //d;
            my $parser = $self->_init($asnName, 1);
            if(!$parser) {
                $entry = undef;
                next;
            }
            $entry->{extnID} = $name;
            my $dec = $parser->decode($entry->{extnValue}) or
	      confess( $parser->error . ".. looks like damaged input parsing extension $asnName" );

	    $self->_scanvalue( $dec );

	    if( exists $special{$asnName} ) {
		my $action = $special{$asnName};
		$dec = $action->( $self, $dec, $asnName, $entry );
	    }
	    $entry->{extnValue} = $dec;
        }
    }
    @{$decoded} = grep { defined } @{$decoded};
    return $decoded;
}

sub _convert_rdn {
    my $self = shift;
    my $typeandvalue = shift;
    my %hash = ( _subject => [], );
    foreach my $entry ( @$typeandvalue ) {
	foreach my $item (@$entry) {
	    my $oid = $item->{type};
	    my $name = (exists $variantNames{$oid})? $variantNames{$oid}[1]: $oids{ $oid };
	    if( defined $name ) {
		push @{$hash{$name}}, sort values %{$item->{value}};
		push @{$hash{_subject}}, $name, [ sort values %{$item->{value}} ];
		my @names = (exists $variantNames{$oid})? @{$variantNames{$oid}} : ( $name );
		foreach my $name ( @names ) {
		    unless( $self->can( $name ) ) {
			no strict 'refs'; ## no critic
			*$name =  sub {
			    my $self = shift;
			    return @{ $self->{certificationRequestInfo}{subject}{$name} } if( wantarray );
			    return $self->{certificationRequestInfo}{subject}{$name}[0] || '';
			}
		    }
		}
	    }
	}
    }

    return \%hash;
}

sub _init {
    my $self = shift;
    my( $node, $optional ) = @_;

    my $parsed = $self->{_asn}->find($node);

    unless( defined $parsed || $optional ) {
	croak( "Missing node $node in ASN.1" );
    }
    return $parsed;
}

###########################################################################
# interface methods

sub csrRequest {
    my $self = shift;
    my $format = shift;

    return( "-----BEGIN CERTIFICATE REQUEST-----\n" .
	    _encode_PEM( $self->{_der} ) .
	    "-----END CERTIFICATE REQUEST-----\n" ) if( $format );

    return $self->{_der};
}

# Common subject components documented to be always present:

foreach my $component (qw/commonName organizationalUnitName organizationName
                          emailAddress stateOrProvinceName countryName domainComponent/ ) {
    no strict 'refs'; ## no critic

    unless( defined &$component ) {
	*$component = sub {
	    my $self = shift;
	    return @{ $self->{certificationRequestInfo}{subject}{$component} || [] } if( wantarray );
	    return $self->{certificationRequestInfo}{subject}{$component}[0] || '';
	}
    }
}

# Complete subject

sub subject {
    my $self = shift;
    my $long = shift;

    return @{ $self->{certificationRequestInfo}{subject}{_subject} } if( wantarray );

    my @subject = @{ $self->{certificationRequestInfo}{subject}{_subject} };

    my $subj = '';
    while( @subject ) {
	my( $name, $value ) = splice( @subject, 0, 2 );
	$name = $shortnames{$name} if( !$long && exists $shortnames{$name} );
	$subj .= "/$name=" . join( ',', @$value );
    }

    return $subj;
}


sub subjectRaw {

    my $self = shift;
    my @subject;
    foreach my $rdn (@{$self->{certificationRequestInfo}{subject_raw}}) {
        my @sequence = map {
            $_->{format} = (keys %{$_->{value}})[0];
            $_->{value} = (values %{$_->{value}})[0];
            $_;
        } @{$rdn};
        if (scalar @sequence > 1) {
            push @subject, \@sequence;
        } else {
            push @subject, $sequence[0];
        }
    }
    return \@subject;

}


sub subjectAltName {
    my $self = shift;
    my( $type ) = @_;

    my $san = $self->extensionValue( 'subjectAltName' );
    unless( defined $san ) {
	return () if( wantarray );
	return undef;  ## no critic
    }

    if( !defined $type ) {
	if( wantarray ) {
	    my %comps;
	    $comps{$_} = 1 foreach (map { keys %$_ } @$san);
	    return sort keys %comps; ## no critic
	}
	my @string;
	foreach my $comp (@$san) {
	    push @string, join( '+', map { "$_:$comp->{$_}" } sort keys %$comp );
	}
	return join( ',', @string );
    }

    my $result = [ map { $_->{$type} } grep { exists $_->{$type} } @$san ];

    return @$result if( wantarray );
    return $result->[0];
}

sub version {
    my $self = shift;
    my $v = $self->{certificationRequestInfo}{version};
    return sprintf( "v%u", $v+1 );
}

sub pkAlgorithm {
    my $self = shift;
    return $self->{certificationRequestInfo}{subjectPKInfo}{algorithm}{algorithm};
}

sub subjectPublicKey {
    my $self = shift;
    my $format = shift;

    return $self->{_pubkey} if( $format );
    return unpack('H*', $self->{certificationRequestInfo}{subjectPKInfo}{subjectPublicKey}[0]);
}

sub subjectPublicKeyParams {
    my $self = shift;
    my $detail = shift;

    croak( "Requires API version 1" ) unless( $self->{_apiVersion} >= 1 );

    undef $error;
    delete $self->{_error};

    my $rv = {};
    my $at = $self->pkAlgorithm;
    $at = 'undef' unless( defined $at );


    # this is wrong but unfortunately seen in the wild
    if( $at eq 'rsassaPss') {
        $at = 'rsaEncryption';
        warn 'Got rsassaPss as pkAlgorithm - converting to RSA';
    }

    if( $at eq 'rsaEncryption' ) {
        $rv->{keytype} = 'RSA';
        my $par = $self->_init( 'rsaKey' );
        my $rsa = $par->decode( $self->{certificationRequestInfo}{subjectPKInfo}{subjectPublicKey}[0] );
        $rv->{keylen} = 4 * ( length( $rsa->{modulus}->as_hex ) -2 ); # 2 == length( '0x' )
        $rv->{modulus} = substr( $rsa->{modulus}->as_hex, 2 );
        $rv->{publicExponent} = ( ref( $rsa->{publicExponent} )?
                                  $rsa->{publicExponent}->as_hex :
                                  sprintf( '%x', $rsa->{publicExponent} ) );
    } elsif( $at eq 'ecPublicKey' ) {
        $rv->{keytype} = 'ECC';

        eval { require Crypt::PK::ECC; };
        if( $@ ) {
            $rv->{keytype} = undef;
            $self->{_error} =
              $error = "ECC public key requires Crypt::PK::ECC\n";
            croak( $error ) if( $self->{_dieOnError} );
            return $rv;
        }
        my $key = $self->subjectPublicKey(1);
        $key = Crypt::PK::ECC->new( \$key )->key2hash;
        $rv->{keylen} = $key->{curve_bits};
        $rv->{pub_x}  = $key->{pub_x};
        $rv->{pub_y}  = $key->{pub_y};
        $rv->{detail} = { %$key } if( $detail );

        my $par = $self->_init( 'eccName' );
        $rv->{curve} = $par->decode( $self->{certificationRequestInfo}{subjectPKInfo}{algorithm}{parameters} );
        $rv->{curve} = $self->_oid2name( $rv->{curve} ) if ($rv->{curve});
    } elsif( $at eq 'dsa' ) {
        $rv->{keytype} = 'DSA';
        my $par = $self->_init( 'dsaKey' );
        my $dsa = $par->decode( $self->{certificationRequestInfo}{subjectPKInfo}{subjectPublicKey}[0] );
        $rv->{keylen} = 4 * ( length( $dsa->as_hex ) -2 );
        if( exists $self->{certificationRequestInfo}{subjectPKInfo}{algorithm}{parameters} ) {
            $par = $self->_init('dsaPars');
            $dsa = $par->decode($self->{certificationRequestInfo}{subjectPKInfo}{algorithm}{parameters});
            $rv->{G} = substr( $dsa->{G}->as_hex, 2 );
            $rv->{P} = substr( $dsa->{P}->as_hex, 2 );
            $rv->{Q} = substr( $dsa->{Q}->as_hex, 2 );
        }
    } else {
        $rv->{keytype} = undef;
        $self->{_error} =
          $error = "Unrecognized public key type $at\n";
        croak( $error ) if( $self->{_dieOnError} );
    }
    return $rv;
}

sub signatureAlgorithm {
    my $self = shift;
    return $self->{signatureAlgorithm}{algorithm};
}

sub signatureParams {
    my $self = shift;

    return unless ( exists $self->{signatureAlgorithm}{parameters} );

    # For RSA PSS the parameters have been parsed to a hash already
    if (ref $self->{signatureAlgorithm}{parameters} eq 'HASH') {
        return $self->{signatureAlgorithm}{parameters};
    }

    my( $tlen, undef, $tag ) = asn_decode_tag2( $self->{signatureAlgorithm}{parameters} );
    if( $tlen != 0 && $tag != ASN_NULL ) {
        return $self->{signatureAlgorithm}{parameters}
    }
    # Known algorithm's parameters MAY return a hash of decoded fields.
    # For now, leaving that to the caller...

    return;
}

sub signature {
    my $self = shift;
    my $format = shift;

    if( defined $format && $format == 2 ) { # Per keytype decoding
        if( $self->pkAlgorithm eq 'ecPublicKey' ) { # ECDSA
            my $par = $self->_init( 'ecdsaSigValue' );
            return $par->decode( $self->{signature}[0] );
        }
        return;                             # Unknown
    }
    return $self->{signature}[0] if( $format );

    return unpack('H*', $self->{signature}[0]);
}

sub certificationRequest {
    my $self = shift;

    return $self->{_signed};
}

sub _attributes {
    my $self = shift;

    my $attributes = $self->{certificationRequestInfo}{attributes};
    return unless( defined $attributes );

    return { map { $_->{type} => $_->{values} } @$attributes };
}

sub attributes {
    my $self = shift;
    my( $name ) = @_;

    if( $self->{_apiVersion} < 1 ) {
	my $attributes = $self->{certificationRequestInfo}{attributes};
	return () unless( defined $attributes );

	my %hash = map { $_->{type} => $_->{values} }
	  @{$attributes};
	return %hash;
    }

    my $attributes = $self->_attributes;
    unless( defined $attributes ) {
	return () if( wantarray );
	return undef;  ## no critic
    }

    unless( defined $name ) {
	return grep { $_  ne 'extensionRequest' } sort keys %$attributes;
    }

    $name = $self->_oid2name( $name );

    if( $name eq 'extensionRequest' ) { # Meaningless, and extensions/extensionValue handle
	return () if( wantarray );
	return undef; ## no critic
    }

    # There can only be one matching the name.
    # If the match becomes wider, sort the keys.


    my @attrs = grep { $_ eq $name } keys %$attributes;
    unless( @attrs ) {
	return () if( wantarray );
	return undef; ## no critic
    }

    my @values;
    foreach my $attr (@attrs) {
	my $values = $attributes->{$attr};
	$values = [ $values ] unless( ref $values eq 'ARRAY' );
	foreach my $value (@$values)  {
	    my $value = $self->_hash2string( $value );
	    push @values, (wantarray? $value : $self->_value2strings( $value ));
	}
    }
    return @values if( wantarray );

    if( @values == 1 ) {
	$values[0] =~ s/^\((.*)\)$/$1/;
	return $values[0];
    }
    return join( ',', @values );
}

sub certificateTemplate {
    my $self = shift;

    return $self->extensionValue( 'certificateTemplate', @_ );
}

# If a hash contains one string (e.g. a CHOICE containing type=>value), return the string.
# If the hash is nested, try recursing.
# If the string can't be identified (clutter in the hash), return the hash
# Some clutter can be filtered by specifying $exclude (a regexp)

sub _hash2string {
    my $self = shift;
    my( $hash, $exclude ) = @_;

    return $hash unless( ref $hash eq 'HASH' );

    my @keys = keys %$hash;

    @keys = grep { $_ !~ /$exclude/ } @keys if( defined $exclude );

    return $hash if( @keys != 1 );

    return $self->_hash2string( $hash->{$keys[0]} ) if( ref $hash->{$keys[0]} eq 'HASH' );

    return $hash->{$keys[0]};
}

# Convert a value to a printable string

sub _value2strings {
    my $self = shift;
    my( $value ) = @_;

    my @strings;
    if( ref $value eq 'ARRAY' ) {
	foreach my $value (@$value) {
	    push @strings, $self->_value2strings( $value );
	}
	return '(' . join( ',', @strings ) . ')' if( @strings > 1 );
	return join( ',', @strings );
    }
    if( ref $value eq 'HASH' ) {
	foreach my $k (sort keys %$value) {
	    push @strings, "$k=" . $self->_value2strings( $value->{$k} );
	}
	return '(' . join( ',', @strings ) . ')' if( @strings > 1 );
	return join( ',', @strings );
    }

    return $value if( $value =~ /^\d+$/ );

    # OpenSSL and Perl-compatible string syntax

    $value =~ s/(["\\\$])/\\$1/g if( $self->{_escapeStrings} );

    return $value if( $value =~ m{\A[\w!\@$%^&*_=+\[\]\{\}:;|<>./?"'-]+\z} ); # Barewords

    return '"' . $value . '"'; # Must quote: whitespace, non-printable, comma, (), \, null string
}

sub extensions {
    my $self = shift;

    my $attributes = $self->_attributes;
    return () unless( defined $attributes && exists $attributes->{extensionRequest} );

    my @present =  map { $_->{extnID} } @{$attributes->{extensionRequest}};
    if( $self->{_apiVersion} >= 1 ) {
	foreach my $ext (@present) {
	    $ext = $variantNames{'$' . $ext} if( exists $variantNames{'$' . $ext} );
	}
    }
    return @present;
}

sub extensionValue {
    my $self = shift;
    my( $extensionName, $format ) = @_;

    my $attributes = $self->_attributes;
    my $value;
    return unless( defined $attributes && exists $attributes->{extensionRequest} );

    $extensionName = $self->_oid2name( $extensionName );

    $extensionName = $variantNames{$extensionName} if( exists $variantNames{$extensionName} );

    foreach my $entry (@{$attributes->{extensionRequest}}) {
        if ($entry->{extnID} eq $extensionName) {
            $value = $entry->{extnValue};
	    if( $self->{_apiVersion} == 0 ) {
		while (ref $value eq 'HASH') {
		    my @keys = sort keys %{$value};
		    $value = $value->{ shift @keys } ;
		}
	    } else {
		if( $entry->{_FMT} ) { # Special formatting
		    $value = $entry->{_FMT}[$format? 1:0];
		} else {
		    $value = $self->_hash2string( $value, '(?i:^(?:critical|.*id)$)' );
		    $value = $self->_value2strings( $value ) if( $format );
		}
	    }
	    last;
        }
    }
    $value =~ s/^\((.*)\)$/$1/ if( $format );

    return $value;
}

sub extensionPresent {
    my $self = shift;
    my( $extensionName ) = @_;

    my $attributes = $self->_attributes;
    return unless( defined $attributes && exists $attributes->{extensionRequest} );

    $extensionName = $self->_oid2name( $extensionName );

    $extensionName = $variantNames{$extensionName} if( exists $variantNames{$extensionName} );

    foreach my $entry (@{$attributes->{extensionRequest}}) {
        if ($entry->{extnID} eq $extensionName) {
	    return 2 if ($entry->{critical});
	    return 1;
        }
    }
    return;
}

sub checkSignature {
    my $self = shift;

    undef $error;
    delete $self->{_error};

    my $ok = eval {
        die( "checkSignature requires API version 1\n" ) unless( $self->{_apiVersion} >= 1 );

        my $key = $self->subjectPublicKey(1); # Key as PEM
        my $sig = $self->signature(1);        # Signature as DER
        my $alg = $self->signatureAlgorithm;  # Algorithm name

        # Determine the signature hash type from the algorithm name

        my @params = ( $sig, $self->certificationRequest );
        if( $alg =~ /sha-?(\d+)/i ) {
            push @params, "SHA$1";

        } elsif( $alg =~ /md-?(\d)/i ) {
            push @params, "MD$1";

        } elsif ( $alg eq 'rsassaPss' ) {

            my $sigParam = $self->signatureParams;
            push @params, uc($sigParam->{digestAlgorithm});
            push @params, 'pss';
            push @params, $sigParam->{saltLength};

        } else {

            die( "Unknown hash in signature algorithm $alg\n" );
        }

        my $keyp = $self->subjectPublicKeyParams;

        die( "Unknown public key type\n" ) unless( defined $keyp->{keytype} );

        # Verify signature using the correct module and hash type.

        if( $keyp->{keytype} eq 'RSA' ) {

            eval { require Crypt::PK::RSA; };
            die( "Unable to load Crypt::PK::RSA\n" ) if( $@ );

            # We have seen requests in the wild that accidentially
            # have the rsaPSS OID set for the key type which is wrong
            # and therefore not supported by Crypt::PK::RSA. We therefore
            # build the key directly from the components extracted earlier
            $key = Crypt::PK::RSA->new( {
                e => $keyp->{publicExponent},
                N => $keyp->{modulus},
            } );
            # if we have NOT pss padding we need to add v1.5 padding
            push @params, 'v1.5' if ( $alg ne 'rsassaPss' );
            return $key->verify_message( @params );

        }

        if( $keyp->{keytype} eq 'DSA' ) {

            eval { require Crypt::PK::DSA; };
            die( "Unable to load Crypt::PK::DSA\n" ) if( $@ );

            $key = Crypt::PK::DSA->new( \$key );
            return $key->verify_message( @params );
        }

        if( $keyp->{keytype} eq 'ECC' ) {
            eval { require Crypt::PK::ECC; };
            die( "Unable to load Crypt::PK::ECC\n" ) if( $@ );

            $key = Crypt::PK::ECC->new( \$key );
            return $key->verify_message( @params );
        }

        die( "Unknown key type $keyp->{keytype}\n" );
    };
    if( $@ ) {
        $self->{_error} =
          $error = $@;
        croak( $error ) if( $self->{_dieOnError} );
        return;
    }
    return 1 if( $ok );

    $self->{_error} =
      $error = "Incorrect signature\n";
    croak( $error ) if( $self->{_dieOnError} );

    return 0;
}

sub _wrap {
    my( $to, $text ) = @_;

    my $wid = 76 - $to;

    my $out = substr( $text, 0, $wid, '' );

    while( length $text ) {
	$out .= "\n" . (' ' x $to) . substr( $text, 0, $wid, '' );
    }
    return $out;
}

sub _encode_PEM {
    my $text = encode_base64( $_[0] );
    return $text if( length $text <= 65 );
    $text    =~ tr/\n//d;
    my $out  = '';
    $out    .= substr( $text, 0, 64, '' ) . "\n" while( length $text );
    return   $out;
}

sub as_string {
    my $self = shift;

    local $self->{_escapeStrings} = 0;
    local( $@, $_, $! );

    my $v = $apiVersion;
    ref( $self )->setAPIversion( 1 ) unless( defined $v && $v == 1 );

    my $string = eval {
        $self = ref( $self )->new( $self->{_der}, acceptPEM => 0, verifySignature => 0, escapeStrings => 0 );
        return $error if( !defined $self );

        $self->__stringify;
    };
    my $at = $@;
    ref( $self )->setAPIversion( $v ) unless( defined $v && $v == 1 );

    $string = '' unless( defined $string );
    $string .= $at if( $at );

    return $string;
}

sub __stringify {
    my $self = shift;

    my $max = 0;
    foreach ($self->attributes, $self->extensions,
	     qw/Version Subject Key_algorithm Public_key Signature_algorithm Signature/) {
	$max = length if( length > $max );
    }

    my $string = sprintf( "%-*s: %s\n", $max, 'Version', $self->version ) ;

    $string .= sprintf( "%-*s: %s\n", $max, 'Subject', _wrap( $max+2, scalar $self->subject ) );

    $string .= "\n          --Attributes--\n";

    $string .= "     --None--" unless( $self->attributes );

    foreach ($self->attributes) {
	$string .= sprintf( "%-*s: %s\n", $max, $_, _wrap( $max+2, scalar $self->attributes($_) ) );
    }

    $string .= "\n          --Extensions--\n";

    $string .= "     --None--" unless( $self->extensions );

    foreach ($self->extensions) {
	my $critical = $self->extensionPresent($_) == 2? 'critical,': '';

	$string .= sprintf( "%-*s: %s\n", $max, $_,
			    _wrap( $max+2, $critical . ($_ eq 'subjectAltName'?
							scalar $self->subjectAltName:
							$self->extensionValue($_, 1) ) ) );
    }

    $string .= "\n          --Key and signature--\n";
    $string .= sprintf( "%-*s: %s\n", $max, 'Key algorithm', $self->pkAlgorithm );
    $string .= sprintf( "%-*s: %s\n", $max, 'Public key', _wrap( $max+2, $self->subjectPublicKey ) );
    $string .= $self->subjectPublicKey(1);
    my $kp = $self->subjectPublicKeyParams(1);
    foreach (sort keys %$kp) {
        my $v = $kp->{$_};

        if( !defined $v && !defined( $v = $self->error ) ) {
            $v = 'undef';
        } elsif( ref $v ) {
            next;
        }
        $string .= sprintf( "%-*s: %s\n", $max, $_, _wrap( $max+2, $v ) );
    }
    if( exists $kp->{detail} ) {
        $kp = $kp->{detail};
        $string .= "Key details\n-----------\n";
        foreach (sort keys %$kp) {
            next if( ref $kp->{$_} );
            $string .= sprintf( "%-*s: %s\n", $max, $_, _wrap( $max+2, $kp->{$_} ) );
        }
    }

    $string .= sprintf( "\n%-*s: %s\n", $max, 'Signature algorithm', $self->signatureAlgorithm );
    $string .= sprintf( "%-*s: %s\n", $max, 'Signature', _wrap( $max+2, $self->signature ) );
    my $sp = $self->signature(2);
    if( $sp ) {
        foreach (sort keys %$sp) {
            my $v = $sp->{$_};

            if( ref $v ) {
                if( $v->can('as_hex') ) {
                    $v = substr( $v->as_hex, 2 );
                } else {
                    next;
                }
            }
            $string .= sprintf( "%-*s: %s\n", $max, $_, _wrap( $max+2, $v ) );
        }
    }

    $string .= "\n          --Request--\n" . $self->csrRequest(1);

    return $string;
}

1;

__END__