view release on metacpan or  search on metacpan

lib/App/Yabsm/Tools.pm  view on Meta::CPAN

    my $lower    = shift;
    my $upper    = shift;
    my $num_args = scalar @_;

    $lower = 0 if $lower eq '_';

    my $lower_ok = $lower <= $num_args;
    my $upper_ok = $upper eq '_' ? 1 : $upper >= $num_args;

    unless ($lower_ok && $upper_ok) {
        my $caller    = ( caller(1) )[3];
        my $error_msg = "yabsm: internal error: called '$caller' with $num_args args but it expects";
        my $range_msg;
        if    ($upper eq '_')    { $range_msg = "at least $lower args" }
        elsif ($lower == $upper) { $range_msg = "$lower args"          }
        else                     { $range_msg = "$lower-$upper args"   }
        confess("$error_msg $range_msg");
    }

    return 1;
}

sub with_error_catch_log {

    # Call $sub with @args within a Feature::Compat::Try try/catch block to catch
    # any exception and log it to /var/log/yabsm instead of killing the program.

    my $sub  = shift;
    my @args = @_;

    try {
        $sub->(@args);
    }
    catch ($e) {
        if (-f '/var/log/yabsm' && open(my $fh, '>>', '/var/log/yabsm')) {
            $e =~ s/^\s+|\s+$//g;
            my $t = localtime();
            my ($yr, $mon, $day, $hr, $min) = map { sprintf '%02d', $_ } $t->year, $t->mon, $t->mday, $t->hour, $t->min;
            say $fh "[${yr}_${mon}_${day}_$hr:$min]: $e";
            close $fh;
        }
    }
}

sub have_sudo_access_to_btrfs {

    # Return 1 if we can run 'btrfs' with 'sudo -n' and return 0 otherwise.

    arg_count_or_die(0, 0, @_);

    return 0+(0 == system('sudo -n btrfs --help >/dev/null 2>&1'));
}

sub have_sudo_access_to_btrfs_or_die {

    # Wrapper around have_sudo_access_to_btrfs() that Carp::Confess's if it
    # returns false.

    arg_count_or_die(0, 0, @_);

    my $username = getpwuid $<;

    have_sudo_access_to_btrfs() ? return 1 : die("yabsm: internal error: no sudo access rights to 'btrfs' while running as user '$username'");
}

sub is_btrfs_dir {

    # Return 1 if $dir is a directory residing on a btrfs subvolume
    # and return 0 otherwise.

    arg_count_or_die(1, 1, @_);

    my $dir = shift;

    return 0 unless -d $dir;

    return 0+(0 == system("btrfs property list '$dir' >/dev/null 2>&1"));
}

sub is_btrfs_dir_or_die {

    # Wrapper around is_btrfs_dir() that Carp::Confess's if it returns false.

    arg_count_or_die(1, 1, @_);

    my $dir = shift;

    is_btrfs_dir($dir) ? return 1 : die("yabsm: internal error: '$dir' is not a directory residing on a btrfs filesystem\n")
}

sub is_btrfs_subvolume {

    # Return 1 if $dir is a btrfs subvolume on this OS and return 0
    # otherwise.
    #
    # A btrfs subvolume is identified by inode number 256

    arg_count_or_die(1, 1, @_);

    my $dir = shift;

    return 0 unless is_btrfs_dir($dir);

    my $inode_num = (split /\s+/, `ls -di '$dir' 2>/dev/null`, 2)[0];

    return 0+(256 == $inode_num);
}

sub is_btrfs_subvolume_or_die {

    # Wrapper around is_btrfs_subvolume() that Carp::Confess's if it returns
    # false.

    arg_count_or_die(1, 1, @_);

    my $dir = shift;

    is_btrfs_subvolume($dir) ? return 1 : die("yabsm: internal error: '$dir' is not a btrfs subvolume")
}

sub nums_denote_valid_date {

lib/App/Yabsm/Tools.pm  view on Meta::CPAN

    arg_count_or_die(5, 5, @_);

    unless ( nums_denote_valid_date(@_) ) {
        my ($yr, $mon, $day, $hr, $min) = @_;
        confess("yabsm: internal error: '${yr}_${mon}_${day}_$hr:$min' does not denote a valid yr_mon_day_hr:min date");
    }

    return 1;
}

sub system_or_die {

    # Wrapper around system that Carp::Confess's if the system command exits
    # with a non-zero status. Redirects STDOUT and STDERR to /dev/null.

    open my $NULLFD, '>', '/dev/null';
    open my $OLD_STDOUT, '>&', STDOUT;
    open my $OLD_STDERR, '>&', STDERR;
    open STDOUT, '>&', $NULLFD;
    open STDERR, '>&', $NULLFD;

    my $status = system @_;

    open STDOUT, '>&', $OLD_STDOUT;
    open STDERR, '>&', $OLD_STDERR;
    close $NULLFD;
    close $OLD_STDOUT;
    close $OLD_STDERR;

    unless (0 == $status) {
        confess("yabsm: internal error: system command '@_' exited with non-zero status '$status'");
    }

    return 1;
}

sub make_path_or_die {

    # Wrapper around File::Path::make_path() that Carp::Confess's if the path
    # cannot be created. The UID and GID of the $path will be set to that of the
    # deepest existing sub-directory in $path.

    my $path = shift;

    $path =~ /^\//
      or die "yabsm: internal error: '$path' is not an absolute path starting with '/'";

    my $dir = $path;

    until (-d $dir) {
        $dir = dirname($dir);
    }

    my ($uid, $gid) = (stat $dir)[4,5];

    -d $path and return 1;

    make_path($path, {uid => $uid, group => $gid}) and return 1;

    my $username = getpwuid $<;

    die "yabsm: error: could not create path '$path' while running as user '$username'\n";
}

sub i_am_root {

    # Return 1 if current user is root and return 0 otherwise.

    return 0+(0 == $<);
}

sub i_am_root_or_die {

    # Die unless running as the root user.

    arg_count_or_die(0, 0, @_);

    unless (i_am_root()) {
        my $username = getpwuid $<;
        confess("yabsm: internal error: not running as root - running as '$username'");
    }

    return 1;
}

1;