← 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:14 2021

Filename/usr/local/lib/perl5/site_perl/Mail/DKIM/PrivateKey.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::DKIM::PrivateKey::::BEGIN@15Mail::DKIM::PrivateKey::BEGIN@15
0000s0sMail::DKIM::PrivateKey::::BEGIN@16Mail::DKIM::PrivateKey::BEGIN@16
0000s0sMail::DKIM::PrivateKey::::BEGIN@2Mail::DKIM::PrivateKey::BEGIN@2
0000s0sMail::DKIM::PrivateKey::::BEGIN@3Mail::DKIM::PrivateKey::BEGIN@3
0000s0sMail::DKIM::PrivateKey::::BEGIN@55Mail::DKIM::PrivateKey::BEGIN@55
0000s0sMail::DKIM::PrivateKey::::__ANON__Mail::DKIM::PrivateKey::__ANON__ (xsub)
0000s0sMail::DKIM::PrivateKey::::convertMail::DKIM::PrivateKey::convert
0000s0sMail::DKIM::PrivateKey::::loadMail::DKIM::PrivateKey::load
0000s0sMail::DKIM::PrivateKey::::signMail::DKIM::PrivateKey::sign
0000s0sMail::DKIM::PrivateKey::::sign_digestMail::DKIM::PrivateKey::sign_digest
0000s0sMail::DKIM::PrivateKey::::sign_sha1_digestMail::DKIM::PrivateKey::sign_sha1_digest
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::PrivateKey;
2use strict;
3use warnings;
4our $VERSION = '1.20200907'; # VERSION
5# ABSTRACT: a private key loaded in memory for DKIM signing
6
7# Copyright 2005-2007 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
14
15use base 'Mail::DKIM::Key';
16use Carp;
17*calculate_EM = \&Mail::DKIM::Key::calculate_EM;
18
19
20sub load {
21 my $class = shift;
22 my %prms = @_;
23
24 my $self = bless {}, $class;
25
26 $self->{'TYPE'} = ( $prms{'Type'} or 'rsa' );
27
28 if ( $prms{'Data'} ) {
29 $self->{'DATA'} = $prms{'Data'};
30 }
31 elsif ( defined $prms{'File'} ) {
32 my @data;
33 open my $file, '<', $prms{'File'}
34 or die "Error: cannot read $prms{File}: $!\n";
35 while ( my $line = <$file> ) {
36 chomp $line;
37 next if $line =~ /^---/;
38 push @data, $line;
39 }
40 $self->{'DATA'} = join '', @data;
41 close $file;
42 }
43 elsif ( $prms{'Cork'} ) {
44 $self->{'CORK'} = $prms{'Cork'};
45 }
46 else {
47 croak 'missing required argument';
48 }
49
50 return $self;
51}
52
53
54sub convert {
55 use Crypt::OpenSSL::RSA;
56
57 my $self = shift;
58
59 $self->data
60 or return;
61
62 # have to PKCS1ify the privkey because openssl is too finicky...
63 my $pkcs = "-----BEGIN RSA PRIVATE KEY-----\n";
64
65 for ( my $i = 0 ; $i < length $self->data ; $i += 64 ) {
66 $pkcs .= substr $self->data, $i, 64;
67 $pkcs .= "\n";
68 }
69
70 $pkcs .= "-----END RSA PRIVATE KEY-----\n";
71
72 my $cork;
73
74 eval {
75 local $SIG{__DIE__};
76 $cork = new_private_key Crypt::OpenSSL::RSA($pkcs);
77 1
78 } || do {
79 $self->errorstr($@);
80 return;
81 };
82
83 $cork
84 or return;
85
86 # segfaults on my machine
87 # $cork->check_key or
88 # return;
89
90 $self->cork($cork);
91
92 return 1;
93}
94
95#deprecated
96sub sign {
97 my $self = shift;
98 my $mail = shift;
99
100 return $self->cork->sign($mail);
101}
102
103#deprecated- use sign_digest() instead
104sub sign_sha1_digest {
105 my $self = shift;
106 my ($digest) = @_;
107 return $self->sign_digest( 'SHA-1', $digest );
108}
109
110
111sub sign_digest {
112 my $self = shift;
113 my ( $digest_algorithm, $digest ) = @_;
114
115 my $rsa_priv = $self->cork;
116 $rsa_priv->use_no_padding;
117
118 my $k = $rsa_priv->size;
119 my $EM = calculate_EM( $digest_algorithm, $digest, $k );
120 return $rsa_priv->decrypt($EM);
121}
122
123__END__