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   99 use strict;
  14         31  
  14         439  
3 14     14   72 use warnings;
  14         74  
  14         722  
4             our $VERSION = '1.20230911'; # 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   102 use base 'Mail::DKIM::Canonicalization::DkimCommon';
  14         84  
  14         1572  
14 14     14   101 use Carp;
  14         36  
  14         8324  
15              
16             sub init {
17 803     803 0 1304 my $self = shift;
18 803         2321 $self->SUPER::init;
19              
20 803         2278 $self->{canonicalize_body_empty_lines} = 0;
21             }
22              
23             sub canonicalize_header {
24 2071     2071 0 3283 my $self = shift;
25 2071 50       4616 croak 'wrong number of parameters' unless ( @_ == 1 );
26 2071         4048 my ($line) = @_;
27              
28             #
29             # step 1: convert all header field names (not the header field values)
30             # to lower case
31             #
32 2071 50       7741 if ( $line =~ /^([^:]+):(.*)/s ) {
33              
34             # lowercase field name
35 2071         7518 $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 2071         8960 $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 2071         12779 $line =~ s/[ \t]+/ /g;
49              
50             #
51             # step 4: delete all WSP characters at the end of the header field value
52             #
53 2071         3977 $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 2071         10201 $line =~ s/^([^:\s]+)\s*:\s*/$1:/;
60              
61 2071         9567 return $line;
62             }
63              
64             sub canonicalize_body {
65 187     187 0 419 my ($self, $multiline) = @_;
66              
67 187         883 $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 187         1263 $multiline =~ s/[ \t]+/ /g;
74              
75             #
76             # step 2: ignore all white space at the end of lines
77             #
78 187         862 $multiline =~ s/[ \t]+(?=\015\012|\z)//g;
79              
80 187         337 $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 187         328 my $empty_lines = $self->{canonicalize_body_empty_lines};
89              
90 187 50       458 if ( $multiline =~ s/^((?:\015\012)+)// )
91             { # count & strip leading empty lines
92 0         0 $empty_lines += length($1) / 2;
93             }
94              
95 187 50 33     454 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 187         496 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 187         339 $self->{canonicalize_body_empty_lines} = $empty_lines;
109 187         496 return $multiline;
110             }
111              
112             1;
113              
114             __END__