File Coverage

blib/lib/HealthCheck/Diagnostic/SFTP.pm

Criterion	Covered	Total	%
statement	59	60	98.3
branch	19	20	95.0
condition	6	9	66.6
subroutine	10	10	100.0
pod	3	3	100.0
total	97	102	95.1

package HealthCheck::Diagnostic::SFTP;
use parent 'HealthCheck::Diagnostic';

# ABSTRACT: Check for SFTP access and operations in a HealthCheck
use version;
our $VERSION = 'v1.5.0'; # VERSION

use strict;
use warnings;

use Carp;
use Net::SFTP;

# For some reason, without this in the cpanfile
# Net::SFTP wouldn't install, so leave this note.
require Net::SSH::Perl::Buffer;

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

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

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

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

    # Allow the diagnostic to be called as a class as well.
    if ( ref $self ) {
        $params{$_} = $self->{$_}
            foreach grep { ! defined $params{$_} } keys %$self;
    }

    # The host is the only required parameter.
    croak "No host" unless $params{host};

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

sub run {
    my ($self, %params) = @_;
    my $host     = $params{host};
    my $callback = $params{callback};
    my $ssh_args = $params{ssh_args} // {};

    # Get our description of the connection.
    my $port        = $ssh_args->{port};
    my $user        = $params{user};
    my $name        = $params{name};
    my $timeout     = $params{timeout} // 10;
    my $target      = sprintf(
        "%s%s%s",
        $user ? $user . '@' : '',
        $host,
        $port ? ":$port" : '',
    );

    my $description = $name ? "$name ($target) SFTP" : "$target SFTP";
    my $options = $ssh_args->{options} // [];

    # Once the SSH ConnectTimeout option is supported, we can re-enable this:
    # https://rt.cpan.org/Public/Bug/Display.html?id=66433
    #
    # unless ( grep { $_ =~ /^ConnectTimeout / } @$options ) {
    #     push @$options, "ConnectTimeout $timeout";
    #     $ssh_args->{options} = $options;
    # }

    # Try to connect to the host.
    my $sftp;
    my %args = map { $_ => $params{$_} }
        grep { exists $params{$_} }
        qw( user password debug warn );
    $args{ssh_args} = $ssh_args;

    local $@;
    local $SIG{ALRM} = sub { die "timeout after $timeout seconds.\n" };
    alarm $timeout;
    eval {
        local $SIG{__DIE__};
        $sftp = Net::SFTP->new( $host, %args );
    };
    alarm 0;
    return {
        status => 'CRITICAL',
        info   => "Error for $description: $@",
    } if $@;

    # No errors were returned so it must be a successful result,
    # unless we want to run a callback.
    return {
        status => 'OK',
        info   => "Successful connection for $description",
    } unless $callback;

    # Try to run a callback on the instance if one is provided.
    my $result;
    eval {
        local $SIG{__DIE__};
        $result = $callback->( $sftp );
    };
    return {
        status => 'CRITICAL',
        info   => "Error in running callback for $description: $@",
    } if $@;

    # Return the callback result hash, or a generic success message.
    return ref $result eq 'HASH' ? $result : {
        status => 'OK',
        info   => "Successful connection and callback for $description",
    };
}

1;

__END__