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   65825 use strict;
  14         40  
  14         450  
3 14     14   75 use warnings;
  14         26  
  14         816  
4             our $VERSION = '1.20230911'; # 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   85 use base 'Mail::DKIM::Canonicalization::DkimCommon';
  14         37  
  14         1963  
14 14     14   120 use Carp;
  14         40  
  14         5382  
15              
16             sub init {
17 118     118 0 197 my $self = shift;
18 118         350 $self->SUPER::init;
19              
20 118         337 $self->{canonicalize_body_empty_lines} = 0;
21             }
22              
23             sub canonicalize_header {
24 275     275 0 455 my $self = shift;
25 275 50       615 croak 'wrong number of parameters' unless ( @_ == 1 );
26 275         561 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         945 return $line;
35             }
36              
37             sub canonicalize_body {
38 73     73 0 118 my $self = shift;
39 73         143 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         145 my $empty_lines = $self->{canonicalize_body_empty_lines};
52              
53 73 100       202 if ( $multiline =~ s/^((?:\015\012)+)// )
54             { # count & strip leading empty lines
55 1         10 $empty_lines += length($1) / 2;
56             }
57              
58 73 100       212 if ( length($multiline) > 0 ) {
59 72         136 $self->{canonicalize_body_started} = 1;
60 72 50       173 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         296 while ( $multiline =~ /\015\012\015\012\z/ )
68             { # count & strip trailing empty lines
69 50126         300811 chop $multiline;
70 50126         67509 chop $multiline;
71 50126         119728 $empty_lines++;
72             }
73              
74 73         126 $self->{canonicalize_body_empty_lines} = $empty_lines;
75 73         207 return $multiline;
76             }
77              
78             sub finish_body {
79 76     76 0 129 my $self = shift;
80             $self->{canonicalize_body_started}
81 76 100       197 or $self->output("\015\012");
82 76         274 $self->SUPER::finish_body;
83             }
84              
85             1;
86              
87             __END__