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   48 use strict;
  7         16  
  7         200  
3 7     7   35 use warnings;
  7         13  
  7         308  
4             our $VERSION = '1.20230630'; # 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   3213 use Mail::DKIM::Canonicalization::dk_simple;
  7         21  
  7         225  
15 7     7   2949 use Mail::DKIM::Canonicalization::dk_nofws;
  7         21  
  7         246  
16              
17 7     7   46 use base 'Mail::DKIM::Algorithm::Base';
  7         13  
  7         626  
18 7     7   43 use Carp;
  7         15  
  7         316  
19 7     7   38 use MIME::Base64;
  7         15  
  7         284  
20 7     7   38 use Digest::SHA;
  7         15  
  7         4876  
21              
22             sub finish_header {
23 21     21 1 40 my $self = shift;
24 21         88 $self->SUPER::finish_header(@_);
25              
26 21 50 33     90 if ( ( my $s = $self->signature )
27             && $self->{canon}->{interesting_header} )
28             {
29 21         46 my $sender = $self->{canon}->{interesting_header}->{sender};
30 21   66     83 $sender = defined($sender) && ( Mail::Address->parse($sender) )[0];
31 21         838 my $author = $self->{canon}->{interesting_header}->{from};
32 21   33     159 $author = defined($author) && ( Mail::Address->parse($author) )[0];
33              
34 21 100       4293 if ($sender) {
    50          
35 4         16 $s->init_identity( $sender->address, 'header.sender' );
36             }
37             elsif ($author) {
38 17         54 $s->init_identity( $author->address, 'header.from' );
39             }
40             }
41 21         121 return;
42             }
43              
44             sub get_canonicalization_class {
45 21     21 0 36 my $self = shift;
46 21 50       55 croak 'wrong number of arguments' unless ( @_ == 1 );
47 21         46 my ($method) = @_;
48              
49 21 50       59 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         41 return $class;
54             }
55              
56             sub init {
57 21     21 0 37 my $self = shift;
58              
59 21 50       71 die 'no signature' unless $self->{Signature};
60              
61 21 100       69 $self->{mode} = $self->{Signature}->signature ? 'verify' : 'sign';
62              
63             # allows subclasses to set the header_digest and body_digest
64             # properties
65 21         71 $self->init_digests;
66              
67 21         52 my $method = $self->{Signature}->canonicalization;
68              
69 21         61 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         163 );
75             }
76              
77             sub init_digests {
78 21     21 0 43 my $self = shift;
79              
80             # initialize a SHA-1 Digest
81 21         105 $self->{header_digest} = Digest::SHA->new(1);
82 21         346 $self->{body_digest} = $self->{header_digest};
83             }
84              
85             sub sign {
86 6     6 1 12 my $self = shift;
87 6 50       15 croak 'wrong number of arguments' unless ( @_ == 1 );
88 6         13 my ($private_key) = @_;
89              
90 6         48 my $digest = $self->{header_digest}->digest;
91 6         23 my $signature = $private_key->sign_digest( 'SHA-1', $digest );
92              
93 6         45 return encode_base64( $signature, '' );
94             }
95              
96             sub verify {
97 13     13 1 20 my $self = shift;
98 13 50       48 croak 'wrong number of arguments' unless ( @_ == 0 );
99              
100 13         57 my $base64 = $self->signature->data;
101 13         46 my $public_key = $self->signature->get_public_key;
102              
103 13         84 my $digest = $self->{header_digest}->digest;
104 13         57 my $sig = decode_base64($base64);
105 13         42 return $public_key->verify_digest( 'SHA-1', $digest, $sig );
106             }
107              
108             sub finish_message {
109 21     21 0 34 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       62 if ( $self->{mode} eq 'sign' ) {
115 6         21 $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__