File Coverage

blib/lib/Mail/Milter/Authentication/Handler/Auth.pm
Criterion Covered Total %
statement 42 44 95.4
branch 4 4 100.0
condition n/a
subroutine 13 13 100.0
pod 1 8 12.5
total 60 69 86.9


line stmt bran cond sub pod time code
1             package Mail::Milter::Authentication::Handler::Auth;
2 31     31   16317 use 5.20.0;
  31         149  
3 31     31   227 use strict;
  31         79  
  31         752  
4 31     31   222 use warnings;
  31         120  
  31         981  
5 31     31   257 use Mail::Milter::Authentication::Pragmas;
  31         101  
  31         273  
6             # ABSTRACT: Handler class for SMTP Auth
7             our $VERSION = '3.20230911'; # VERSION
8 31     31   7546 use base 'Mail::Milter::Authentication::Handler';
  31         128  
  31         21295  
9              
10             sub default_config {
11 1     1 0 2265 return {};
12             }
13              
14             sub grafana_rows {
15 1     1 0 4861 my ( $self ) = @_;
16 1         2 my @rows;
17 1         9 push @rows, $self->get_json( 'Auth_metrics' );
18 1         5 return \@rows;
19             }
20              
21             sub register_metrics {
22             return {
23 30     30 1 292 'authenticated_connect_total' => 'The number of connections from an authenticated host',
24             };
25             }
26              
27             sub pre_loop_setup {
28 30     30 0 123 my ( $self ) = @_;
29 30         137 my $protocol = Mail::Milter::Authentication::Config::get_config()->{'protocol'};
30 30 100       138 if ( $protocol ne 'milter' ) {
31 16         311 warn 'The Auth handler only works with the milter protocol';
32             }
33             }
34              
35             sub get_auth_name {
36 74     74 0 245 my ($self) = @_;
37 74         475 my $name = $self->get_symbol('{auth_authen}');
38 74         409 return $name;
39             }
40              
41             sub connect_callback {
42 74     74 0 326 my ( $self, $hostname, $ip ) = @_;
43 74         544 $self->{'is_authenticated'} = 0;
44             }
45              
46             sub envfrom_callback {
47 74     74 0 320 my ( $self, $env_from ) = @_;
48 74         439 my $auth_name = $self->get_auth_name();
49 74 100       369 if ($auth_name) {
50 1         8 $self->dbgout( 'AuthenticatedAs', $auth_name, LOG_INFO );
51             # Clear the current auth headers ( iprev and helo may already be added )
52             # ToDo is this a good idea?
53 1         7 my $top_handler = $self->get_top_handler();
54 1         4 for my $type ( sort keys $top_handler->{'c_auth_headers'}->%* ) {
55 0         0 $top_handler->{'c_auth_headers'}->{$type} = [];
56             }
57 1         4 for my $type ( sort keys $top_handler->{'auth_headers'}->%* ) {
58 0         0 $top_handler->{'auth_headers'}->{$type} = [];
59             }
60 1         5 $self->{'is_authenticated'} = 1;
61 1         7 $self->metric_count( 'authenticated_connect_total' );
62 1         12 my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'auth' )->safe_set_value( 'pass' );
63 1         128 $self->add_auth_header( $header );
64             }
65             }
66              
67             sub close_callback {
68 104     104 0 368 my ( $self ) = @_;
69 104         417 delete $self->{'is_authenticated'};
70             }
71              
72             1;
73              
74             __END__
75              
76             =pod
77              
78             =encoding UTF-8
79              
80             =head1 NAME
81              
82             Mail::Milter::Authentication::Handler::Auth - Handler class for SMTP Auth
83              
84             =head1 VERSION
85              
86             version 3.20230911
87              
88             =head1 DESCRIPTION
89              
90             Module which identifies email that was sent via an authenticated connection.
91              
92             =head1 CONFIGURATION
93              
94             No configuration options exist for this handler.
95              
96             =head1 AUTHOR
97              
98             Marc Bradshaw <marc@marcbradshaw.net>
99              
100             =head1 COPYRIGHT AND LICENSE
101              
102             This software is copyright (c) 2020 by Marc Bradshaw.
103              
104             This is free software; you can redistribute it and/or modify it under
105             the same terms as the Perl 5 programming language system itself.
106              
107             =cut