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   151 use strict;
  14         41  
  14         467  
3 14     14   84 use warnings;
  14         44  
  14         680  
4             our $VERSION = '1.20230911'; # 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   10656 use Mail::DKIM::Canonicalization::nowsp;
  14         34  
  14         433  
15 14     14   6241 use Mail::DKIM::Canonicalization::relaxed;
  14         35  
  14         446  
16 14     14   5986 use Mail::DKIM::Canonicalization::simple;
  14         52  
  14         421  
17 14     14   6095 use Mail::DKIM::Canonicalization::seal;
  14         74  
  14         423  
18              
19 14     14   86 use Carp;
  14         29  
  14         801  
20 14     14   94 use MIME::Base64;
  14         26  
  14         16268  
21              
22             sub new {
23 481     481 0 831 my $class = shift;
24 481         1938 my %args = @_;
25 481         1106 my $self = bless \%args, $class;
26 481         1460 $self->init;
27 481         1178 return $self;
28             }
29              
30             sub init {
31 460     460 0 647 my $self = shift;
32              
33 460 50       1047 croak 'no signature' unless $self->{Signature};
34              
35 460 100       1086 $self->{mode} = $self->{Signature}->signature ? 'verify' : 'sign';
36              
37             # allows subclasses to set the header_digest and body_digest
38             # properties
39 460         1677 $self->init_digests;
40              
41 460         5298 my ( $header_method, $body_method ) = $self->{Signature}->canonicalization;
42              
43 460         1144 my $header_class = $self->get_canonicalization_class($header_method);
44 460         941 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 460         2253 );
50             $self->{body_canon} = $body_class->new(
51             output_digest => $self->{body_digest},
52             Signature => $self->{Signature},
53             Debug_Canonicalization => $self->{Debug_Canonicalization}
54 460         1858 );
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 920     920 0 1285 my $self = shift;
66 920 50       1793 croak 'wrong number of arguments' unless ( @_ == 1 );
67 920         1532 my ($method) = @_;
68              
69 920 50       2328 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 920         1533 return $class;
76             }
77              
78              
79             sub add_body {
80 458     458 1 675 my $self = shift;
81 458   66     1055 my $canon = $self->{body_canon} || $self->{canon};
82 458         1283 $canon->add_body(@_);
83             }
84              
85              
86             sub add_header {
87 6040     6040 1 8231 my $self = shift;
88 6040         12604 $self->{canon}->add_header(@_);
89             }
90              
91              
92             sub finish_body {
93 439     439 1 712 my $self = shift;
94 439   66     1111 my $body_canon = $self->{body_canon} || $self->{canon};
95 439         1402 $body_canon->finish_body;
96 439         1070 $self->finish_message;
97             }
98              
99              
100             sub finish_header {
101 477     477 1 773 my $self = shift;
102 477         1486 $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 259     259 0 451 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 259         809 my $sighash = $self->{Signature}->body_hash();
117 259 100 66     1048 if ( $self->{body_hash} and $sighash ) {
118 149         291 my $body_hash = $self->{body_hash};
119 149         458 my $expected = decode_base64($sighash);
120 149 100       403 if ( $body_hash ne $expected ) {
121 6         18 $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 6         29 return;
128             }
129             }
130 253         947 return 1;
131             }
132              
133             sub finish_message {
134 418     418 0 623 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 418         3339 $self->{body_hash} = $self->{body_digest}->digest;
141 418 100       1325 if ( $self->{mode} eq 'sign' ) {
142             $self->{Signature}
143 58         340 ->body_hash( encode_base64( $self->{body_hash}, '' ) );
144             }
145              
146 418 100       900 if ( $self->{mode} eq 'sign' ) {
147 58         232 $self->{Signature}->prettify;
148             }
149              
150 418         1289 my $sig_line = $self->{Signature}->as_string_without_data;
151 418         1551 my $canonicalized = $self->{canon}->canonicalize_header($sig_line);
152              
153 418         1490 $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 2156     2156 1 3589 my $self = shift;
165             @_
166 2156 50       4242 and $self->{Signature} = shift;
167 2156         5598 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__