package HTTP::PublicKeyPins;

use 5.006;
use strict;
use warnings;
use Crypt::OpenSSL::X509();
use Crypt::OpenSSL::RSA();
use Convert::ASN1();
use Digest();
use MIME::Base64();
use English qw( -no_match_vars );
use FileHandle();
use Exporter();
use Carp();
*import = \&Exporter::import;
our @EXPORT_OK = qw(
  pin_sha256
);
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK, );

sub _CERTIFICATE_HEADER_SIZE { return 40; }
sub _MAX_PUBLIC_KEY_SIZE     { return 65_536; }

our $VERSION = '0.07';

sub pin_sha256 {
    my ($path) = @_;
    my $handle = FileHandle->new($path)
      or Carp::croak("Failed to open $path for reading:$EXTENDED_OS_ERROR");
    read $handle, my $file_header, _CERTIFICATE_HEADER_SIZE()
      or Carp::croak("Failed to read from $path:$EXTENDED_OS_ERROR");
    my $pem_encoded_public_key_string;
    if ( $file_header =~
        /^[-]{5}BEGIN[ ](?:X[.]?509[ ]|TRUSTED[ ])?CERTIFICATE[-]{5}/smx )
    {
        $pem_encoded_public_key_string =
          _process_pem_certificate( $handle, $file_header, $path );
    }
    elsif ( $file_header =~ /^[-]{5}BEGIN[ ](?:RSA[ ])?PUBLIC[ ]KEY[-]{5}/smx )
    {
        $pem_encoded_public_key_string =
          _process_pem_public_key( $handle, $file_header, $path );
    }
    else {
        $pem_encoded_public_key_string =
          _check_for_der_certificate( $handle, $file_header, $path );
        if ( !defined $pem_encoded_public_key_string ) {
            Carp::croak("$path is not an X.509 Certificate");
        }
    }

    $pem_encoded_public_key_string =~
      s/^[-]{5}BEGIN[ ]PUBLIC[ ]KEY[-]{5}\r?\n//smx;
    $pem_encoded_public_key_string =~
      s/^[-]{5}END[ ]PUBLIC[ ]KEY[-]{5}\r?\n//smx;
    my $der_encoded_public_key_string =
      MIME::Base64::decode($pem_encoded_public_key_string);
    my $digest = Digest->new('SHA-256');
    $digest->add($der_encoded_public_key_string);
    my $base64 = MIME::Base64::encode_base64( $digest->digest() );
    chomp $base64;
    return $base64;
}

sub _process_pem_certificate {
    my ( $handle, $file_header, $path ) = @_;
    my $pem_encoded_public_key_string;
    if ( $file_header =~ /^[-]{5}BEGIN[ ]CERTIFICATE[-]{5}/smx ) {
        my $x509 = Crypt::OpenSSL::X509->new_from_file($path);
        $pem_encoded_public_key_string =
          _get_pem_encoded_public_key_string($x509);
    }
    elsif ( $file_header =~
        /^[-]{5}BEGIN[ ](?:X[.]?509|TRUSTED)[ ]CERTIFICATE[-]{5}/smx )
    {
        seek $handle, 0, Fcntl::SEEK_SET()
          or Carp::croak("Failed to seek to start of $path:$EXTENDED_OS_ERROR");
        defined read $handle, my $pem_encoded_certificate_string,
          _MAX_PUBLIC_KEY_SIZE()
          or Carp::croak("Failed to read from $path:$EXTENDED_OS_ERROR");
        $pem_encoded_certificate_string =~
s/^([-]{5}BEGIN[ ])(?:X[.]?509|TRUSTED)[ ](CERTIFICATE[-]{5})/$1$2/smx;
        $pem_encoded_certificate_string =~
          s/^([-]{5}END[ ])(?:X[.]?509|TRUSTED)[ ](CERTIFICATE[-]{5})/$1$2/smx;
        my $x509 = Crypt::OpenSSL::X509->new_from_string(
            $pem_encoded_certificate_string);
        $pem_encoded_public_key_string =
          _get_pem_encoded_public_key_string($x509);
    }
    return $pem_encoded_public_key_string;
}

sub _check_for_der_certificate {
    my ( $handle, $file_header, $path ) = @_;
    my $pem_encoded_public_key_string;
    eval {
        my $x509 = Crypt::OpenSSL::X509->new_from_file( $path,
            Crypt::OpenSSL::X509::FORMAT_ASN1() );
        $pem_encoded_public_key_string =
          _get_pem_encoded_public_key_string($x509);
    } or do {
        return;
    };
    return $pem_encoded_public_key_string;
}

