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