File Coverage

blib/lib/Sys/Bprsync/Cmd/Command/configcheck.pm

Criterion	Covered	Total	%
statement	11	13	84.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	16	18	88.8

package Sys::Bprsync::Cmd::Command::configcheck;
{
  $Sys::Bprsync::Cmd::Command::configcheck::VERSION = '0.25';
}
BEGIN {
  $Sys::Bprsync::Cmd::Command::configcheck::AUTHORITY = 'cpan:TEX';
}
# ABSTRACT: verify the bprsync configuration

use 5.010_000;
use mro 'c3';
use feature ':5.10';

use Moose;
use namespace::autoclean;

# use IO::Handle;
# use autodie;
# use MooseX::Params::Validate;
# use Carp;
# use English qw( -no_match_vars );
# use Try::Tiny;
use Sys::Bprsync;

# extends ...
extends 'Sys::Bprsync::Cmd::Command';
# has ...
has '_bp' => (
    'is'    => 'ro',
    'isa'   => 'Sys::Bprsync',
    'lazy'  => 1,
    'builder' => '_init_bp',
    'reader' => 'bp',
);

has 'verbose' => (
    'is'            => 'ro',
    'isa'           => 'Bool',
    'required'      => 0,
    'traits'        => [qw(Getopt)],
    'cmd_aliases'   => 'v',
    'documentation' => 'Be more verbose',
);
# with ...
# initializers ...
sub _init_bp {
    my $self = shift;

    my $BP = Sys::Bprsync::->new({
        'config'        => $self->config(),
        'logger'        => $self->logger(),
        'logfile'       => $self->config()->get( 'Sys::Bprsync::Logfile', { Default => '/tmp/bprsync.log', } ),
        'concurrency'   => 1,
    });

    return $BP;
}

# your code here ...
sub execute {
    my $self = shift;

    my $status = 1;
    # do we have at least one job?
    my $jobs = $self->bp()->vaults();
    if($jobs && ref($jobs) eq 'ARRAY') {
        # check each vault if it is accessible
        foreach my $job_name (sort @{$jobs}) {
            my $job = $self->bp()->config()->get($self->bp()->config_prefix().'::Jobs::'.$job_name);
            say 'Job: '.$job_name;
            if($self->verbose()) {
                say "\t".$job->{'source'}.' => '.$job->{'destination'};
                say "\tBwlimit: ".$job->{'bwlimit'} if $job->{'bwlimit'};
                say "\tCompression: ".$job->{'compression'} if $job->{'compression'};
                say "\tDelete: ".$job->{'delete'} if $job->{'delete'};
                say "\tDescription: ".$job->{'description'} if $job->{'description'};
                say "\tExclude: ".$job->{'exclude'} if $job->{'exclude'};
                say "\tExcludefrom: ".$job->{'excludefrom'} if $job->{'excludefrom'};
                say "\tHardlink: ".$job->{'hardlink'} if $job->{'hardlink'};
                say "\tWill cross FS boundaries: ".($job->{'nocrossfs'} ? 'No' : 'Yes');
                say "\tNumeric-IDs: ".$job->{'numericids'} if $job->{'numericids'};
                say "\tRemote-Shell: ".$job->{'rsh'} if $job->{'rsh'};
                say "\tRemote-Shell Options: ".$job->{'rshopts'} if $job->{'rshopts'};
                say "\tTimeframe: ".$job->{'timeframe'} if $job->{'timeframe'};
            }

            # check access ...
            ## for local dirs: check existence and rw
            ## for remotes: check ssh access
            # source
            if($job->{'source'} =~ m/:/) {
                # remote
                if(!$self->_check_remote($job->{'source'},$job->{'rshopts'})) {
                    $status = 0;
                }
            } else {
                # local
                if(!$self->_check_local($job->{'source'})) {
                    $status = 0;
                }
            }
            # destination
            if($job->{'destination'} =~ m/:/) {
                # remote
                if(!$self->_check_remote($job->{'destination'},$job->{'rshopts'})) {
                    $status = 0;
                }
            } else {
                # local
                if(!$self->_check_local($job->{'destination'})) {
                    $status = 0;
                }
            }
        }
    } else {
        my @files_read = @{$self->bp()->config()->files_read()};
        if(@files_read) {
            say 'ERROR - No jobs defined in: '.join(q{:},@files_read);
        } else {
            say 'ERROR - No config files found in '.join(q{:},@{$self->bp()->config()->locations()});
        }
        $status = 0;
    }

    return $status;
}

sub _check_remote {
    my $self = shift;
    my $location = shift;
    my $rshopts = shift || '';

    my ($host, $path) = split /:/, $location, 2;
    if($self->bp()->sys()->check_ssh_login($host, { SSHOpts => $rshopts, })) {
        say ' OK - SSH access to '.$host.' works';
        if($self->bp()->sys()->run_remote_cmd($host,'ls '.$path,, { SSHOpts => $rshopts, })) {
            say ' OK - Remote location '.$path.' is a directory';
            return 1;
        } else {
            say ' ERROR - Remote location '.$path.' not found on host '.$host;
            return;
        }
    } else {
        say ' ERROR - SSH access to '.$host.' failed!';
        return;
    }
}

sub _check_local {
    my $self = shift;
    my $location = shift;

    if(-d $location) {
        say ' OK - Location '.$location.' is a directory';
        if(-w $location) {
            say ' OK - Location '.$location.' is writeable';
            return 1;
        }
    } else {
        say ' ERROR - Location '.$location.' is no directory';
        return;
    }
}

sub abstract {
    return 'Check integrity of the configuration';
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Sys::Bprsync::Cmd::Command::configcheck - verify the bprsync configuration

=head1 METHODS

=head2 abstract

Workaround.

=head2 execute

Extensive configuration test.

=head1 NAME

Sys::Bprsync::Cmd::Command::configcheck - verify the bprsync configuration

=head1 AUTHOR

Dominik Schulz <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Dominik Schulz.

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