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 15     15   101 use strict;
  15         36  
  15         643  
3 15     15   115 use warnings;
  15         51  
  15         1392  
4             our $VERSION = '1.20240923'; # 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 15     15   112 use base 'Mail::DKIM::Canonicalization::DkimCommon';
  15         83  
  15         2707  
14 15     15   105 use Carp;
  15         31  
  15         12632  
15              
16             sub init {
17 805     805 0 1346 my $self = shift;
18 805         2894 $self->SUPER::init;
19              
20 805         1911 $self->{canonicalize_body_empty_lines} = 0;
21             }
22              
23             sub canonicalize_header {
24 2077     2077 0 3488 my $self = shift;
25 2077 50       6365 croak 'wrong number of parameters' unless ( @_ == 1 );
26 2077         4572 my ($line) = @_;
27              
28             #
29             # step 1: convert all header field names (not the header field values)
30             # to lower case
31             #
32 2077 50       9692 if ( $line =~ /^([^:]+):(.*)/s ) {
33              
34             # lowercase field name
35 2077         9362 $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 2077         11286 $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 2077         17807 $line =~ s/[ \t]+/ /g;
49              
50             #
51             # step 4: delete all WSP characters at the end of the header field value
52             #
53 2077         5683 $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 2077         21927 $line =~ s/^([^:\s]+)\s*:\s*/$1:/;
60              
61 2077         12136 return $line;
62             }
63              
64             sub canonicalize_body {
65 187     187 0 636 my ($self, $multiline) = @_;
66              
67 187         1237 $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         1753 $multiline =~ s/[ \t]+/ /g;
74              
75             #
76             # step 2: ignore all white space at the end of lines
77             #
78 187         1240 $multiline =~ s/[ \t]+(?=\015\012|\z)//g;
79              
80 187         455 $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         435 my $empty_lines = $self->{canonicalize_body_empty_lines};
89              
90 187 50       699 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     706 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         730 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         433 $self->{canonicalize_body_empty_lines} = $empty_lines;
109 187         737 return $multiline;
110             }
111              
112             1;
113              
114             __END__