package Crypt::OpenSSL::X509;

use warnings;
use strict;

use Exporter;
use base qw(Exporter);

use Convert::ASN1;

use version; our $VERSION = version->declare('2.1.2');

our @EXPORT_OK = qw(
  FORMAT_UNDEF FORMAT_ASN1 FORMAT_TEXT FORMAT_PEM
  FORMAT_PKCS12 FORMAT_SMIME FORMAT_ENGINE FORMAT_IISSGC OPENSSL_VERSION_NUMBER
);

sub Crypt::OpenSSL::X509::has_extension_oid {
  my $x509 = shift;
  my $oid  = shift;

  return ${$x509->extensions_by_oid}{$oid} ? 1 : 0;
}

sub Crypt::OpenSSL::X509::Extension::is_critical {
  my $ext = shift;
  my $crit = $ext->critical();

  return $crit ? 1 : 0;
}

# return a hash for the values of keyUsage or nsCertType
sub Crypt::OpenSSL::X509::Extension::hash_bit_string {
  my $ext  = shift;

  my @bits = split(//, $ext->bit_string);
  my $len  = @bits;

  my %bit_str_hash = ();

  if ($len == 9) { # bits for keyUsage

    %bit_str_hash = (
      'Digital Signature' => $bits[0],
      'Non Repudiation'   => $bits[1],
      'Key Encipherment'  => $bits[2],
      'Data Encipherment' => $bits[3],
      'Key Agreement'     => $bits[4],
      'Certificate Sign'  => $bits[5],
      'CRL Sign'          => $bits[6],
      'Encipher Only'     => $bits[7],
      'Decipher Only'     => $bits[8],);

  } elsif ($len == 8) {    #bits for nsCertType

    %bit_str_hash = (
      'SSL Client'        => $bits[0],
      'SSL Server'        => $bits[1],
      'S/MIME'            => $bits[2],
      'Object Signing'    => $bits[3],
      'Unused'            => $bits[4],
      'SSL CA'            => $bits[5],
      'S/MIME CA'         => $bits[6],
      'Object Signing CA' => $bits[7],);
  }

  return %bit_str_hash;
}

sub Crypt::OpenSSL::X509::Extension::extKeyUsage {
  my $ext = shift;

  my @vals = split(/ /, $ext->extendedKeyUsage);

  return @vals;
}

sub Crypt::OpenSSL::X509::is_selfsigned {
  my $x509 = shift;

  return $x509->subject eq $x509->issuer;
}

sub Crypt::OpenSSL::X509::subjectaltname {
  my $x509 = shift;

  my $SUBJECT_ALT_NAME_OID = '2.5.29.17';
  my $ext;
  eval {
    # extensions_by_oid croaks of no extensions found
    # we don't care we will return an empty array
    $ext = $x509->extensions_by_oid();
  };

  # Determine whether the SubjectAltName exist
  if (! defined ${$ext}{$SUBJECT_ALT_NAME_OID}) {
    # Simply return a reference to an empty array if it does not exist
    my @tmp = ();
    return \@tmp;
  }

  my $pdu = ${$ext}{$SUBJECT_ALT_NAME_OID}->value();

  # remove leading '#' from the value returned
  $pdu =~ s/^#//g;

  my $bin_data = join '', pack 'H*', $pdu;
  my $asn = Convert::ASN1->new();

  my $ok = $asn->prepare(q<
    AnotherName ::= SEQUENCE {
      type    OBJECT IDENTIFIER,
      value      [0] EXPLICIT ANY } --DEFINED BY type-id }

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

   --  Directory string type --

    DirectoryString ::= CHOICE {
      teletexString		TeletexString,  --(SIZE (1..MAX)),
      printableString		PrintableString,  --(SIZE (1..MAX)),
      bmpString		BMPString,  --(SIZE (1..MAX)),
      universalString		UniversalString,  --(SIZE (1..MAX)),
      utf8String		UTF8String,  --(SIZE (1..MAX)),
      ia5String		IA5String  --added for EmailAddress
	}

    AttributeType ::= OBJECT IDENTIFIER

    AttributeValue ::= DirectoryString  --ANY

    AttributeTypeAndValue ::= SEQUENCE {
      type			AttributeType,
      value			AttributeValue
	}

    -- naming data types --

    Name ::= CHOICE { -- only one possibility for now
      rdnSequence		RDNSequence
	}

    RDNSequence ::= SEQUENCE OF RelativeDistinguishedName

    DistinguishedName ::= RDNSequence

    RelativeDistinguishedName ::=
	SET OF AttributeTypeAndValue  --SET SIZE (1 .. MAX) OF

    SubjectAltName ::= GeneralNames

    GeneralNames ::= SEQUENCE OF GeneralName

    GeneralName ::= CHOICE {
      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
    }

  >);
  die '*** Could not prepare definition: '.$asn->error()
      if !$ok;

  # This is an important bit - if you don't do the find the decode
  # will randomly fail/succeed.  This is required to work
  my $asn_node = $asn->find('SubjectAltName')
      or die $asn->error;

  my $san = $asn_node->decode($bin_data)
      or die 'Unable to decode SubjectAltName: '.$asn_node->error;

  return $san;
}

