← 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/relaxed.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::DKIM::Canonicalization::relaxed::::BEGIN@13Mail::DKIM::Canonicalization::relaxed::BEGIN@13
0000s0sMail::DKIM::Canonicalization::relaxed::::BEGIN@14Mail::DKIM::Canonicalization::relaxed::BEGIN@14
0000s0sMail::DKIM::Canonicalization::relaxed::::BEGIN@2Mail::DKIM::Canonicalization::relaxed::BEGIN@2
0000s0sMail::DKIM::Canonicalization::relaxed::::BEGIN@3Mail::DKIM::Canonicalization::relaxed::BEGIN@3
0000s0sMail::DKIM::Canonicalization::relaxed::::canonicalize_bodyMail::DKIM::Canonicalization::relaxed::canonicalize_body
0000s0sMail::DKIM::Canonicalization::relaxed::::canonicalize_headerMail::DKIM::Canonicalization::relaxed::canonicalize_header
0000s0sMail::DKIM::Canonicalization::relaxed::::initMail::DKIM::Canonicalization::relaxed::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::relaxed;
2use strict;
3use warnings;
4our $VERSION = '1.20200907'; # VERSION
5# ABSTRACT: common canonicalization
6
7# Copyright 2005 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::DkimCommon';
14use Carp;
15
16sub init {
17 my $self = shift;
18 $self->SUPER::init;
19
20 $self->{canonicalize_body_empty_lines} = 0;
21}
22
23sub canonicalize_header {
24 my $self = shift;
25 croak 'wrong number of parameters' unless ( @_ == 1 );
26 my ($line) = @_;
27
28 #
29 # step 1: convert all header field names (not the header field values)
30 # to lower case
31 #
32 if ( $line =~ /^([^:]+):(.*)/s ) {
33
34 # lowercase field name
35 $line = lc($1) . ":$2";
36 }
37
38 #
39 # step 2: unwrap all header field continuation lines... i.e.
40 # remove any CRLF sequences that are followed by WSP
41 #
42 $line =~ s/\015\012(\s)/$1/g;
43
44 #
45 # step 3: convert all sequences of one or more WSP characters to
46 # a single SP character
47 #
48 $line =~ s/[ \t]+/ /g;
49
50 #
51 # step 4: delete all WSP characters at the end of the header field value
52 #
53 $line =~ s/ \z//s;
54
55 #
56 # step 5: delete any WSP character remaining before and after the colon
57 # separating the header field name from the header field value
58 #
59 $line =~ s/^([^:\s]+)\s*:\s*/$1:/;
60
61 return $line;
62}
63
64sub canonicalize_body {
65 my ($self, $multiline) = @_;
66
67 $multiline =~ s/\015\012\z//s;
68
69 #
70 # step 1: reduce all sequences of WSP within a line to a single
71 # SP character
72 #
73 $multiline =~ s/[ \t]+/ /g;
74
75 #
76 # step 2: ignore all white space at the end of lines
77 #
78 $multiline =~ s/[ \t]+(?=\015\012|\z)//g;
79
80 $multiline .= "\015\012";
81
82 #
83 # step 3: ignore empty lines at the end of the message body
84 # (i.e. do not emit empty lines until a following nonempty line
85 # is found)
86 #
87
88 my $empty_lines = $self->{canonicalize_body_empty_lines};
89
90 if ( $multiline =~ s/^((?:\015\012)+)// )
91 { # count & strip leading empty lines
92 $empty_lines += length($1) / 2;
93 }
94
95 if ( $empty_lines > 0 && length($multiline) > 0 )
96 { # re-insert leading white if any nonempty lines exist
97 $multiline = ( "\015\012" x $empty_lines ) . $multiline;
98 $empty_lines = 0;
99 }
100
101 while ( $multiline =~ /\015\012\015\012\z/ )
102 { # count & strip trailing empty lines
103 chop $multiline;
104 chop $multiline;
105 $empty_lines++;
106 }
107
108 $self->{canonicalize_body_empty_lines} = $empty_lines;
109 return $multiline;
110}
111
1121;
113
114__END__