sub _process_pem_public_key {
    my ( $handle, $file_header, $path ) = @_;
    my $pem_encoded_public_key_string;
    if ( $file_header =~ /^[-]{5}BEGIN[ ]PUBLIC[ ]KEY[-]{5}/smx ) {
        seek $handle, 0, Fcntl::SEEK_SET()
          or Carp::croak("Failed to seek to start of $path:$EXTENDED_OS_ERROR");
        defined read $handle, $pem_encoded_public_key_string,
          _MAX_PUBLIC_KEY_SIZE()
          or Carp::croak("Failed to read from $path:$EXTENDED_OS_ERROR");
    }
    elsif ( $file_header =~ /^[-]{5}BEGIN[ ]RSA[ ]PUBLIC[ ]KEY[-]{5}/smx ) {
        seek $handle, 0, Fcntl::SEEK_SET()
          or Carp::croak("Failed to seek to start of $path:$EXTENDED_OS_ERROR");
        defined read $handle, my $pem_encoded_rsa_public_key_string,
          _MAX_PUBLIC_KEY_SIZE()
          or Carp::croak("Failed to read from $path:$EXTENDED_OS_ERROR");
        my $pubkey = Crypt::OpenSSL::RSA->new_public_key(
            $pem_encoded_rsa_public_key_string);
        $pem_encoded_public_key_string = $pubkey->get_public_key_x509_string();
    }
    return $pem_encoded_public_key_string;
}

sub _get_pem_encoded_public_key_string {
    my ($x509) = @_;
    my $pem_encoded_public_key_string;
    if ( $x509->key_alg_name() eq 'rsaEncryption' ) {
        my $pubkey = Crypt::OpenSSL::RSA->new_public_key( $x509->pubkey() );
        $pem_encoded_public_key_string = $pubkey->get_public_key_x509_string();
    }
    else {
        $pem_encoded_public_key_string = $x509->pubkey();
    }
    return $pem_encoded_public_key_string;
}

1;    # End of HTTP::PublicKeyPins
__END__

=head1 NAME

HTTP::PublicKeyPins - Generate RFC 7469 HTTP Public Key Pin (HPKP) header values

=head1 VERSION

Version 0.07

=head1 SYNOPSIS

Make it more difficult for the bad guys to Man-In-The-Middle your users TLS sessions

    use HTTP::Headers();
    use HTTP::PublicKeyPins qw( pin_sha256 );

    ...
    my $h = HTTP::Headers->new();
    $h->header( 'Public-Key-Pins-Report-Only',
            'pin-sha256="'
          . pin_sha256('/etc/pki/tls/certs/example.pem')
          . '"; pin-sha256="'
          . pin_sha256('/etc/pki/tls/certs/backup.pem')
          . '"; report-uri="https://example.com/pkp-report.pl' );


=head1 DESCRIPTION

This module allows the calculation of RFC 7469 HTTP Public Key Pin header values. This can be used to verify your TLS session to a remote server has not been hit by a Man-In-The-Middle attack OR to instruct your users to ignore any TLS sessions to your web service that does not use your Public Key

=head1 EXPORT

=head2 pin_sha256

This function accepts the path to a L<X.509 Certificate|https://en.wikipedia.org/wiki/X.509>.  It will load the public key from the certificate and prepare the appropriate value for the pin_sha256 parameter of the Public-Key-Pins value. This function will also make an attempt to read public keys (in PEM format).  Patches for other formats are encouraged.

=head1 SUBROUTINES/METHODS

None.  This module only has the one exported function.

=head1 DIAGNOSTICS
 
=over
 
=item C<< Failed to open %s for reading >>
 
Failed to open the supplied X.509 Certificate file
 
=item C<< Failed to read from %s >>
 
Failed to read from the supplied X.509 Certificate file

=item C<< %s is not an X.509 Certificate >>
 
The supplied input file does not look like X.509 Certificate File. The X.509 Certificate file may be encoded in PEM or DER format. A PEM encoded X.509 Certificate file has the following header

  -----BEGIN CERTIFICATE-----

=back
 
=head1 CONFIGURATION AND ENVIRONMENT
 
HTTP::PublicKeyPins requires no configuration files or environment variables.
 
=head1 DEPENDENCIES
 
HTTP::PublicKeyPins requires the following non-core modules
 
  Crypt::OpenSSL::X509;
  Crypt::OpenSSL::RSA;
  Digest
 
=head1 INCOMPATIBILITIES
 
None known.

=head1 SEE ALSO

=over

=item L<RFC 7469 - Public Key Pinning Extension for HTTP|http://tools.ietf.org/html/rfc7469>

=item L<X.509 Certificate|https://en.wikipedia.org/wiki/X.509>

=back

=head1 AUTHOR

David Dick, C<< <ddick at cpan.org> >>

=head1 BUGS AND LIMITATIONS
 
Please report any bugs or feature requests to C<bug-http-publickeypins at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=HTTP-PublicKeyPins>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc HTTP::PublicKeyPins


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTTP-PublicKeyPins>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/HTTP-PublicKeyPins>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/HTTP-PublicKeyPins>

=item * Search CPAN

L<http://search.cpan.org/dist/HTTP-PublicKeyPins/>

=back


=head1 LICENSE AND COPYRIGHT

Copyright 2015 David Dick.

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. This program is distributed in the hope that 
it will be useful, but WITHOUT ANY WARRANTY; without even the implied 
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
