File Coverage

blib/lib/Mail/DKIM/Key.pm
Criterion Covered Total %
statement 22 31 70.9
branch 7 14 50.0
condition n/a
subroutine 5 8 62.5
pod 0 6 0.0
total 34 59 57.6


line stmt bran cond sub pod time code
1             package Mail::DKIM::Key;
2 15     15   165 use strict;
  15         32  
  15         599  
3 15     15   78 use warnings;
  15         28  
  15         7942  
4             # ABSTRACT: Represents a DKIM Key
5             our $VERSION = '1.20240923'; # VERSION
6              
7             # Copyright 2006 Jason Long. All rights reserved.
8             #
9             # Copyright (c) 2004 Anthony D. Urso. All rights reserved.
10             # This program is free software; you can redistribute it and/or
11             # modify it under the same terms as Perl itself.
12              
13             sub cork {
14 1505     1505 0 4145 my $self = shift;
15              
16             (@_)
17 1505 100       4423 and $self->{'CORK'} = shift;
18              
19 1505 100       5473 $self->{'CORK'}
20             or $self->convert;
21              
22 1504         4859 $self->{'CORK'};
23             }
24              
25             sub data {
26 1068     1068 0 1386 my $self = shift;
27              
28             (@_)
29 1068 50       1696 and $self->{'DATA'} = shift;
30              
31 1068         2280 $self->{'DATA'};
32             }
33              
34             sub errorstr {
35 0     0 0 0 my $self = shift;
36              
37             (@_)
38 0 0       0 and $self->{'ESTR'} = shift;
39              
40 0         0 $self->{'ESTR'};
41             }
42              
43             sub size {
44 0     0 0 0 my $self = shift;
45              
46 0         0 return $self->cork->size * 8;
47             }
48              
49             sub type {
50 0     0 0 0 my $self = shift;
51              
52             (@_)
53 0 0       0 and $self->{'TYPE'} = shift;
54              
55 0         0 $self->{'TYPE'};
56             }
57              
58             sub calculate_EM {
59 392     392 0 1386 my ( $digest_algorithm, $digest, $emLen ) = @_;
60              
61             # this function performs DER encoding of the algorithm ID for the
62             # hash function and the hash value itself
63             # It has this syntax:
64             # DigestInfo ::= SEQUENCE {
65             # digestAlgorithm AlgorithmIdentifier,
66             # digest OCTET STRING
67             # }
68              
69             # RFC 3447, page 42, provides the following octet values:
70 392         2418 my %digest_encoding = (
71             'SHA-1' => pack( 'H*', '3021300906052B0E03021A05000414' ),
72             'SHA-256' => pack( 'H*', '3031300d060960864801650304020105000420' ),
73             );
74              
75 392 50       3034 defined $digest_encoding{$digest_algorithm}
76             or die "Unsupported digest algorithm '$digest_algorithm'";
77              
78 392         1052 my $T = $digest_encoding{$digest_algorithm} . $digest;
79 392         907 my $tLen = length($T);
80              
81 392 50       1358 if ( $emLen < $tLen + 11 ) {
82 0         0 die 'Intended encoded message length too short.';
83             }
84              
85 392         1442 my $PS = chr(0xff) x ( $emLen - $tLen - 3 );
86 392         935 my $EM = chr(0) . chr(1) . $PS . chr(0) . $T;
87 392         1983 return $EM;
88             }
89              
90             1;
91              
92             __END__