File Coverage

blib/lib/Mail/DKIM/Canonicalization/relaxed.pm
Criterion Covered Total %
statement 36 42 85.7
branch 4 8 50.0
condition 1 3 33.3
subroutine 7 7 100.0
pod 0 3 0.0
total 48 63 76.1


line stmt bran cond sub pod time code
1             package Mail::DKIM::Canonicalization::relaxed;
2 14     14   100 use strict;
  14         29  
  14         411  
3 14     14   73 use warnings;
  14         33  
  14         673  
4             our $VERSION = '1.20230212'; # VERSION
5             # ABSTRACT: common canonicalization
6              
7             # Copyright 2005 Messiah College. All rights reserved.
8             # Jason Long
9              
10             # This program is free software; you can redistribute it and/or
11             # modify it under the same terms as Perl itself.
12              
13 14     14   89 use base 'Mail::DKIM::Canonicalization::DkimCommon';
  14         45  
  14         1344  
14 14     14   92 use Carp;
  14         34  
  14         8046  
15              
16             sub init {
17 789     789 0 1225 my $self = shift;
18 789         2161 $self->SUPER::init;
19              
20 789         2054 $self->{canonicalize_body_empty_lines} = 0;
21             }
22              
23             sub canonicalize_header {
24 2009     2009 0 3194 my $self = shift;
25 2009 50       4192 croak 'wrong number of parameters' unless ( @_ == 1 );
26 2009         3976 my ($line) = @_;
27              
28             #
29             # step 1: convert all header field names (not the header field values)
30             # to lower case
31             #
32 2009 50       7313 if ( $line =~ /^([^:]+):(.*)/s ) {
33              
34             # lowercase field name
35 2009         7511 $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 2009         8668 $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 2009         12594 $line =~ s/[ \t]+/ /g;
49              
50             #
51             # step 4: delete all WSP characters at the end of the header field value
52             #
53 2009         3811 $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 2009         10027 $line =~ s/^([^:\s]+)\s*:\s*/$1:/;
60              
61 2009         9483 return $line;
62             }
63              
64             sub canonicalize_body {
65 181     181 0 419 my ($self, $multiline) = @_;
66              
67 181         831 $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 181         1227 $multiline =~ s/[ \t]+/ /g;
74              
75             #
76             # step 2: ignore all white space at the end of lines
77             #
78 181         808 $multiline =~ s/[ \t]+(?=\015\012|\z)//g;
79              
80 181         350 $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 181         342 my $empty_lines = $self->{canonicalize_body_empty_lines};
89              
90 181 50       433 if ( $multiline =~ s/^((?:\015\012)+)// )
91             { # count & strip leading empty lines
92 0         0 $empty_lines += length($1) / 2;
93             }
94              
95 181 50 33     816 if ( $empty_lines > 0 && length($multiline) > 0 )
96             { # re-insert leading white if any nonempty lines exist
97 0         0 $multiline = ( "\015\012" x $empty_lines ) . $multiline;
98 0         0 $empty_lines = 0;
99             }
100              
101 181         559 while ( $multiline =~ /\015\012\015\012\z/ )
102             { # count & strip trailing empty lines
103 0         0 chop $multiline;
104 0         0 chop $multiline;
105 0         0 $empty_lines++;
106             }
107              
108 181         318 $self->{canonicalize_body_empty_lines} = $empty_lines;
109 181         501 return $multiline;
110             }
111              
112             1;
113              
114             __END__