| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Net::DNS::SEC::Digest; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 1 |  |  | 1 |  | 3107 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 29 |  | 
| 4 | 1 |  |  | 1 |  | 5 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 58 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 |  |  |  |  |  |  | our $VERSION = (qw$Id: Digest.pm 1849 2021-08-19 08:25:20Z willem $)[2]; | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | =head1 NAME | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | Net::DNS::SEC::Digest - Message Digest Algorithms | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 15 |  |  |  |  |  |  |  | 
| 16 |  |  |  |  |  |  | require Net::DNS::SEC::Digest; | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | $object = Net::DNS::SEC::Digest::SHA->new(256); | 
| 19 |  |  |  |  |  |  | $object->add($text); | 
| 20 |  |  |  |  |  |  | $object->add($more); | 
| 21 |  |  |  |  |  |  | $digest = $object->digest; | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | Interface package providing access to the message digest algorithm | 
| 27 |  |  |  |  |  |  | implementations within the OpenSSL libcrypto library. | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | =cut | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  |  | 
| 32 | 1 |  |  | 1 |  | 6 | use constant libcrypto_available => Net::DNS::SEC::libcrypto->can('EVP_MD_CTX_new'); | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 63 |  | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 1 |  |  | 1 |  | 609 | BEGIN { die 'Net::DNS::SEC not available' unless libcrypto_available } | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | my %digest = ( | 
| 38 |  |  |  |  |  |  | MD5 => sub { Net::DNS::SEC::libcrypto::EVP_md5() }, | 
| 39 |  |  |  |  |  |  |  | 
| 40 |  |  |  |  |  |  | SHA_1	=> sub { Net::DNS::SEC::libcrypto::EVP_sha1() }, | 
| 41 |  |  |  |  |  |  | SHA_224 => sub { Net::DNS::SEC::libcrypto::EVP_sha224() }, | 
| 42 |  |  |  |  |  |  | SHA_256 => sub { Net::DNS::SEC::libcrypto::EVP_sha256() }, | 
| 43 |  |  |  |  |  |  | SHA_384 => sub { Net::DNS::SEC::libcrypto::EVP_sha384() }, | 
| 44 |  |  |  |  |  |  | SHA_512 => sub { Net::DNS::SEC::libcrypto::EVP_sha512() }, | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | SHA3_224 => sub { Net::DNS::SEC::libcrypto::EVP_sha3_224() }, | 
| 47 |  |  |  |  |  |  | SHA3_256 => sub { Net::DNS::SEC::libcrypto::EVP_sha3_256() }, | 
| 48 |  |  |  |  |  |  | SHA3_384 => sub { Net::DNS::SEC::libcrypto::EVP_sha3_384() }, | 
| 49 |  |  |  |  |  |  | SHA3_512 => sub { Net::DNS::SEC::libcrypto::EVP_sha3_512() }, | 
| 50 |  |  |  |  |  |  | ); | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | sub new { | 
| 54 | 10 |  |  | 10 | 1 | 3051 | my ( $class, @param ) = @_; | 
| 55 | 10 |  |  |  |  | 52 | my ($index) = reverse split '::', join '_', $class, @param; | 
| 56 | 10 |  |  |  |  | 23 | my $evpmd   = $digest{$index}; | 
| 57 | 10 |  |  |  |  | 51 | my $mdctx   = Net::DNS::SEC::libcrypto::EVP_MD_CTX_new(); | 
| 58 | 10 |  |  |  |  | 22 | Net::DNS::SEC::libcrypto::EVP_DigestInit( $mdctx, &$evpmd ); | 
| 59 | 6 |  |  |  |  | 18 | return bless( {ctx => $mdctx, md => &$evpmd}, $class ); | 
| 60 |  |  |  |  |  |  | } | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | sub add { | 
| 63 | 18 |  |  | 18 | 1 | 56 | my $self = shift; | 
| 64 | 18 |  |  |  |  | 60 | return Net::DNS::SEC::libcrypto::EVP_DigestUpdate( $self->{ctx}, shift ); | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | sub digest { | 
| 68 | 12 |  |  | 12 | 1 | 49 | my $self = shift; | 
| 69 | 12 |  |  |  |  | 84 | my $dgst = Net::DNS::SEC::libcrypto::EVP_DigestFinal( $self->{ctx} ); | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | # reinitialise; emulate API offered by Digest::SHA | 
| 72 | 12 |  |  |  |  | 59 | Net::DNS::SEC::libcrypto::EVP_DigestInit( $self->{ctx}, $self->{md} ); | 
| 73 | 12 |  |  |  |  | 84 | return $dgst; | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | DESTROY { | 
| 77 | 6 |  |  | 6 |  | 3167 | my $self = shift; | 
| 78 | 6 |  |  |  |  | 43 | return Net::DNS::SEC::libcrypto::EVP_MD_CTX_free( $self->{ctx} ); | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | ## no critic ProhibitMultiplePackages | 
| 83 |  |  |  |  |  |  | package Net::DNS::SEC::Digest::MD5; | 
| 84 |  |  |  |  |  |  | our @ISA = qw(Net::DNS::SEC::Digest); | 
| 85 |  |  |  |  |  |  |  | 
| 86 |  |  |  |  |  |  | package Net::DNS::SEC::Digest::SHA; | 
| 87 |  |  |  |  |  |  | our @ISA = qw(Net::DNS::SEC::Digest); | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | package Net::DNS::SEC::Digest::SHA3; | 
| 90 |  |  |  |  |  |  | our @ISA = qw(Net::DNS::SEC::Digest); | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | 1; | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | __END__ |