← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:15 2021

Filename/usr/local/lib/perl5/site_perl/Mail/DKIM/DkSignature.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::DKIM::DkSignature::::BEGIN@124Mail::DKIM::DkSignature::BEGIN@124
0000s0sMail::DKIM::DkSignature::::BEGIN@14Mail::DKIM::DkSignature::BEGIN@14
0000s0sMail::DKIM::DkSignature::::BEGIN@15Mail::DKIM::DkSignature::BEGIN@15
0000s0sMail::DKIM::DkSignature::::BEGIN@17Mail::DKIM::DkSignature::BEGIN@17
0000s0sMail::DKIM::DkSignature::::BEGIN@18Mail::DKIM::DkSignature::BEGIN@18
0000s0sMail::DKIM::DkSignature::::BEGIN@2Mail::DKIM::DkSignature::BEGIN@2
0000s0sMail::DKIM::DkSignature::::BEGIN@3Mail::DKIM::DkSignature::BEGIN@3
0000s0sMail::DKIM::DkSignature::::DEFAULT_PREFIXMail::DKIM::DkSignature::DEFAULT_PREFIX
0000s0sMail::DKIM::DkSignature::::__ANON__Mail::DKIM::DkSignature::__ANON__ (xsub)
0000s0sMail::DKIM::DkSignature::::algorithmMail::DKIM::DkSignature::algorithm
0000s0sMail::DKIM::DkSignature::::as_string_without_dataMail::DKIM::DkSignature::as_string_without_data
0000s0sMail::DKIM::DkSignature::::body_countMail::DKIM::DkSignature::body_count
0000s0sMail::DKIM::DkSignature::::body_hashMail::DKIM::DkSignature::body_hash
0000s0sMail::DKIM::DkSignature::::canonicalizationMail::DKIM::DkSignature::canonicalization
0000s0sMail::DKIM::DkSignature::::check_canonicalizationMail::DKIM::DkSignature::check_canonicalization
0000s0sMail::DKIM::DkSignature::::check_protocolMail::DKIM::DkSignature::check_protocol
0000s0sMail::DKIM::DkSignature::::check_versionMail::DKIM::DkSignature::check_version
0000s0sMail::DKIM::DkSignature::::domainMail::DKIM::DkSignature::domain
0000s0sMail::DKIM::DkSignature::::expirationMail::DKIM::DkSignature::expiration
0000s0sMail::DKIM::DkSignature::::get_algorithm_classMail::DKIM::DkSignature::get_algorithm_class
0000s0sMail::DKIM::DkSignature::::hash_algorithmMail::DKIM::DkSignature::hash_algorithm
0000s0sMail::DKIM::DkSignature::::identityMail::DKIM::DkSignature::identity
0000s0sMail::DKIM::DkSignature::::identity_sourceMail::DKIM::DkSignature::identity_source
0000s0sMail::DKIM::DkSignature::::init_identityMail::DKIM::DkSignature::init_identity
0000s0sMail::DKIM::DkSignature::::methodMail::DKIM::DkSignature::method
0000s0sMail::DKIM::DkSignature::::newMail::DKIM::DkSignature::new
0000s0sMail::DKIM::DkSignature::::parseMail::DKIM::DkSignature::parse
0000s0sMail::DKIM::DkSignature::::protocolMail::DKIM::DkSignature::protocol
0000s0sMail::DKIM::DkSignature::::timestampMail::DKIM::DkSignature::timestamp
0000s0sMail::DKIM::DkSignature::::versionMail::DKIM::DkSignature::version
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Mail::DKIM::DkSignature;
2use strict;
3use warnings;
4our $VERSION = '1.20200907'; # VERSION
5# ABSTRACT: represents a DomainKeys-Signature header
6
7# Copyright 2005-2006 Messiah College. All rights reserved.
8# Jason Long <jlong@messiah.edu>
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
14use Mail::DKIM::PublicKey;
15use Mail::DKIM::Algorithm::dk_rsa_sha1;
16
17use base 'Mail::DKIM::Signature';
18use Carp;
19
20
21sub new {
22 my $type = shift;
23 my %prms = @_;
24 my $self = {};
25 bless $self, $type;
26
27 $self->algorithm( $prms{'Algorithm'} || 'rsa-sha1' );
28 $self->signature( $prms{'Signature'} );
29 $self->canonicalization( $prms{'Method'} || 'simple' );
30 $self->domain( $prms{'Domain'} );
31 $self->headerlist( $prms{'Headers'} );
32 $self->protocol( $prms{'Query'} || 'dns' );
33 $self->selector( $prms{'Selector'} );
34 $self->key( $prms{'Key'} ) if defined $prms{'Key'};
35
36 return $self;
37}
38
39
40sub parse {
41 my $class = shift;
42 croak 'wrong number of arguments' unless ( @_ == 1 );
43 my ($string) = @_;
44
45 # remove line terminator, if present
46 $string =~ s/\015\012\z//;
47
48 # remove field name, if present
49 my $prefix;
50 if ( $string =~ /^(domainkey-signature:)(.*)/si ) {
51
52 # save the field name (capitalization), so that it can be
53 # restored later
54 $prefix = $1;
55 $string = $2;
56 }
57
58 my $self = $class->Mail::DKIM::KeyValueList::parse($string);
59 $self->{prefix} = $prefix;
60
61 return $self;
62}
63
- -
66sub as_string_without_data {
67 croak 'as_string_without_data not implemented';
68}
69
70sub body_count {
71 croak 'body_count not implemented';
72}
73
74sub body_hash {
75 croak 'body_hash not implemented';
76}
77
78
79sub algorithm {
80 my $self = shift;
81
82 if (@_) {
83 $self->set_tag( 'a', shift );
84 }
85
86 my $a = $self->get_tag('a');
87 return defined $a && $a ne '' ? lc $a : 'rsa-sha1';
88}
89
90
91sub canonicalization {
92 my $self = shift;
93 croak 'too many arguments' if ( @_ > 1 );
94
95 if (@_) {
96 $self->set_tag( 'c', shift );
97 }
98
99 return lc( $self->get_tag('c') ) || 'simple';
100}
101
102sub DEFAULT_PREFIX {
103 return 'DomainKey-Signature:';
104}
105
106
107sub domain {
108 my $self = shift;
109
110 if (@_) {
111 $self->set_tag( 'd', shift );
112 }
113
114 my $d = $self->get_tag('d');
115 return defined $d ? lc $d : undef;
116}
117
118sub expiration {
119 my $self = shift;
120 croak 'cannot change expiration on ' . ref($self) if @_;
121 return undef;
122}
123
124use MIME::Base64;
125
126sub check_canonicalization {
127 my $self = shift;
128
129 my $c = $self->canonicalization;
130
131 my @known = ( 'nofws', 'simple' );
132 return unless ( grep { $_ eq $c } @known );
133 return 1;
134}
135
136# Returns a filtered list of protocols that can be used to fetch the
137# public key corresponding to this signature. An empty list means that
138# all designated protocols are unrecognized.
139# Note: at this time, the only recognized protocol for DomainKey
140# signatures is "dns".
141#
142sub check_protocol {
143 my $self = shift;
144
145 my $protocol = $self->protocol;
146 return 'dns/txt' if $protocol && $protocol eq 'dns';
147 return;
148}
149
150sub check_version {
151
152 #DomainKeys doesn't have a v= tag
153 return 1;
154}
155
156sub get_algorithm_class {
157 my $self = shift;
158 croak 'wrong number of arguments' unless ( @_ == 1 );
159 my ($algorithm) = @_;
160
161 my $class =
162 $algorithm eq 'rsa-sha1'
163 ? 'Mail::DKIM::Algorithm::dk_rsa_sha1'
164 : undef;
165 return $class;
166}
167
168# get_public_key - same as parent class
169
170sub hash_algorithm {
171 my $self = shift;
172 my $algorithm = $self->algorithm;
173
174 return $algorithm eq 'rsa-sha1' ? 'sha1' : undef;
175}
176
177
178#sub headerlist
179# is in Signature.pm
180
181
182sub identity {
183 my $self = shift;
184 croak 'cannot change identity on ' . ref($self) if @_;
185 return $self->{dk_identity};
186}
187
188
189sub identity_source {
190 my $self = shift;
191 croak 'unexpected argument' if @_;
192 return $self->{dk_identity_source};
193}
194
195# init_identity() - initialize the DomainKeys concept of identity
196#
197# The signing identity of a DomainKeys signature is the sender
198# of the message itself, i.e. the address in the Sender/From header.
199# The sender may not be known when the signature object is
200# constructed (since the signature usually precedes the From/Sender
201# header), so use this method when you have the From/Sender value.
202# See also finish_header() in Mail::DKIM::Verifier.
203#
204sub init_identity {
205 my $self = shift;
206 $self->{dk_identity} = shift;
207 $self->{dk_identity_source} = shift;
208}
209
210sub method {
211 croak 'method not implemented (use canonicalization instead)';
212}
213
214
215sub protocol {
216 my $self = shift;
217
218 (@_)
219 and $self->set_tag( 'q', shift );
220
221 # although draft-delany-domainkeys-base-06 does mandate presence of a
222 # q=dns tag, it is quote common that q tag is missing - be merciful
223 return !defined( $self->get_tag('q') ) ? 'dns' : lc $self->get_tag('q');
224}
225
226
227# same as parent class
228
229
230# same as parent class
231
232sub timestamp {
233 croak 'timestamp not implemented';
234}
235
236sub version {
237 croak 'version not implemented';
238}
239
240
2411;
242
243__END__