File Coverage

blib/lib/Mail/Milter/Authentication/Handler/XGoogleDKIM.pm
Criterion Covered Total %
statement 138 193 71.5
branch 32 58 55.1
condition 5 24 20.8
subroutine 15 18 83.3
pod 1 9 11.1
total 191 302 63.2


line stmt bran cond sub pod time code
1             package Mail::Milter::Authentication::Handler::XGoogleDKIM;
2 16     16   10232 use 5.20.0;
  16         77  
3 16     16   142 use strict;
  16         57  
  16         468  
4 16     16   123 use warnings;
  16         62  
  16         530  
5 16     16   102 use Mail::Milter::Authentication::Pragmas;
  16         76  
  16         137  
6             # ABSTRACT: Handler class for Google specific DKIM
7             our $VERSION = '3.20230911'; # VERSION
8 16     16   4156 use base 'Mail::Milter::Authentication::Handler';
  16         46  
  16         2103  
9 16     16   1710 use Mail::DKIM 1.20200824;
  16         744  
  16         402  
10 16     16   1429 use Mail::DKIM::DNS;
  16         3127  
  16         461  
11 16     16   1689 use Mail::DKIM::Verifier;
  16         186049  
  16         43417  
12              
13             sub default_config {
14             return {
15 0     0 0 0 'hide_none' => 0,
16             };
17             }
18              
19             sub grafana_rows {
20 0     0 0 0 my ( $self ) = @_;
21 0         0 my @rows;
22 0         0 push @rows, $self->get_json( 'XGoogleDKIM_metrics' );
23 0         0 return \@rows;
24             }
25              
26             sub register_metrics {
27             return {
28 15     15 1 139 'xgoogledkim_total' => 'The number of emails processed for X-Google-DKIM',
29             };
30             }
31              
32             sub envfrom_callback {
33 64     64 0 288 my ( $self, $env_from ) = @_;
34 64         313 $self->{'failmode'} = 0;
35 64         234 $self->{'headers'} = [];
36 64         196 $self->{'has_dkim'} = 0;
37 64         240 $self->{'carry'} = q{};
38 64         328 $self->destroy_object('xgdkim');
39             }
40              
41             sub header_callback {
42 797     797 0 2334 my ( $self, $header, $value, $original ) = @_;
43 797 50       2456 return if ( $self->{'failmode'} );
44 797         1545 my $EOL = "\015\012";
45 797         2084 my $dkim_chunk = $original . $EOL;
46 797         7560 $dkim_chunk =~ s/\015?\012/$EOL/g;
47              
48 797 100       2868 if ( lc($header) eq 'dkim-signature' ) {
49 40         196 $dkim_chunk = 'X-Orig-' . $dkim_chunk;
50             }
51 797 50       2049 if ( lc($header) eq 'domainkey-signature' ) {
52 0         0 $dkim_chunk = 'X-Orig-' . $dkim_chunk;
53             }
54 797         1465 push @{$self->{'headers'}} , $dkim_chunk;
  797         2323  
55              
56             # Add Google signatures to the mix.
57             # Is this wise?
58 797 100       3022 if ( $header eq 'X-Google-DKIM-Signature' ) {
59 38         264 my $x_dkim_chunk = 'DKIM-Signature: ' . $value . $EOL;
60 38         614 $x_dkim_chunk =~ s/\015?\012/$EOL/g;
61 38         144 push @{$self->{'headers'}} , $x_dkim_chunk;
  38         174  
62 38         166 $self->{'has_dkim'} = 1;
63 38         286 my ($domain) = $value =~ /d=([^;]*);/;
64 38         303 my ($selector) = $value =~ /s=([^;]*);/;
65 38         294 my $resolver = $self->get_object('resolver');
66 38 50 33     456 if ( defined $selector && defined $domain ) {
67 38         187 my $lookup = $selector.'._domainkey.'.$domain;
68 38         96 eval{ $resolver->bgsend( $lookup, 'TXT' ) };
  38         229  
69 38         46192 $self->handle_exception( $@ );
70 38         326 $self->dbgout( 'DNSEarlyLookup', "$lookup TXT", LOG_DEBUG );
71             }
72             }
73             }
74              
75             sub eoh_callback {
76 64     64 0 288 my ($self) = @_;
77 64 50       385 return if ( $self->{'failmode'} );
78 64         347 my $config = $self->handler_config();
79              
80 64 100       407 if ( $self->{'has_dkim'} == 0 ) {
81 26         197 $self->metric_count( 'xgoogledkim_total', { 'result' => 'none' } );
82 26         277 $self->dbgout( 'XGoogleDKIMResult', 'No X-Google-DKIM headers', LOG_DEBUG );
83 26 100       214 if ( !( $config->{'hide_none'} ) ) {
84 18         121 my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-google-dkim' )->safe_set_value( 'none' );
85 18         1322 $header->add_child( Mail::AuthenticationResults::Header::Comment->new()->safe_set_value( 'no signatures found' ) );
86 18         6043 $self->add_auth_header( $header );
87             }
88 26         187 delete $self->{'headers'};
89             }
90             else {
91              
92 38         138 my $dkim;
93 38         114 eval {
94 38         229 $dkim = Mail::DKIM::Verifier->new();
95 38         1696 my $resolver = $self->get_object('resolver');
96 38         238 Mail::DKIM::DNS::resolver($resolver);
97 38         411 $self->set_object('xgdkim', $dkim, 1);
98             };
99 38 50       300 if ( my $error = $@ ) {
100 0         0 $self->handle_exception( $error );
101 0         0 $self->log_error( 'XGoogleDKIM Setup Error ' . $error );
102 0         0 $self->{'failmode'} = 1;
103 0         0 $self->_check_error( $error );
104 0         0 $self->metric_count( 'xgoogledkim_total', { 'result' => 'error' } );
105 0         0 delete $self->{'headers'};
106 0         0 return;
107             }
108              
109 38         119 eval {
110             $dkim->PRINT( join q{},
111 38         140 @{ $self->{'headers'} },
  38         845  
112             "\015\012",
113             );
114             };
115 38 50       106818 if ( my $error = $@ ) {
116 0         0 $self->handle_exception( $error );
117 0         0 $self->log_error( 'XGoogleDKIM Headers Error ' . $error );
118 0         0 $self->{'failmode'} = 1;
119 0         0 $self->_check_error( $error );
120 0         0 $self->metric_count( 'xgoogledkim_total', { 'result' => 'error' } );
121             }
122              
123 38         318 delete $self->{'headers'};
124             }
125              
126 64         342 $self->{'carry'} = q{};
127             }
128              
129             sub body_callback {
130 62     62 0 320 my ( $self, $body_chunk ) = @_;
131 62 50       314 return if ( $self->{'failmode'} );
132 62 100       361 return if ( $self->{'has_dkim'} == 0 );
133 38         118 my $EOL = "\015\012";
134              
135 38         89 my $dkim_chunk;
136 38 50       183 if ( $self->{'carry'} ne q{} ) {
137 0         0 $dkim_chunk = $self->{'carry'} . $body_chunk;
138 0         0 $self->{'carry'} = q{};
139             }
140             else {
141 38         128 $dkim_chunk = $body_chunk;
142             }
143              
144 38 50       208 if ( substr( $dkim_chunk, -1 ) eq "\015" ) {
145 0         0 $self->{'carry'} = "\015";
146 0         0 $dkim_chunk = substr( $dkim_chunk, 0, -1 );
147             }
148              
149 38         879 $dkim_chunk =~ s/\015?\012/$EOL/g;
150              
151 38         240 my $dkim = $self->get_object('xgdkim');
152 38         121 eval {
153 38         221 $dkim->PRINT( $dkim_chunk );
154             };
155 38 50       5609 if ( my $error = $@ ) {
156 0         0 $self->handle_exception( $error );
157 0         0 $self->log_error( 'XGoogleDKIM Body Error ' . $error );
158 0         0 $self->{'failmode'} = 1;
159 0         0 $self->_check_error( $error );
160 0         0 $self->metric_count( 'xgoogledkim_total', { 'result' => 'error' } );
161             }
162             }
163              
164             sub eom_callback {
165 64     64 0 281 my ($self) = @_;
166              
167 64 100       371 return if ( $self->{'has_dkim'} == 0 );
168 38 50       191 return if ( $self->{'failmode'} );
169              
170 38         162 my $config = $self->handler_config();
171              
172 38         231 my $dkim = $self->get_object('xgdkim');
173              
174 38         176 eval {
175 38         258 $dkim->PRINT( $self->{'carry'} );
176 38         827 $dkim->CLOSE();
177              
178 38         97242 my $dkim_result = $dkim->result;
179 38         402 my $dkim_result_detail = $dkim->result_detail;
180              
181 38         573 $self->metric_count( 'xgoogledkim_total', { 'result' => $dkim_result } );
182              
183 38         702 $self->dbgout( 'XGoogleDKIMResult', $dkim_result_detail, LOG_DEBUG );
184              
185 38 50       311 if ( !$dkim->signatures() ) {
186 0 0 0     0 if ( !( $config->{'hide_none'} && $dkim_result eq 'none' ) ) {
187 0         0 my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-google-dkim' )->safe_set_value( $dkim_result );
188 0         0 $header->add_child( Mail::AuthenticationResults::Header::Comment->new()->safe_set_value( 'no signatures found' ) );
189 0         0 $self->add_auth_header( $header );
190             }
191             }
192 38         573 foreach my $signature ( $dkim->signatures() ) {
193              
194 38         591 my $otype = ref $signature;
195 38 50       277 my $type =
    50          
196             $otype eq 'Mail::DKIM::DkSignature' ? 'domainkeys'
197             : $otype eq 'Mail::DKIM::Signature' ? 'dkim'
198             : 'dkim';
199 38         204 $self->dbgout( 'XGoogleDKIMSignatureType', $type, LOG_DEBUG );
200              
201 38         313 $self->dbgout( 'XGoogleDKIMSignatureIdentity', $signature->identity, LOG_DEBUG );
202 38         291 $self->dbgout( 'XGoogleDKIMSignatureResult', $signature->result_detail, LOG_DEBUG );
203 38         265 my $signature_result = $signature->result();
204 38         396 my $signature_result_detail = $signature->result_detail();
205              
206 38 50       491 if ( $signature_result eq 'invalid' ) {
207 0 0       0 if ( $signature_result_detail =~ /DNS query timeout for (.*) at / ) {
208 0         0 my $timeout_domain = $1;
209 0         0 $self->log_error( "TIMEOUT DETECTED: in XGoogleDKIM result: $timeout_domain" );
210 0         0 $signature_result_detail = "DNS query timeout for $timeout_domain";
211             }
212             }
213              
214 38         115 my $result_comment = q{};
215 38 100 66     266 if ( $signature_result ne 'pass' and $signature_result ne 'none' ) {
216 8         180 $signature_result_detail =~ /$signature_result \((.*)\)/;
217 8 50       50 if ( $1 ) {
218 8         38 $result_comment = $1 . ', ';
219             }
220             }
221 38 50 66     275 if (
222             !(
223             $config->{'hide_none'} && $signature_result eq 'none'
224             )
225             )
226             {
227              
228 38         226 my $key_data = q{};
229 38         98 eval {
230 38         158 my $key = $signature->get_public_key();
231 38         571 $key_data = $key->size() . '-bit ' . $key->type() . ' key';
232             };
233              
234 38         1044 my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-google-dkim' )->safe_set_value( $signature_result );
235 38         2777 $header->add_child( Mail::AuthenticationResults::Header::Comment->new()->safe_set_value( $result_comment . $key_data ) );
236 38         13402 $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'header.d' )->safe_set_value( $signature->domain() ) );
237 38         4394 $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'header.i' )->safe_set_value( $signature->identity() ) );
238 38         4747 $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'header.b' )->safe_set_value( substr( $signature->data(), 0, 8 ) ) );
239 38         4742 $self->add_auth_header($header);
240             }
241             }
242              
243             };
244 38 50       298 if ( my $error = $@ ) {
245 0         0 $self->handle_exception( $error );
246             # Also in DMARC module
247 0         0 $self->log_error( 'XGoogleDKIM EOM Error ' . $error );
248 0         0 $self->{'failmode'} = 1;
249 0         0 $self->_check_error( $error );
250 0         0 $self->metric_count( 'xgoogledkim_total', { 'result' => 'error' } );
251 0         0 return;
252             }
253             }
254              
255             sub close_callback {
256 102     102 0 371 my ( $self ) = @_;
257 102         341 delete $self->{'failmode'};
258 102         283 delete $self->{'headers'};
259 102         250 delete $self->{'body'};
260 102         267 delete $self->{'carry'};
261 102         243 delete $self->{'has_dkim'};
262 102         427 $self->destroy_object('xgdkim');
263             }
264              
265             sub _check_error {
266 0     0     my ( $self, $error ) = @_;
267 0 0 0       if ( $error =~ /^DNS error: query timed out/
    0 0        
      0        
      0        
268             or $error =~ /^DNS query timeout/
269             ){
270 0           $self->log_error( 'Temp XGoogleDKIM Error - ' . $error );
271 0           my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-google-dkim' )->safe_set_value( 'temperror' );
272 0           $header->add_child( Mail::AuthenticationResults::Header::Comment->new()->safe_set_value( 'dns timeout' ) );
273 0           $self->add_auth_header( $header );
274             }
275             elsif ( $error =~ /^no domain to fetch policy for$/
276             or $error =~ /^policy syntax error$/
277             or $error =~ /^empty domain label/
278             or $error =~ /^invalid name /
279             ){
280 0           $self->log_error( 'Perm XGoogleDKIM Error - ' . $error );
281 0           my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-google-dkim' )->safe_set_value( 'perlerror' );
282 0           $header->add_child( Mail::AuthenticationResults::Header::Comment->new()->safe_set_value( 'syntax or domain error' ) );
283 0           $self->add_auth_header( $header );
284             }
285             else {
286 0           $self->exit_on_close( 'Unexpected XGoogleDKIM Error - ' . $error );
287 0           my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-google-dkim' )->safe_set_value( 'temperror' );
288 0           $self->add_auth_header( $header );
289             # Fill these in as they occur, but for unknowns err on the side of caution
290             # and tempfail/exit
291 0           $self->tempfail_on_error();
292             }
293             }
294              
295             1;
296              
297             __END__
298              
299             =pod
300              
301             =encoding UTF-8
302              
303             =head1 NAME
304              
305             Mail::Milter::Authentication::Handler::XGoogleDKIM - Handler class for Google specific DKIM
306              
307             =head1 VERSION
308              
309             version 3.20230911
310              
311             =head1 DESCRIPTION
312              
313             Module for validation of X-Google-DKIM signatures.
314              
315             =head1 CONFIGURATION
316              
317             "XGoogleDKIM" : { | Config for the X-Google-DKIM Module
318             "hide_none" : 0, | Hide auth line if the result is 'none'
319             },
320              
321             =head1 AUTHOR
322              
323             Marc Bradshaw <marc@marcbradshaw.net>
324              
325             =head1 COPYRIGHT AND LICENSE
326              
327             This software is copyright (c) 2020 by Marc Bradshaw.
328              
329             This is free software; you can redistribute it and/or modify it under
330             the same terms as the Perl 5 programming language system itself.
331              
332             =cut