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__ |