File Coverage

blib/lib/HealthCheck/Diagnostic/SMTP.pm

Criterion	Covered	Total	%
statement	36	41	87.8
branch	5	10	50.0
condition	1	7	14.2
subroutine	10	10	100.0
pod	3	3	100.0
total	55	71	77.4

package HealthCheck::Diagnostic::SMTP;

use strict;
use warnings;

use parent 'HealthCheck::Diagnostic';

use Net::SMTP;

# https://metacpan.org/pod/distribution/perl/pod/perl5140delta.pod#Exception-Handling
use constant UNSTABLE_DOLLARAT => $] lt '5.013002';

# ABSTRACT: Verify connectivity to an SMTP mail server
use version;
our $VERSION = 'v0.0.4'; # VERSION

sub new {
    my ($class, @params) = @_;

    my %params = @params == 1 && ( ref $params[0] || '' ) eq 'HASH'
        ? %{ $params[0] } : @params;

    return $class->SUPER::new(
        id     => 'smtp',
        label  => 'SMTP',
        %params,
    );
}

sub check {
    my ($self, %params) = @_;

    # Make it so that the diagnostic can be used as an instance or a
    # class, and the `check` params get preference.
    if ( ref $self ) {
        $params{ $_ } = $self->{ $_ }
            foreach grep { ! defined $params{ $_ } } keys %$self;
    }

    return $self->SUPER::check( %params );
}

sub run {
    my ($self, %params) = @_;

    local $@ unless UNSTABLE_DOLLARAT;
    my $smtp = $self->smtp_connect( %params );

    unless ( $smtp ) {
        return {
            status => 'CRITICAL',
            info   => "$@",
        };
    }

    my $banner = $smtp->banner;
    $smtp->quit;

    return {
        status => 'OK',
        info   => $banner,
    };
}

sub smtp_connect {
    my ( $self, %params ) = @_;

    my $host    = $params{ host } or die "host is required\n";
    my $port    = $params{ port }    // 25;
    my $timeout = $params{ timeout } // 5;

    $host = $host->( %params ) if ref $host eq 'CODE';

    return Net::SMTP->new( $host, Timeout => $timeout, Port => $port );
}

1;

__END__