File Coverage

blib/lib/Mail/DKIM/Algorithm/dk_rsa_sha1.pm
Criterion Covered Total %
statement 67 67 100.0
branch 15 22 68.1
condition 4 9 44.4
subroutine 16 16 100.0
pod 3 8 37.5
total 105 122 86.0


line stmt bran cond sub pod time code
1             package Mail::DKIM::Algorithm::dk_rsa_sha1;
2 7     7   49 use strict;
  7         14  
  7         259  
3 7     7   38 use warnings;
  7         14  
  7         315  
4             our $VERSION = '1.20230911'; # VERSION
5             # ABSTRACT: Base algorithm class
6              
7             # Copyright 2005-2006 Messiah College. All rights reserved.
8             # Jason Long
9              
10             # Copyright (c) 2004 Anthony D. Urso. All rights reserved.
11             # This program is free software; you can redistribute it and/or
12             # modify it under the same terms as Perl itself.
13              
14 7     7   3019 use Mail::DKIM::Canonicalization::dk_simple;
  7         19  
  7         229  
15 7     7   3038 use Mail::DKIM::Canonicalization::dk_nofws;
  7         18  
  7         230  
16              
17 7     7   43 use base 'Mail::DKIM::Algorithm::Base';
  7         14  
  7         635  
18 7     7   42 use Carp;
  7         16  
  7         335  
19 7     7   40 use MIME::Base64;
  7         14  
  7         278  
20 7     7   40 use Digest::SHA;
  7         12  
  7         4993  
21              
22             sub finish_header {
23 21     21 1 40 my $self = shift;
24 21         71 $self->SUPER::finish_header(@_);
25              
26 21 50 33     83 if ( ( my $s = $self->signature )
27             && $self->{canon}->{interesting_header} )
28             {
29 21         45 my $sender = $self->{canon}->{interesting_header}->{sender};
30 21   66     78 $sender = defined($sender) && ( Mail::Address->parse($sender) )[0];
31 21         829 my $author = $self->{canon}->{interesting_header}->{from};
32 21   33     124 $author = defined($author) && ( Mail::Address->parse($author) )[0];
33              
34 21 100       4273 if ($sender) {
    50          
35 4         14 $s->init_identity( $sender->address, 'header.sender' );
36             }
37             elsif ($author) {
38 17         50 $s->init_identity( $author->address, 'header.from' );
39             }
40             }
41 21         70 return;
42             }
43              
44             sub get_canonicalization_class {
45 21     21 0 35 my $self = shift;
46 21 50       46 croak 'wrong number of arguments' unless ( @_ == 1 );
47 21         44 my ($method) = @_;
48              
49 21 50       52 my $class =
    100          
50             $method eq 'nofws' ? 'Mail::DKIM::Canonicalization::dk_nofws'
51             : $method eq 'simple' ? 'Mail::DKIM::Canonicalization::dk_simple'
52             : die "unknown method $method\n";
53 21         38 return $class;
54             }
55              
56             sub init {
57 21     21 0 31 my $self = shift;
58              
59 21 50       61 die 'no signature' unless $self->{Signature};
60              
61 21 100       57 $self->{mode} = $self->{Signature}->signature ? 'verify' : 'sign';
62              
63             # allows subclasses to set the header_digest and body_digest
64             # properties
65 21         62 $self->init_digests;
66              
67 21         53 my $method = $self->{Signature}->canonicalization;
68              
69 21         59 my $canon_class = $self->get_canonicalization_class($method);
70             $self->{canon} = $canon_class->new(
71             output_digest => $self->{header_digest},
72             Signature => $self->{Signature},
73             Debug_Canonicalization => $self->{Debug_Canonicalization}
74 21         166 );
75             }
76              
77             sub init_digests {
78 21     21 0 47 my $self = shift;
79              
80             # initialize a SHA-1 Digest
81 21         99 $self->{header_digest} = Digest::SHA->new(1);
82 21         306 $self->{body_digest} = $self->{header_digest};
83             }
84              
85             sub sign {
86 6     6 1 10 my $self = shift;
87 6 50       30 croak 'wrong number of arguments' unless ( @_ == 1 );
88 6         22 my ($private_key) = @_;
89              
90 6         51 my $digest = $self->{header_digest}->digest;
91 6         24 my $signature = $private_key->sign_digest( 'SHA-1', $digest );
92              
93 6         53 return encode_base64( $signature, '' );
94             }
95              
96             sub verify {
97 13     13 1 24 my $self = shift;
98 13 50       40 croak 'wrong number of arguments' unless ( @_ == 0 );
99              
100 13         48 my $base64 = $self->signature->data;
101 13         36 my $public_key = $self->signature->get_public_key;
102              
103 13         81 my $digest = $self->{header_digest}->digest;
104 13         53 my $sig = decode_base64($base64);
105 13         39 return $public_key->verify_digest( 'SHA-1', $digest, $sig );
106             }
107              
108             sub finish_message {
109 21     21 0 42 my $self = shift;
110              
111             # DomainKeys doesn't include the signature in the digest,
112             # but we still want it to look "pretty" :).
113              
114 21 100       63 if ( $self->{mode} eq 'sign' ) {
115 6         24 $self->{Signature}->prettify;
116             }
117             }
118              
119             sub wants_pre_signature_headers {
120 15     15 0 39 return 0;
121             }
122              
123             1;
124              
125             __END__