File Coverage

blib/lib/Mail/DKIM/Canonicalization/simple.pm
Criterion Covered Total %
statement 36 38 94.7
branch 8 10 80.0
condition n/a
subroutine 8 8 100.0
pod 0 4 0.0
total 52 60 86.6


line stmt bran cond sub pod time code
1             package Mail::DKIM::Canonicalization::simple;
2 14     14   65462 use strict;
  14         43  
  14         445  
3 14     14   73 use warnings;
  14         27  
  14         796  
4             our $VERSION = '1.20230630'; # VERSION
5             # ABSTRACT: simple 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         27  
  14         1942  
14 14     14   112 use Carp;
  14         33  
  14         5386  
15              
16             sub init {
17 118     118 0 195 my $self = shift;
18 118         344 $self->SUPER::init;
19              
20 118         314 $self->{canonicalize_body_empty_lines} = 0;
21             }
22              
23             sub canonicalize_header {
24 275     275 0 412 my $self = shift;
25 275 50       591 croak 'wrong number of parameters' unless ( @_ == 1 );
26 275         547 my ($line) = @_;
27              
28             #
29             # draft-allman-dkim-base-01.txt, section 3.4.1:
30             # the "simple" header field canonicalization algorithm does not
31             # change the header field in any way
32             #
33              
34 275         972 return $line;
35             }
36              
37             sub canonicalize_body {
38 73     73 0 120 my $self = shift;
39 73         155 my ($multiline) = @_;
40              
41             #
42             # draft-allman-dkim-base-01.txt, section 3.4.3:
43             # the "simple" body canonicalization algorithm ignores all
44             # empty lines at the end of the message body
45             #
46              
47             #
48             # (i.e. do not emit empty lines until a following nonempty line
49             # is found)
50             #
51 73         133 my $empty_lines = $self->{canonicalize_body_empty_lines};
52              
53 73 100       203 if ( $multiline =~ s/^((?:\015\012)+)// )
54             { # count & strip leading empty lines
55 1         5 $empty_lines += length($1) / 2;
56             }
57              
58 73 100       198 if ( length($multiline) > 0 ) {
59 72         169 $self->{canonicalize_body_started} = 1;
60 72 50       160 if ( $empty_lines > 0 )
61             { # re-insert leading white if any nonempty lines exist
62 0         0 $multiline = ( "\015\012" x $empty_lines ) . $multiline;
63 0         0 $empty_lines = 0;
64             }
65             }
66              
67 73         291 while ( $multiline =~ /\015\012\015\012\z/ )
68             { # count & strip trailing empty lines
69 50126         284248 chop $multiline;
70 50126         65957 chop $multiline;
71 50126         121149 $empty_lines++;
72             }
73              
74 73         133 $self->{canonicalize_body_empty_lines} = $empty_lines;
75 73         195 return $multiline;
76             }
77              
78             sub finish_body {
79 76     76 0 144 my $self = shift;
80             $self->{canonicalize_body_started}
81 76 100       198 or $self->output("\015\012");
82 76         308 $self->SUPER::finish_body;
83             }
84              
85             1;
86              
87             __END__