use XSLoader;
XSLoader::load 'Crypt::OpenSSL::X509', $VERSION;

END {
  __PACKAGE__->__X509_cleanup;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Crypt::OpenSSL::X509 - Perl extension to OpenSSL's X509 API.

=head1 SYNOPSIS

  use Crypt::OpenSSL::X509;

  my $x509 = Crypt::OpenSSL::X509->new_from_file('cert.pem');

  print $x509->pubkey() . "\n";
  print $x509->subject() . "\n";
  print $x509->hash() . "\n";
  print $x509->email() . "\n";
  print $x509->issuer() . "\n";
  print $x509->issuer_hash() . "\n";
  print $x509->notBefore() . "\n";
  print $x509->notAfter() . "\n";
  print $x509->modulus() . "\n";
  print $x509->exponent() . "\n";
  print $x509->fingerprint_md5() . "\n";
  print $x509->fingerprint_sha256() . "\n";
  print $x509->as_string() . "\n";

  my $x509 = Crypt::OpenSSL::X509->new_from_string(
    $der_encoded_data, Crypt::OpenSSL::X509::FORMAT_ASN1
  );

  # given a time offset of $seconds, will the certificate be valid?
  if ($x509->checkend($seconds)) {
    # cert is expired at $seconds offset
  } else {
    # cert is ok at $seconds offset
  }

  my $exts = $x509->extensions_by_oid();

  foreach my $oid (keys %$exts) {
    my $ext = $$exts{$oid};
    print $oid, " ", $ext->object()->name(), ": ", $ext->value(), "\n";
  }


=head1 ABSTRACT

  Crypt::OpenSSL::X509 - Perl extension to OpenSSL's X509 API.

=head1 DESCRIPTION

  This implement a large majority of OpenSSL's useful X509 API.

  The email() method supports both certificates where the
  subject is of the form:
  "... CN=Firstname lastname/emailAddress=user@domain", and also
  certificates where there is a X509v3 Extension of the form
  "X509v3 Subject Alternative Name: email=user@domain".

=head2 SUPPORTED OPENSSL VERSIONS

This module supports multiple versions of OpenSSL and maintains backward compatibility:

=over 4

=item OpenSSL 1.0.x - Legacy support (1.0.2 and later)

=item OpenSSL 1.1.x - Full support

=item OpenSSL 3.x - Full support (current stable)

=item OpenSSL 4.x - Full support (with ASN1 opaque structure compatibility)

=item LibreSSL 2.x/3.x - Compatible

=back

OpenSSL 4.0.0 introduced opaque ASN1 string types, requiring the use of accessor functions instead of direct structure member access. This module uses conditional compilation to maintain compatibility across all versions while supporting the new OpenSSL 4.x API requirements.

=head2 EXPORT

None by default.

On request:

	FORMAT_UNDEF FORMAT_ASN1 FORMAT_TEXT FORMAT_PEM
	FORMAT_PKCS12 FORMAT_SMIME FORMAT_ENGINE FORMAT_IISSGC


=head1 FUNCTIONS

=head2 X509 CONSTRUCTORS

=over 4

=item new ( )

Create a new X509 object.

=item new_from_string ( STRING [ FORMAT ] )

=item new_from_file ( FILENAME [ FORMAT ] )

Create a new X509 object from a string or file. C<FORMAT> should be C<FORMAT_ASN1> or C<FORMAT_PEM>.

=back

=head2 X509 ACCESSORS

=over 4

=item subject

Subject name as a string.

=item issuer

Issuer name as a string.

=item issuer_hash

Issuer name hash as a string.

=item serial

Serial number as a string.

=item hash

Alias for subject_hash

=item subject_hash

Subject name hash as a string.

=item notBefore

C<notBefore> time as a string.

=item notAfter

C<notAfter> time as a string.

=item email

Email addresses as string, if multiple addresses found, they are separated by a space (' ').

=item version

Certificate version as a string.

=item sig_alg_name

Signature algorithm name as a string.

=item key_alg_name

Public key algorithm name as a string.

=item curve

Name of the EC curve used in the public key.

=back

=head2 X509 METHODS

=over 4

=item subject_name ( )

=item issuer_name ( )

Return a Name object for the subject or issuer name. Methods for handling Name objects are given below.

=item is_selfsigned ( )

Return Boolean value if subject and issuer name are the same.

=item as_string ( [ FORMAT ] )

Return the certificate as a string in the specified format. C<FORMAT> can be one of C<FORMAT_PEM> (the default) or C<FORMAT_ASN1>.

=item modulus ( )

Return the modulus for an RSA public key as a string of hex digits. For DSA and EC return the public key. Other algorithms are not supported.

=item bit_length ( )

Return the length of the modulus as a number of bits.

=item fingerprint_md5 ( )

=item fingerprint_sha1 ( )

=item fingerprint_sha224 ( )

=item fingerprint_sha256 ( )

=item fingerprint_sha384 ( )

=item fingerprint_sha512 ( )

Return the specified message digest for the certificate.

=item checkend( OFFSET )

Given an offset in seconds, will the certificate be expired? Returns True if the certificate will be expired. False otherwise.

=item pubkey ( )

Return the RSA, DSA, or EC public key.

=item num_extensions ( )

Return the number of extensions in the certificate.

=item extension ( INDEX )

Return the Extension specified by the integer C<INDEX>.
Methods for handling Extension objects are given below.

=item extensions_by_oid ( )

=item extensions_by_name ( )

=item extensions_by_long_name ( )

Return a hash of Extensions indexed by OID or name.

=item has_extension_oid ( OID )

Return true if the certificate has the extension specified by C<OID>.

=item subjectaltname ( )

Uses Convert::ASN1 to extract the Subject Alternative Names from the X509 object.
subjectaltname ( ) returns an array of objects, each object representing a SAN.

These could be of the following types (as defined in the embedded ASN.1 schema):

=over 4

=item * rfc822Name — email address (IA5String)

=item * dNSName — DNS hostname (IA5String)

=item * x400Address — X.400 address (ANY)

=item * directoryName — Distinguished Name (RDNSequence)

=item * ediPartyName — EDI party name (EDIPartyName)

=item * uniformResourceIdentifier — URI (IA5String)

=item * iPAddress — IP address (OCTET STRING; 4 bytes IPv4, 16 bytes IPv6)

=item * registeredID — OID (OBJECT IDENTIFIER)

=back

Note: C<otherName> (tag [0] in RFC 5280) is not implemented and will never appear in the output.

    [
        {
            'rfc822Name' => 'altuser@mpi-sws.org'
        },
        {
            'rfc822Name' => 'user@mpi-sws.org'
        },
    ]

=back

=head2 X509::Extension METHODS

=over 4

=item critical ( )

Return a value indicating if the extension is critical or not.
FIXME: the value is an ASN.1 BOOLEAN value.

=item object ( )

Return the ObjectID of the extension.
Methods for handling ObjectID objects are given below.

=item value ( )

Return the value of the extension as an asn1parse(1) style hex dump.

=item as_string ( )

Return a human-readable version of the extension as formatted by X509V3_EXT_print. Note that this will return an empty string for OIDs with unknown ASN.1 encodings.

=back

=head2 X509::ObjectID METHODS

=over 4

=item name ( )

Return the long name of the object as a string.

=item oid ( )

Return the numeric dot-separated form of the object identifier as a string.

=back

=head2 X509::Name METHODS

=over 4

=item as_string ( )

Return a string representation of the Name

=item entries ( )

Return an array of Name_Entry objects. Methods for handling Name_Entry objects are given below.

=item has_entry ( TYPE [ LASTPOS ] )

=item has_long_entry ( TYPE [ LASTPOS ] )

=item has_oid_entry ( TYPE [ LASTPOS ] )

Return true if a name has an entry of the specified C<TYPE>. Depending on the function the C<TYPE> may be in the short form (e.g. C<CN>), long form (C<commonName>) or OID (C<2.5.4.3>). If C<LASTPOS> is specified then the search is made from that index rather than from the start.

=item get_index_by_type ( TYPE [ LASTPOS ] )

=item get_index_by_long_type ( TYPE [ LASTPOS ] )

=item get_index_by_oid_type ( TYPE [ LASTPOS ] )

Return the index of an entry of the specified C<TYPE> in a name. Depending on the function the C<TYPE> may be in the short form (e.g. C<CN>), long form (C<commonName>) or OID (C<2.5.4.3>). If C<LASTPOS> is specified then the search is made from that index rather than from the start.

=item get_entry_by_type ( TYPE [ LASTPOS ] )

=item get_entry_by_long_type ( TYPE [ LASTPOS ] )

These methods work similarly to get_index_by_* but return the Name_Entry rather than the index.

=back

=head2 X509::Name_Entry METHODS

=over 4

=item as_string ( [ LONG ] )

Return a string representation of the Name_Entry of the form C<typeName=Value>. If C<LONG> is 1, the long form of the type is used.

=item type ( [ LONG ] )

Return a string representation of the type of the Name_Entry. If C<LONG> is 1, the long form of the type is used.

=item value ( )

Return a string representation of the value of the Name_Entry.

=item is_printableString ( )

=item is_ia5string ( )

=item is_utf8string ( )

=item is_asn1_type ( [ASN1_TYPE] )

Return true if the Name_Entry value is of the specified type. The value of C<ASN1_TYPE> should be as listed in OpenSSL's C<asn1.h>.

=back

=head1 ISSUE REPORTING

Please report any bugs or feature requests using B<GitHub>.

=over

=item * L<GitHub Issues|https://github.com/dsully/perl-crypt-openssl-x509/issues>

=back

=head1 SEE ALSO

=over

=item * L<OpenSSL website|https://www.openssl.org/>

=item * L<Crypt::OpenSSL::RSA|https://metacpan.org/pod/Crypt::OpenSSL::RSA>

=item * L<Crypt::OpenSSL::Bignum|https://metacpan.org/pod/Crypt::OpenSSL::Bignum>

=item * L<Crypt::OpenSSL::Guess|https://metacpan.org/pod/Crypt::OpenSSL::Guess>

=back

=head1 AUTHOR

=over

=item * Dan Sully, original author

=item * Jonas Brømsø, current maintainer

=item * Please see the L</ACKNOWLEDGEMENTS> section for a list of contributors.

=back

=head1 ACKNOWLEDGEMENTS

In alphabetical order.

=over

=item * @eserte

=item * @kmx

=item * @stphnlyd

=item * Ashley Hindmarsh @bestscarper

=item * Bernhard M. Wiedemann @bmwiedemann

=item * Brad Davidson @brandond

=item * Daniel Kahn Gillmor

=item * Daniel Risacher

=item * David O'Callaghan

=item * David Steinbrunner @dsteinbrunner

=item * dsteinwand

=item * Florian Schlichting @fschlich

=item * IKEDA Soji @ikedas

=item * James Hunt @jhunt

=item * James Rouzier @jrouzierinverse

=item * Johanna @0xxon

=item * Jonas Brømsø @jonasbn

=item * Louise Doran

=item * Maxime Besson @maxbes

=item * Michael McClimon @mmcclimon

=item * Michal Josef Špaček @michal-josef-spacek

=item * Neil Bowers @neilb

=item * Nicholas Harteau

=item * Otmar Lendl

=item * Patrick C. @errror

=item * Patrick Cernko

=item * Petr Pisar @ppisar

=item * pi-rho

=item * Salvador Fandiño @salva

=item * Sebastian Andrzej Siewior

=item * Sho Nakatani @laysakura

=item * Shoichi Kaji @skaji

=item * Timothy Legge @timlegge 

=item * Todd Rinaldo @toddr

=item * Uli Scholler

=back

=head1 COPYRIGHT AND LICENSE

Copyright 2004 by Dan Sully

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
