File Coverage

blib/lib/Mail/Milter/Authentication/Handler/TLS.pm

Criterion	Covered	Total	%
statement	70	97	72.1
branch	14	30	46.6
condition			n/a
subroutine	14	16	87.5
pod	1	9	11.1
total	99	152	65.1

package Mail::Milter::Authentication::Handler::TLS;
use strict;
use warnings;
use base 'Mail::Milter::Authentication::Handler';
our $VERSION = '20191206'; # VERSION

use Sys::Syslog qw{:standard :macros};
use Mail::AuthenticationResults::Header::Entry;
use Mail::AuthenticationResults::Header::SubEntry;
use Mail::AuthenticationResults::Header::Comment;

sub default_config {
    return {};
}

sub grafana_rows {
    my ( $self ) = @_;
    my @rows;
    push @rows, $self->get_json( 'TLS_metrics' );
    return \@rows;
}

sub register_metrics {
    return {
        'tls_connect_total' => 'The number of connections which were enctypted',
    };
}

sub pre_loop_setup {
    my ( $self ) = @_;
    my $protocol = Mail::Milter::Authentication::Config::get_config()->{'protocol'};
    if ( $protocol eq 'smtp' ) {
        warn 'When in smtp mode, the TLS handler requires the MTA to write TLS data into the first Received header.';
    }
    return;
}

sub connect_callback {
    my ( $self ) = @_;
    # Reset state on a connection
    delete $self->{'is_encrypted'};
    return;
}

sub envfrom_callback {
    my ( $self, $env_from ) = @_;

    delete $self->{'first_header_read'};

    my $protocol = Mail::Milter::Authentication::Config::get_config()->{'protocol'};
    return if $protocol ne 'milter';

    my $version = $self->get_symbol('{tls_version}');
    my $cipher  = $self->get_symbol('{cipher}');
    my $bits    = $self->get_symbol('{cipher_bits}');
    # on postfix the macro is empty on untrusted connections
    my $trusted = $self->get_symbol('{cert_issuer}') ? ', trusted' : '';

    if ($version) {
        $self->dbgout( 'EncryptedAs', "$version, $cipher, $bits bits$trusted", LOG_INFO );
        $self->{'is_encrypted'} = 1;

        my $metric_data = {};
        my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-tls' )->safe_set_value( 'pass' );
        $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'smtp.version' )->safe_set_value( $version ) );
        $metric_data->{ 'version' } = $version;

        if ( $cipher ) {
            $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'smtp.cipher' )->safe_set_value( $cipher ) );
            $metric_data->{ 'cipher' } = $cipher;
        }
        if ( $bits ) {
            $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'smtp.bits' )->safe_set_value( $bits ) );
            $metric_data->{ 'bits' } = $bits;
        }
        $metric_data->{ 'trusted' } = $trusted ? 1 : 0;

        $self->metric_count( 'tls_connect_total', $metric_data );

        $self->add_auth_header( $header );
    }
    else {
        $self->{'is_encrypted'} = 0;
    }
    return;
}

sub header_callback {
    my ( $self, $header, $value ) = @_;

    return if lc $header ne 'received';
    return if ( exists( $self->{'first_header_read'} ) );
    $self->{'first_header_read'} = 1;


    my $protocol = Mail::Milter::Authentication::Config::get_config()->{'protocol'};
    return if $protocol ne 'smtp';

    # Try and parse the first received header, this should be something like...
    # Received: from mail-ua0-f173.google.com (mail-ua0-f173.google.com [209.85.217.173])
    #           (using TLSv1.2 with cipher ECDHE-RSA-AES128-GCM-SHA256 (128/128 bits))
    #           (No client certificate requested)
    #           by mx5.messagingengine.com (Postfix) with ESMTPS
    #           for <[e-mail]>; Thu,  1 Dec 2016 22:35:06 -0500 (EST)

    # Future, extend to check for client certificates

    $value =~ m/using ([^ ]*) with cipher ([^ ]+) \(([^ ]+) bits\)/;
    my $version = $1;
    my $cipher  = $2;
    my $bits    = $3;

    if ($version) {
        $self->dbgout( 'EncryptedAs', "$version, $cipher, $bits bits", LOG_INFO );
        $self->{'is_encrypted'} = 1;

        my $metric_data = {};
        my $header = Mail::AuthenticationResults::Header::Entry->new()->set_key( 'x-tls' )->safe_set_value( 'pass' );
        $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'smtp.version' )->safe_set_value( $version ) );
        $metric_data->{ 'version' } = $version;

        if ( $cipher ) {
            $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'smtp.cipher' )->safe_set_value( $cipher ) );
            $metric_data->{ 'cipher' } = $cipher;
        }
        if ( $bits ) {
            $header->add_child( Mail::AuthenticationResults::Header::SubEntry->new()->set_key( 'smtp.bits' )->safe_set_value( $bits ) );
            $metric_data->{ 'bits' } = $bits;
        }

        $self->metric_count( 'tls_connect_total', $metric_data );

        $self->add_auth_header( $header );
    }

    return;
}

sub eoh_callback {
    my ( $self ) = @_;
    my $protocol = Mail::Milter::Authentication::Config::get_config()->{'protocol'};
    return if $protocol ne 'smtp';
    return if defined $self->{'is_encrypted'};
    $self->{'is_encrypted'} = 0;
    return;
}

sub close_callback {
    my ( $self ) = @_;
    delete $self->{'first_header_read'};
    delete $self->{'is_encrypted'};
    return;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Mail::Milter::Authentication::Handler::TLS

=head1 VERSION

version 20191206

=head1 DESCRIPTION

Identify TLS protected connections.

=head1 CONFIGURATION

No configuration options exist for this handler.

=head1 AUTHOR

Marc Bradshaw <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2018 by Marc Bradshaw.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut