← 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/Canonicalization/DkCommon.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::DKIM::Canonicalization::DkCommon::::BEGIN@13Mail::DKIM::Canonicalization::DkCommon::BEGIN@13
0000s0sMail::DKIM::Canonicalization::DkCommon::::BEGIN@14Mail::DKIM::Canonicalization::DkCommon::BEGIN@14
0000s0sMail::DKIM::Canonicalization::DkCommon::::BEGIN@2Mail::DKIM::Canonicalization::DkCommon::BEGIN@2
0000s0sMail::DKIM::Canonicalization::DkCommon::::BEGIN@3Mail::DKIM::Canonicalization::DkCommon::BEGIN@3
0000s0sMail::DKIM::Canonicalization::DkCommon::::add_bodyMail::DKIM::Canonicalization::DkCommon::add_body
0000s0sMail::DKIM::Canonicalization::DkCommon::::add_headerMail::DKIM::Canonicalization::DkCommon::add_header
0000s0sMail::DKIM::Canonicalization::DkCommon::::finish_bodyMail::DKIM::Canonicalization::DkCommon::finish_body
0000s0sMail::DKIM::Canonicalization::DkCommon::::finish_headerMail::DKIM::Canonicalization::DkCommon::finish_header
0000s0sMail::DKIM::Canonicalization::DkCommon::::finish_messageMail::DKIM::Canonicalization::DkCommon::finish_message
0000s0sMail::DKIM::Canonicalization::DkCommon::::initMail::DKIM::Canonicalization::DkCommon::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::DkCommon;
2use strict;
3use warnings;
4our $VERSION = '1.20200907'; # VERSION
5# ABSTRACT: dk common canonicalization
6
7# Copyright 2005-2006 Messiah College. All rights reserved.
8# Jason Long <jlong@messiah.edu>
9
10# This program is free software; you can redistribute it and/or
11# modify it under the same terms as Perl itself.
12
13use base 'Mail::DKIM::Canonicalization::Base';
14use Carp;
15
16sub init {
17 my $self = shift;
18 $self->SUPER::init;
19
20 $self->{header_count} = 0;
21}
22
23# similar to code in DkimCommon.pm
24sub add_header {
25
26 #Note: canonicalization of headers is performed
27 #in finish_header()
28
29 my $self = shift;
30 $self->{header_count}++;
31}
32
33sub finish_header {
34 my $self = shift;
35 my %args = @_;
36
37 # RFC4870, 3.3:
38 # h = A colon-separated list of header field names that identify the
39 # headers presented to the signing algorithm. If present, the
40 # value MUST contain the complete list of headers in the order
41 # presented to the signing algorithm.
42 #
43 # In the presence of duplicate headers, a signer may include
44 # duplicate entries in the list of headers in this tag. If a
45 # header is included in this list, a verifier must include all
46 # occurrences of that header, subsequent to the "DomainKey-
47 # Signature:" header in the verification.
48 #
49 # RFC4870, 3.4.2.1:
50 # * Each line of the email is presented to the signing algorithm in
51 # the order it occurs in the complete email, from the first line of
52 # the headers to the last line of the body.
53 # * If the "h" tag is used, only those header lines (and their
54 # continuation lines if any) added to the "h" tag list are included.
55
56 # only consider headers AFTER my signature
57 my @sig_headers;
58 {
59 my $s0 = @{ $args{Headers} } - $self->{header_count};
60 my $s1 = @{ $args{Headers} } - 1;
61 @sig_headers = ( @{ $args{Headers} } )[ $s0 .. $s1 ];
62 }
63
64 # check if signature specifies a list of headers
65 my @sig_header_names = $self->{Signature}->headerlist;
66 if (@sig_header_names) {
67
68 # - first, group all header fields with the same name together
69 # (using a hash of arrays)
70 my %heads;
71 foreach my $line (@sig_headers) {
72 next unless $line =~ /^([^\s:]+)\s*:/;
73 my $field_name = lc $1;
74
75 $heads{$field_name} ||= [];
76 push @{ $heads{$field_name} }, $line;
77 }
78
79 # - second, count how many times each header field name appears
80 # in the h= tag
81 my %counts;
82 foreach my $field_name (@sig_header_names) {
83 $heads{ lc $field_name } ||= [];
84 $counts{ lc $field_name }++;
85 }
86
87 # - finally, working backwards through the h= tag,
88 # collect the headers we will be signing (last to first).
89 # Normally, one occurrence of a name in the h= tag
90 # correlates to one occurrence of that header being presented
91 # to canonicalization, but if (working backwards) we are
92 # at the first occurrence of that name, and there are
93 # multiple headers of that name, then put them all in.
94 #
95 @sig_headers = ();
96 while ( my $field_name = pop @sig_header_names ) {
97 $counts{ lc $field_name }--;
98 if ( $counts{ lc $field_name } > 0 ) {
99
100 # this field is named more than once in the h= tag,
101 # so only take the last occuring of that header
102 my $line = pop @{ $heads{ lc $field_name } };
103 unshift @sig_headers, $line if defined $line;
104 }
105 else {
106 unshift @sig_headers, @{ $heads{ lc $field_name } };
107 $heads{ lc $field_name } = [];
108 }
109 }
110 }
111
112 # iterate through each header, in the order determined above
113 foreach my $line (@sig_headers) {
114 if ( $line =~ /^(from|sender)\s*:(.*)$/i ) {
115 my $field = $1;
116 my $content = $2;
117 $self->{interesting_header}->{ lc $field } = $content;
118 }
119 $line =~ s/\015\012\z//s;
120 $self->output( $self->canonicalize_header( $line . "\015\012" ) );
121 }
122
123 $self->output( $self->canonicalize_body("\015\012") );
124}
125
126sub add_body {
127 my $self = shift;
128 my ($multiline) = @_;
129
130 $self->output( $self->canonicalize_body($multiline) );
131}
132
133sub finish_body {
134}
135
136sub finish_message {
137}
138
1391;
140
141__END__