File Coverage

blib/lib/Mail/Milter/Authentication/Handler/PTR.pm
Criterion Covered Total %
statement 33 40 82.5
branch 12 14 85.7
condition n/a
subroutine 7 9 77.7
pod 1 4 25.0
total 53 67 79.1


line stmt bran cond sub pod time code
1             package Mail::Milter::Authentication::Handler::PTR;
2 29     29   18687 use 5.20.0;
  29         197  
3 29     29   175 use strict;
  29         107  
  29         864  
4 29     29   381 use warnings;
  29         73  
  29         831  
5 29     29   210 use Mail::Milter::Authentication::Pragmas;
  29         156  
  29         498  
6             # ABSTRACT: Handler class for PTR checking
7             our $VERSION = '3.20230629'; # VERSION
8 29     29   7530 use base 'Mail::Milter::Authentication::Handler';
  29         124  
  29         17392  
9              
10             sub default_config {
11 0     0 0 0 return {};
12             }
13              
14             sub grafana_rows {
15 0     0 0 0 my ( $self ) = @_;
16 0         0 my @rows;
17 0         0 push @rows, $self->get_json( 'PTR_metrics' );
18 0         0 return \@rows;
19             }
20              
21             sub register_metrics {
22             return {
23 28     28 1 357 'ptr_total' => 'The number of emails processed for PTR',
24             };
25             }
26              
27             sub helo_callback {
28              
29             # On HELO
30 68     68 0 303 my ( $self, $helo_host ) = @_;
31 68 100       447 return if ( $self->is_local_ip_address() );
32 60 100       435 return if ( $self->is_trusted_ip_address() );
33 58 50       502 return if ( $self->is_authenticated() );
34              
35 58 50       346 if ( ! $self->is_handler_loaded( 'IPRev' ) ) {
36 0         0 $self->log_error( 'PTR Config Error: IPRev is missing ');
37 0         0 return;
38             }
39              
40 58         324 my $iprev_handler = $self->get_handler('IPRev');
41             my $domains =
42             exists( $iprev_handler->{'verified_ptr'} )
43 58 100       436 ? $iprev_handler->{'verified_ptr'}
44             : q{};
45              
46 58         244 my $found_match = 0;
47              
48 58         415 foreach my $domain ( split ',', $domains ) {
49 22 100       157 if ( lc $domain eq lc $helo_host ) {
50 20         88 $found_match = 1;
51             }
52             }
53              
54 58 100       343 my $result = $found_match ? 'pass' : 'fail';
55 58         423 $self->dbgout( 'PTRMatch', $result, LOG_DEBUG );
56 58         444 my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-ptr' )->safe_set_value( $result );
57 58         4329 $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'smtp.helo' )->safe_set_value( $helo_host ) );
58 58         6137 $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'policy.ptr' )->safe_set_value( $domains ) );
59 58         5663 $self->add_c_auth_header( $header );
60 58         629 $self->metric_count( 'ptr_total', { 'result' => $result} );
61             }
62              
63             1;
64              
65             __END__
66              
67             =pod
68              
69             =encoding UTF-8
70              
71             =head1 NAME
72              
73             Mail::Milter::Authentication::Handler::PTR - Handler class for PTR checking
74              
75             =head1 VERSION
76              
77             version 3.20230629
78              
79             =head1 DESCRIPTION
80              
81             Check DNS PTR Records match.
82              
83             This handler requires the IPRev handler to be installed and active.
84              
85             =head1 CONFIGURATION
86              
87             No configuration options exist for this handler.
88              
89             =head1 AUTHOR
90              
91             Marc Bradshaw <marc@marcbradshaw.net>
92              
93             =head1 COPYRIGHT AND LICENSE
94              
95             This software is copyright (c) 2020 by Marc Bradshaw.
96              
97             This is free software; you can redistribute it and/or modify it under
98             the same terms as the Perl 5 programming language system itself.
99              
100             =cut