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   67940 use strict;
  14         41  
  14         408  
3 14     14   75 use warnings;
  14         27  
  14         617  
4             our $VERSION = '1.20230212'; # 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   113 use base 'Mail::DKIM::Canonicalization::DkimCommon';
  14         41  
  14         1913  
14 14     14   114 use Carp;
  14         30  
  14         5313  
15              
16             sub init {
17 116     116 0 193 my $self = shift;
18 116         360 $self->SUPER::init;
19              
20 116         347 $self->{canonicalize_body_empty_lines} = 0;
21             }
22              
23             sub canonicalize_header {
24 275     275 0 435 my $self = shift;
25 275 50       587 croak 'wrong number of parameters' unless ( @_ == 1 );
26 275         498 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         986 return $line;
35             }
36              
37             sub canonicalize_body {
38 71     71 0 124 my $self = shift;
39 71         184 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 71         122 my $empty_lines = $self->{canonicalize_body_empty_lines};
52              
53 71 100       220 if ( $multiline =~ s/^((?:\015\012)+)// )
54             { # count & strip leading empty lines
55 1         5 $empty_lines += length($1) / 2;
56             }
57              
58 71 100       173 if ( length($multiline) > 0 ) {
59 70         181 $self->{canonicalize_body_started} = 1;
60 70 50       186 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 71         283 while ( $multiline =~ /\015\012\015\012\z/ )
68             { # count & strip trailing empty lines
69 50126         339371 chop $multiline;
70 50126         69047 chop $multiline;
71 50126         127205 $empty_lines++;
72             }
73              
74 71         143 $self->{canonicalize_body_empty_lines} = $empty_lines;
75 71         308 return $multiline;
76             }
77              
78             sub finish_body {
79 74     74 0 140 my $self = shift;
80             $self->{canonicalize_body_started}
81 74 100       233 or $self->output("\015\012");
82 74         250 $self->SUPER::finish_body;
83             }
84              
85             1;
86              
87             __END__