← 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/Algorithm/dk_rsa_sha1.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@14Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@14
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@15Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@15
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@17Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@17
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@18Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@18
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@19Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@19
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@2Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@2
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@20Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@20
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::BEGIN@3Mail::DKIM::Algorithm::dk_rsa_sha1::BEGIN@3
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::__ANON__Mail::DKIM::Algorithm::dk_rsa_sha1::__ANON__ (xsub)
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::finish_headerMail::DKIM::Algorithm::dk_rsa_sha1::finish_header
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::finish_messageMail::DKIM::Algorithm::dk_rsa_sha1::finish_message
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::get_canonicalization_classMail::DKIM::Algorithm::dk_rsa_sha1::get_canonicalization_class
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::initMail::DKIM::Algorithm::dk_rsa_sha1::init
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::init_digestsMail::DKIM::Algorithm::dk_rsa_sha1::init_digests
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::signMail::DKIM::Algorithm::dk_rsa_sha1::sign
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::verifyMail::DKIM::Algorithm::dk_rsa_sha1::verify
0000s0sMail::DKIM::Algorithm::dk_rsa_sha1::::wants_pre_signature_headersMail::DKIM::Algorithm::dk_rsa_sha1::wants_pre_signature_headers
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::Algorithm::dk_rsa_sha1;
2use strict;
3use warnings;
4our $VERSION = '1.20200907'; # VERSION
5# ABSTRACT: Base algorithm class
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::Canonicalization::dk_simple;
15use Mail::DKIM::Canonicalization::dk_nofws;
16
17use base 'Mail::DKIM::Algorithm::Base';
18use Carp;
19use MIME::Base64;
20use Digest::SHA;
21
22sub finish_header {
23 my $self = shift;
24 $self->SUPER::finish_header(@_);
25
26 if ( ( my $s = $self->signature )
27 && $self->{canon}->{interesting_header} )
28 {
29 my $sender = $self->{canon}->{interesting_header}->{sender};
30 $sender = defined($sender) && ( Mail::Address->parse($sender) )[0];
31 my $author = $self->{canon}->{interesting_header}->{from};
32 $author = defined($author) && ( Mail::Address->parse($author) )[0];
33
34 if ($sender) {
35 $s->init_identity( $sender->address, 'header.sender' );
36 }
37 elsif ($author) {
38 $s->init_identity( $author->address, 'header.from' );
39 }
40 }
41 return;
42}
43
44sub get_canonicalization_class {
45 my $self = shift;
46 croak 'wrong number of arguments' unless ( @_ == 1 );
47 my ($method) = @_;
48
49 my $class =
50 $method eq 'nofws' ? 'Mail::DKIM::Canonicalization::dk_nofws'
51 : $method eq 'simple' ? 'Mail::DKIM::Canonicalization::dk_simple'
52 : die "unknown method $method\n";
53 return $class;
54}
55
56sub init {
57 my $self = shift;
58
59 die 'no signature' unless $self->{Signature};
60
61 $self->{mode} = $self->{Signature}->signature ? 'verify' : 'sign';
62
63 # allows subclasses to set the header_digest and body_digest
64 # properties
65 $self->init_digests;
66
67 my $method = $self->{Signature}->canonicalization;
68
69 my $canon_class = $self->get_canonicalization_class($method);
70 $self->{canon} = $canon_class->new(
71 output_digest => $self->{header_digest},
72 Signature => $self->{Signature},
73 Debug_Canonicalization => $self->{Debug_Canonicalization}
74 );
75}
76
77sub init_digests {
78 my $self = shift;
79
80 # initialize a SHA-1 Digest
81 $self->{header_digest} = Digest::SHA->new(1);
82 $self->{body_digest} = $self->{header_digest};
83}
84
85sub sign {
86 my $self = shift;
87 croak 'wrong number of arguments' unless ( @_ == 1 );
88 my ($private_key) = @_;
89
90 my $digest = $self->{header_digest}->digest;
91 my $signature = $private_key->sign_digest( 'SHA-1', $digest );
92
93 return encode_base64( $signature, '' );
94}
95
96sub verify {
97 my $self = shift;
98 croak 'wrong number of arguments' unless ( @_ == 0 );
99
100 my $base64 = $self->signature->data;
101 my $public_key = $self->signature->get_public_key;
102
103 my $digest = $self->{header_digest}->digest;
104 my $sig = decode_base64($base64);
105 return $public_key->verify_digest( 'SHA-1', $digest, $sig );
106}
107
108sub finish_message {
109 my $self = shift;
110
111 # DomainKeys doesn't include the signature in the digest,
112 # but we still want it to look "pretty" :).
113
114 if ( $self->{mode} eq 'sign' ) {
115 $self->{Signature}->prettify;
116 }
117}
118
119sub wants_pre_signature_headers {
120 return 0;
121}
122
1231;
124
125__END__