File Coverage

blib/lib/Mail/DKIM/Algorithm/Base.pm
Criterion Covered Total %
statement 75 78 96.1
branch 19 24 79.1
condition 6 9 66.6
subroutine 18 21 85.7
pod 7 13 53.8
total 125 145 86.2


line stmt bran cond sub pod time code
1             package Mail::DKIM::Algorithm::Base;
2 14     14   124 use strict;
  14         44  
  14         407  
3 14     14   79 use warnings;
  14         57  
  14         570  
4             our $VERSION = '1.20230212'; # VERSION
5             # ABSTRACT: base class for DKIM "algorithms"
6              
7             # Copyright 2005-2007 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 14     14   6142 use Mail::DKIM::Canonicalization::nowsp;
  14         41  
  14         435  
15 14     14   6058 use Mail::DKIM::Canonicalization::relaxed;
  14         69  
  14         493  
16 14     14   5609 use Mail::DKIM::Canonicalization::simple;
  14         53  
  14         574  
17 14     14   5950 use Mail::DKIM::Canonicalization::seal;
  14         48  
  14         416  
18              
19 14     14   101 use Carp;
  14         30  
  14         911  
20 14     14   6680 use MIME::Base64;
  14         10695  
  14         11462  
21              
22             sub new {
23 473     473 0 876 my $class = shift;
24 473         1718 my %args = @_;
25 473         1011 my $self = bless \%args, $class;
26 473         1359 $self->init;
27 473         1205 return $self;
28             }
29              
30             sub init {
31 452     452 0 690 my $self = shift;
32              
33 452 50       1034 croak 'no signature' unless $self->{Signature};
34              
35 452 100       1138 $self->{mode} = $self->{Signature}->signature ? 'verify' : 'sign';
36              
37             # allows subclasses to set the header_digest and body_digest
38             # properties
39 452         1797 $self->init_digests;
40              
41 452         4921 my ( $header_method, $body_method ) = $self->{Signature}->canonicalization;
42              
43 452         1155 my $header_class = $self->get_canonicalization_class($header_method);
44 452         823 my $body_class = $self->get_canonicalization_class($body_method);
45             $self->{canon} = $header_class->new(
46             output_digest => $self->{header_digest},
47             Signature => $self->{Signature},
48             Debug_Canonicalization => $self->{Debug_Canonicalization}
49 452         2025 );
50             $self->{body_canon} = $body_class->new(
51             output_digest => $self->{body_digest},
52             Signature => $self->{Signature},
53             Debug_Canonicalization => $self->{Debug_Canonicalization}
54 452         1411 );
55             }
56              
57             # override this method, please...
58             # this method should set the "header_digest" and "body_digest" properties
59             sub init_digests {
60 0     0 0 0 die 'not implemented';
61             }
62              
63             # private method - DKIM-specific
64             sub get_canonicalization_class {
65 904     904 0 1354 my $self = shift;
66 904 50       1906 croak 'wrong number of arguments' unless ( @_ == 1 );
67 904         1531 my ($method) = @_;
68              
69 904 50       2255 my $class =
    100          
    100          
    50          
70             $method eq 'nowsp' ? 'Mail::DKIM::Canonicalization::nowsp'
71             : $method eq 'relaxed' ? 'Mail::DKIM::Canonicalization::relaxed'
72             : $method eq 'simple' ? 'Mail::DKIM::Canonicalization::simple'
73             : $method eq 'seal' ? 'Mail::DKIM::Canonicalization::seal'
74             : die "unknown method $method\n";
75 904         1584 return $class;
76             }
77              
78              
79             sub add_body {
80 450     450 1 649 my $self = shift;
81 450   66     1079 my $canon = $self->{body_canon} || $self->{canon};
82 450         1207 $canon->add_body(@_);
83             }
84              
85              
86             sub add_header {
87 5986     5986 1 8012 my $self = shift;
88 5986         12266 $self->{canon}->add_header(@_);
89             }
90              
91              
92             sub finish_body {
93 431     431 1 678 my $self = shift;
94 431   66     1068 my $body_canon = $self->{body_canon} || $self->{canon};
95 431         1391 $body_canon->finish_body;
96 431         913 $self->finish_message;
97             }
98              
99              
100             sub finish_header {
101 469     469 1 851 my $self = shift;
102 469         1456 $self->{canon}->finish_header(@_);
103             }
104              
105             # checks the bh= tag of the signature to see if it has the same body
106             # hash as computed by canonicalizing/digesting the actual message body.
107             # If it doesn't match, a false value is returned, and the
108             # verification_details property is set to "body has been altered"
109             sub check_body_hash {
110 257     257 0 436 my $self = shift;
111              
112             # The body_hash value is set in finish_message(), if we're operating
113             # from a version of the DKIM spec that uses the bh= tag. Otherwise,
114             # the signature shouldn't have a bh= tag to check.
115              
116 257         810 my $sighash = $self->{Signature}->body_hash();
117 257 100 66     1374 if ( $self->{body_hash} and $sighash ) {
118 147         273 my $body_hash = $self->{body_hash};
119 147         487 my $expected = decode_base64($sighash);
120 147 100       404 if ( $body_hash ne $expected ) {
121 5         12 $self->{verification_details} = 'body has been altered';
122              
123             # print STDERR "I calculated "
124             # . encode_base64($body_hash, "") . "\n";
125             # print STDERR "signature has "
126             # . encode_base64($expected, "") . "\n";
127 5         20 return;
128             }
129             }
130 252         841 return 1;
131             }
132              
133             sub finish_message {
134 410     410 0 701 my $self = shift;
135              
136             # DKIM requires the signature itself to be committed into the digest.
137             # But first, we need to set the bh= tag on the signature, then
138             # "prettify" it.
139              
140 410         3225 $self->{body_hash} = $self->{body_digest}->digest;
141 410 100       1225 if ( $self->{mode} eq 'sign' ) {
142             $self->{Signature}
143 56         319 ->body_hash( encode_base64( $self->{body_hash}, '' ) );
144             }
145              
146 410 100       880 if ( $self->{mode} eq 'sign' ) {
147 56         195 $self->{Signature}->prettify;
148             }
149              
150 410         1217 my $sig_line = $self->{Signature}->as_string_without_data;
151 410         1555 my $canonicalized = $self->{canon}->canonicalize_header($sig_line);
152              
153 410         1380 $self->{canon}->output($canonicalized);
154             }
155              
156              
157             # override this method, please...
158             sub sign {
159 0     0 1 0 die 'Not implemented';
160             }
161              
162              
163             sub signature {
164 2124     2124 1 3182 my $self = shift;
165             @_
166 2124 50       4211 and $self->{Signature} = shift;
167 2124         5211 return $self->{Signature};
168             }
169              
170              
171             # override this method, please...
172             sub verify {
173 0     0 1   die 'Not implemented';
174             }
175              
176             1;
177              
178             __END__