← 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/Canonicalization/DkimCommon.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::DKIM::Canonicalization::DkimCommon::::BEGIN@14Mail::DKIM::Canonicalization::DkimCommon::BEGIN@14
0000s0sMail::DKIM::Canonicalization::DkimCommon::::BEGIN@15Mail::DKIM::Canonicalization::DkimCommon::BEGIN@15
0000s0sMail::DKIM::Canonicalization::DkimCommon::::BEGIN@2Mail::DKIM::Canonicalization::DkimCommon::BEGIN@2
0000s0sMail::DKIM::Canonicalization::DkimCommon::::BEGIN@3Mail::DKIM::Canonicalization::DkimCommon::BEGIN@3
0000s0sMail::DKIM::Canonicalization::DkimCommon::::add_bodyMail::DKIM::Canonicalization::DkimCommon::add_body
0000s0sMail::DKIM::Canonicalization::DkimCommon::::add_headerMail::DKIM::Canonicalization::DkimCommon::add_header
0000s0sMail::DKIM::Canonicalization::DkimCommon::::body_countMail::DKIM::Canonicalization::DkimCommon::body_count
0000s0sMail::DKIM::Canonicalization::DkimCommon::::body_truncatedMail::DKIM::Canonicalization::DkimCommon::body_truncated
0000s0sMail::DKIM::Canonicalization::DkimCommon::::finish_bodyMail::DKIM::Canonicalization::DkimCommon::finish_body
0000s0sMail::DKIM::Canonicalization::DkimCommon::::finish_headerMail::DKIM::Canonicalization::DkimCommon::finish_header
0000s0sMail::DKIM::Canonicalization::DkimCommon::::finish_messageMail::DKIM::Canonicalization::DkimCommon::finish_message
0000s0sMail::DKIM::Canonicalization::DkimCommon::::initMail::DKIM::Canonicalization::DkimCommon::init
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::Canonicalization::DkimCommon;
2use strict;
3use warnings;
4our $VERSION = '1.20200907'; # VERSION
5# ABSTRACT: common canonicalization
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
14use base 'Mail::DKIM::Canonicalization::Base';
15use Carp;
16
17sub init {
18 my $self = shift;
19 $self->SUPER::init;
20
21 $self->{body_count} = 0;
22 $self->{body_truncated} = 0;
23
24 # these canonicalization methods require signature to use
25 $self->{Signature}
26 or croak 'no signature specified';
27}
28
29# similar to code in DkCommon.pm
30sub add_header {
31
32 #Note: canonicalization of headers is performed
33 #in finish_header()
34}
35
36sub finish_header {
37 my $self = shift;
38 my %args = @_;
39
40 # Headers are canonicalized in the order specified by the h= tag.
41 # However, in the case of multiple instances of the same header name,
42 # the headers will be canonicalized in reverse order (i.e. "from
43 # the bottom of the header field block to the top").
44 #
45 # This is described in 5.4 of RFC4871.
46
47 # Since the bottom-most headers are to get precedence, we reverse
48 # the headers here... (now the first header matching a particular
49 # name is the header to insert)
50 my @mess_headers = reverse @{ $args{Headers} };
51
52 # presence of a h= tag is mandatory...
53 unless ( defined $self->{Signature}->headerlist ) {
54 die "Error: h= tag is required for this canonicalization\n";
55 }
56
57 # iterate through the header field names specified in the signature
58 my @sig_headers = $self->{Signature}->headerlist;
59 foreach my $hdr_name (@sig_headers) {
60 $hdr_name = lc $hdr_name;
61
62 # find the specified header in the message
63 inner_loop:
64 for ( my $i = 0 ; $i < @mess_headers ; $i++ ) {
65 my $hdr = $mess_headers[$i];
66
67 if ( $hdr =~ /^([^\s:]+)\s*:/ ) {
68 my $key = lc $1;
69 if ( $key eq $hdr_name ) {
70
71 # found it
72
73 # remove it from our list, so if it occurs more than
74 # once, we'll get the next header in line
75 splice @mess_headers, $i, 1;
76
77 $hdr =~ s/\015\012\z//s;
78 $self->output(
79 $self->canonicalize_header($hdr) . "\015\012" );
80 last inner_loop;
81 }
82 }
83 }
84 }
85}
86
87sub add_body {
88 my $self = shift;
89 my ($multiline) = @_;
90
91 $multiline = $self->canonicalize_body($multiline);
92 if ( $self->{Signature} ) {
93 if ( my $limit = $self->{Signature}->body_count ) {
94 my $remaining = $limit - $self->{body_count};
95 if ( length($multiline) > $remaining ) {
96 $self->{body_truncated} += length($multiline) - $remaining;
97 $multiline = substr( $multiline, 0, $remaining );
98 }
99 }
100 }
101
102 $self->{body_count} += length($multiline);
103 $self->output($multiline);
104}
105
106sub finish_body {
107}
108
109sub finish_message {
110 my $self = shift;
111
112 if ( $self->{Signature} ) {
113 $self->output("\015\012");
114
115 # append the DKIM-Signature (without data)
116 my $line = $self->{Signature}->as_string_without_data;
117
118 # signature is subject to same canonicalization as headers
119 $self->output( $self->canonicalize_header($line) );
120 }
121}
122
123sub body_count {
124 my $self = shift;
125 return $self->{body_count};
126}
127
128sub body_truncated {
129 my $self = shift;
130 return $self->{body_truncated};
131}
132
1331;
134
135__END__