view release on metacpan or  search on metacpan

lib/App/Yabsm/Command/Find.pm  view on Meta::CPAN

#  Author:  Nicholas Hubbard
#  WWW:     https://github.com/NicholasBHubbard/yabsm
#  License: MIT

#  Provides functionality for finding snapshots via a snapshot finding DSL.
#
#  See t/Yabsm/Snapshot.pm for this libraries tests.

use strict;
use warnings;
use v5.16.3;

package App::Yabsm::Command::Find;

use App::Yabsm::Tools qw( :ALL );
use App::Yabsm::Config::Query qw ( :ALL );
use App::Yabsm::Config::Parser qw(parse_config_or_die);
use App::Yabsm::Backup::SSH;
use App::Yabsm::Snapshot qw(nums_to_snapshot_name
                            snapshot_name_nums
                            current_time_snapshot_name
                            sort_snapshots
                            is_snapshot_name
                            snapshots_eq
                            snapshot_newer
                            snapshot_older
                            snapshot_newer_or_eq
                            snapshot_older_or_eq
                           );

use Feature::Compat::Try;
use Net::OpenSSH;
use Time::Piece;
use File::Basename qw(basename);
use Carp qw(confess);
use POSIX ();

use Parser::MGC;
use base qw(Parser::MGC);

sub usage {
    arg_count_or_die(0, 0, @_);
    return 'usage: yabsm <find|f> [--help] [<SNAP|SSH_BACKUP|LOCAL_BACKUP> <QUERY>]'."\n";
}

sub help {
    @_ == 0 or die usage();
    my $usage = usage();
    $usage =~ s/\s+$//;
    print <<"END_HELP";
$usage

see the section "Finding Snapshots" in 'man yabsm' for a detailed explanation on
how to find snapshots and backups.

examples:
    yabsm find home_snap back-10-hours
    yabsm f root_ssh_backup newest
    yabsm f home_local_backup oldest
    yabsm f home_snap 'between b-10-mins 15:45'
    yabsm f root_snap 'after back-2-days'
    yabsm f root_local_backup 'before b-14-d'
END_HELP
}

                 ####################################
                 #               MAIN               #
                 ####################################

sub main {

    if (@_ == 1) {
        shift =~ /^(-h|--help)$/ or die usage();
        help();
    }

    elsif (@_ == 2) {

        my $thing = shift;
        my $query = shift;

        my $config_ref = parse_config_or_die();

        unless (snap_exists($thing, $config_ref) || ssh_backup_exists($thing, $config_ref) || local_backup_exists($thing, $config_ref)) {
            die "yabsm: error: no such snap, ssh_backup, or local_backup named '$thing'\n";
        }

        my @snapshots = answer_query($thing, parse_query_or_die($query), $config_ref);

        say for @snapshots;
    }

    else {
        die usage()
    }
}

                 ####################################
                 #           QUERY ANSWERING        #
                 ####################################

sub answer_query {

    # Return a subset of all the snapshots/backups of $thing that satisfy
    # $query.

    arg_count_or_die(3, 3, @_);

    my $thing      = shift;
    my %query      = %{+shift};
    my $config_ref = shift;

    my @snapshots;

    if (snap_exists($thing, $config_ref)) {
        for my $tframe (snap_timeframes($thing, $config_ref)) {
            my $dir = snap_dest($thing, $tframe, $config_ref);
            unless (-r $dir) {
                die "yabsm: error: do not have read permission on '$dir'\n";
            }
            opendir my $dh, $dir or confess "yabsm: internal error: could not opendir '$dir'";
            push @snapshots, map { $_ = "$dir/$_" } grep { is_snapshot_name($_) } readdir($dh);
            closedir $dh;
        }
    }

    elsif (ssh_backup_exists($thing, $config_ref)) {

        die 'yabsm: error: permission denied'."\n" unless i_am_root();

        my $yabsm_uid = getpwnam('yabsm') or die q(yabsm: error: no user named 'yabsm')."\n";

        POSIX::setuid($yabsm_uid);

        my $ssh = App::Yabsm::Backup::SSH::new_ssh_conn($thing, $config_ref);

        my $ssh_dest = ssh_backup_ssh_dest($thing, $config_ref);

        if ($ssh->error) {
            die "yabsm: ssh error: $ssh_dest: ".$ssh->error."\n";
        }
        for my $tframe (ssh_backup_timeframes($thing, $config_ref)) {
            my $dir  = ssh_backup_dir($thing, $tframe, $config_ref);
            unless ($ssh->system("[ -r '$dir' ]")) {
                die "yabsm: ssh error: $ssh_dest: remote user does not have read permission on '$dir'\n";
            }
            push @snapshots, grep { chomp $_; is_snapshot_name($_) } App::Yabsm::Backup::SSH::ssh_system_or_die($ssh, "ls -1 '$dir'");
            map { $_ = "$dir/$_" } @snapshots;
        }
    }

    elsif (local_backup_exists($thing, $config_ref)) {
        for my $tframe (local_backup_timeframes($thing, $config_ref)) {
            my $dir = local_backup_dir($thing, $tframe, $config_ref);
            unless (-r $dir) {
                die "yabsm: error: do not have read permission on '$dir'\n";
            }
            opendir my $dh, $dir or confess "yabsm: internal error: could not opendir '$dir'";
            push @snapshots, map { $_ = "$dir/$_" } grep { is_snapshot_name($_) } readdir($dh);
            closedir $dh;
        }
    }

    else {
        die "yabsm: internal error: no such snap, ssh_backup, or local_backup named '$thing'";
    }

    @snapshots = sort_snapshots(\@snapshots);

    if ($query{type} eq 'all') {
        ;
    }

    elsif ($query{type} eq 'newest') {
        @snapshots = answer_newest_query(\@snapshots);
    }

    elsif ($query{type} eq 'oldest') {
        @snapshots = answer_oldest_query(\@snapshots);
    }

    elsif ($query{type} eq 'after') {
        @snapshots = answer_after_query($query{target}, \@snapshots);
    }

    elsif ($query{type} eq 'before') {
        @snapshots = answer_before_query($query{target}, \@snapshots);
    }

    elsif ($query{type} eq 'between') {
        @snapshots = answer_between_query($query{target1}, $query{target2}, \@snapshots);
    }

    elsif ($query{type} eq 'closest') {
        @snapshots = answer_closest_query($query{target}, \@snapshots);
    }

    else {
        confess("yabsm: internal error: no such query type $query{type}");
    }

    return wantarray ? @snapshots : \@snapshots;
}

sub answer_newest_query {

    # Return the newest snapshot in @snapshots. Because @snapshots is assumed to
    # be sorted from newest to oldest we know the newest snapshot is the first
    # snapshot in @snapshots.

    arg_count_or_die(1, 1, @_);

    my @newest;

    push @newest, shift->[0];

    return wantarray ? @newest : \@newest;
}

sub answer_oldest_query {

    # Return the oldest snapshot in @snapshots. Because @snapshots is assumed to
    # be sorted from newest to oldest we know the oldest snapshot is the last
    # snapshot in @snapshots.