deprecated/e-smith-backup
6
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
fe41ccadec
e-smith-backup/root/usr/share/perl5/vendor_perl/esmith/BlockDevices.pm

511 lines
13 KiB
Perl
Raw Blame History

#----------------------------------------------------------------------
# Copyright 2015 Ian Wells
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#----------------------------------------------------------------------
package esmith::BlockDevices;
use strict;
use warnings;
use English '-no_match_vars';
use Carp;
use File::Path qw(make_path remove_tree);
use POSIX qw(:sys_wait_h strftime);
use Locale::gettext;
use File::stat;
use v5.10.1;
use Taint::Util;
use Readonly;
use File::Find;
use vars qw($VERSION @ISA @EXPORT_OK);
@ISA = qw(Exporter);
=head1 NAME
esmith::BlockDevices - Module to handle block devices
=head1 SYNOPSIS
use esmith::BlockDevices;
my $devices = BlockDevices->new ();
=head1 DESCRIPTION
This module provides an abstracted interface to the
block devices used for backup/restore
=cut
my $EMPTY = q{};
sub new
{
my $class = shift;
my $self = {
_blox => lsblk(),
mount => findValidFS(),
_fstype => $EMPTY,
allowmount => $EMPTY,
@_,
};
bless $self, $class;
return $self;
}
sub lsblk
{
#ToDo add some comments
my %blox; # a hash to hold the device information
my $short = qx(/bin/lsblk -sdn -o KNAME);
my @long = qx(/bin/lsblk -P -b -o KNAME,MAJ:MIN,RM,RO,TYPE,MOUNTPOINT,FSTYPE,LABEL,UUID,MODEL,SIZE,STATE,MODE,OWNER,GROUP);
# Not all of this information may be needed currently, but it does not affect the processing time
untaint ($short);
untaint (@long);
my $devicemodel= $EMPTY;
for (@long)
{
my @line = split /\"\s/s;
my $name;
if ($line[0] =~ /KNAME=\"(.*)/s)
{
$name = $1;
}
else {carp 'Could not match KNAME'; last;} # should never occur.
$blox{$name}{tip} = ($short =~ m/^$name$/sm) ? 1 : 0;
for (@line)
{
my ($key,$value) = split /=/s;
$value =~ s/\"//sg;
$blox{$name}{$key} = trim($value);
}
if ($blox{$name}{TYPE} =~ /rom|disk/s)
{
$devicemodel = $blox{$name}{MODEL};
}
else
{
$blox{$name}{MODEL} = trim($devicemodel);
}
$blox{$name}{SIZEH} = scaleIt($blox{$name}{SIZE});
}
return \%blox;
}
sub findValidFS
{
# Find all filesystem types that are supported
my %fs; # a hash to hold the supported filesystem type information
my @cmd = `cat /proc/filesystems`;
foreach (@cmd)
{
if (/.*\t(.*?)$/s){$fs {$1}=$1;}
}
@cmd = `ls -1 /lib/modules/\$(uname -r)/kernel/fs/*/*ko.*`;
foreach (@cmd)
{
if (/.*\/(.*?)\.ko/s){$fs {$1}=$1;}
}
# If ext4 driver is present, add ext2 and ext3
if(exists($fs{ext4}))
{
$fs{'ext2'}='ext2';
$fs{'ext3'}='ext3';
}
return \%fs;
}
sub scanBlocks
{
# Scan all the block devices
# This takes some seconds on systems with many filesystems
my ($self) = @_;
$self->{_blox} = lsblk;
$self->{_fstype} = findValidFS;
return;
}
sub list
{
my ($self) = @_;
my @dirs=();
my $hashref = $self->{_blox};
foreach my $drive (keys %{$hashref})
{
push @dirs, $drive;
}
return @dirs;
}
sub checkBackupDriveSize
{
my ($self,$drive, $size) = @_;
my $hashref = $self->{_blox};
my $sz = $EMPTY;
my $mntdir = $self->{mount};
Readonly my $VFAT_LIMIT => 2147483648;
Readonly my $KBYTE => 1024;
# size > drive size
if ($size > $hashref->{$drive}{SIZE})
{
return 1; # filesystem too small
}
# FAT32 drive and size > 2G
if (($size > $VFAT_LIMIT) && ($hashref->{$drive}{FSTYPE} eq 'vfat'))
{
return 2; # filesystem vfat limit
}
#ToDo add a check here to see if mounting is allowed by db value
# check mount and find actual size
if ($self->mountable ($drive)) # Only check filesystems that appear mountable
{
$self->mount ($drive);
my $filesize = -s "$mntdir/smeserver.tgz";
# Check free disk space
my $df = qx(/usr/bin/df -P \"$mntdir\");
if ($df =~ /(\S+)\s+(\S+)\s+(\S+)\s+(\d*%)/s)
{
my $dsize = ($3 * $KBYTE) + ($filesize //= 0);
if ($size > $dsize) # not enough space
{
$sz = 3; # filesystem has too little free space
}
}
else # fail (never seen in testing)
{
$sz = 4; # Failed to get disk size
}
$self->unmount;
}
return $sz;
}
# Check each block device
# Return two arrays, valid drives, invalid drives
sub checkBackupDrives
{
my ($self,$bsize) = @_;
my @valid = ();
my @invalid = ();
$self->scanBlocks; # scan all block devices
my $hashref = $self->{_blox};
my $allowmount = $self->{'allowmount'}; # Are mounted drives allowed in $checks.
my $checks = 'UU RO FS'; # These checks are always valid
$checks .= ' MO' if ($allowmount eq 'enabled');
$checks .= ' SZ' if ($bsize); # Only run the size check when a valid size is given
foreach my $drive (keys %{$hashref})
{
$hashref->{$drive}{REASON} = $EMPTY; # Reason for a filesystem being (in)valid
next unless $hashref->{$drive}{tip}; #Ignore drives that have child filesystems
# drives mounted on /, /boot, or [SWAP] are never valid for backups
next if ($hashref->{$drive}{MOUNTPOINT} =~ /^\/boot$|^\[SWAP\]$|^\/$/s );
# validate each filesystem against the checks
foreach my $check (split / /s, $checks)
{
for ($check)
{
if (/^UU/si) # No UUID
{
$hashref->{$drive}{REASON} .='UU ' unless $self->uuid ($drive); last;
}
if (/^RO/si) # Read Only
{
$hashref->{$drive}{REASON} .='RO ' if $self->readonly ($drive); last;
}
if (/^FS/si) # Invalid filesystem
{
$hashref->{$drive}{REASON} .='FS ' unless $self->validFS ($drive); last;
}
if (/^MO/si) # Mounted
{
$hashref->{$drive}{REASON} .='MO ' if $self->mountpoint ($drive); last;
}
if (/^SZ/si) # filesystem size, this includes mounting to check free space
{
$hashref->{$drive}{REASON} .='SZ ' if $self->checkBackupDriveSize ($drive, $bsize);
#ToDo the return value contains the reason why there is insufficient space, but this is not used yet.
last;
}
{ carp "not supported yet in checkBackupDrives: $check"; } # Should never be seen
}
}
if ($hashref->{$drive}{REASON})
{
push @invalid, $drive;
}
else
{
push @valid, $drive;
}
}
return (\@valid, \@invalid);
}
sub findBackup
{
my ($self, $kname, $foundref, $maxDepth, $count) = @_;
my $hashref = $self->{_blox};
my $mountpoint = $self->{'mount'};
my $file = 'smeserver.tgz';
$self->mount ($kname);
sleep 1;
# start with the absolute path
my $findRoot = Cwd::realpath($mountpoint);
# determine the depth of our beginning directory
my $begDepth = 1 + grep { length } File::Spec->splitdir($findRoot);
find (
{
preprocess => sub
{ @_ if (scalar File::Spec->splitdir($File::Find::dir) - $begDepth) <= $maxDepth },
wanted => sub
{
if (($_ =~ m/^$file/s) && ($File::Find::name =~ qr|^([-+@\w\s./:\\]+)$| )) # if matching the backup name
{
$$count++;
my $sb = stat $1;
${$foundref}{$$count}{count}=$$count;
${$foundref}{$$count}{device}=$kname;
${$foundref}{$$count}{path} = $1;
${$foundref}{$$count}{path} =~ s/$mountpoint//; #strip off the mountpoint
${$foundref}{$$count}{path} =~ s/$file//; #strip off the filename
${$foundref}{$$count}{size}=$sb->size; # size in bytes
${$foundref}{$$count}{sizeH}=scaleIt($sb->size); # human readable size
${$foundref}{$$count}{time}=strftime '%d %b %g %H:%M', localtime $sb->mtime;
}
},
untaint => 1,
untaint_pattern => qr|^([-+@\w\s./:\\]+)$|,
untaint_skip =>1,
},
$findRoot
);
$self->unmount;
return;
}
sub desc # brief description of a filesystem
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
my $model = $hashref->{$kname}{MODEL};
my $label = $hashref->{$kname}{LABEL} || gettext('no label');
my $size = $hashref->{$kname}{SIZEH};
return "$label $model $size";
}
# Given the KNAME check if the filesystem.could be mountable
# Check that there are no children, i.e. a tip
# Check that it has a UUID, Filesystem,
sub mountable
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{tip} && $hashref->{$kname}{UUID} && _isFS ($hashref->{$kname}{FSTYPE})) ? 1 : $EMPTY;
}
# Given the KNAME check if the filesystem.is read-only
# returns 1 for Read-Only and $EMPTY for R-W
sub readonly
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{RO}) ? 1 : $EMPTY;
}
sub mountpoint
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{MOUNTPOINT});
}
sub uuid
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{UUID});
}
sub model
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{MODEL});
}
# Given the KNAME return the label
# returns 'no label' if none found
sub label
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{LABEL}) || gettext('no label');
}
sub size
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{SIZE});
}
# Given a filesystem.(eg sr0) check if it's filesystem type is allowed
sub validFS
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
my $fsref = $self->{_fstype};
return ($fsref->{$hashref->{$kname}{FSTYPE}}) || $EMPTY;
}
# Given a filesystem.type (eg vfat) check if it is allowed
sub _isFS
{
my ($filesystem) = @_;
return $EMPTY unless $filesystem;
my $fsref = findValidFS;
return ($fsref->{$filesystem}) || $EMPTY;
}
# Return the reason string which indicates why a drive is (in)valid
sub reason
{
my ($self,$kname) = @_;
my $hashref = $self->{_blox};
return ($hashref->{$kname}{REASON});
}
# Given the KNAME mount the filesystem, example
# system ('/bin/mount', '-t', 'vfat', '-U', '9891-4C8A', '/tmp/mnt');
sub mount
{
my ($self, $kname) = @_;
my $hashref = $self->{_blox};
$self->createMountpoint;
system ('/bin/mount', '-t', $hashref->{$kname}{FSTYPE}, '-U', $hashref->{$kname}{UUID}, $self->{mount}) == 0
or croak (gettext('Failed to mount')." $self->{mount},$hashref->{$kname}{FSTYPE},$hashref->{$kname}{UUID}: $?");
return;
}
# Unmount the block device
sub unmount
{
my $self = shift;
system('/bin/umount', $self->{mount}) == 0
or croak (gettext('Failed to unmount')." $self->{mount}: $?");
return;
}
# Create the mountpoint directory
# Error if already mounted
sub createMountpoint
{
my $self = shift;
my $mount = $self->{mount};
# Check if the mountpoint is in use
if (!checkMount ($mount))
{
# Try to unmount, will die if fails
$self->unmount;
}
if ($mount && ! -d $mount)
{
eval {make_path($mount)};
croak (gettext('Error while creating')." $mount $EVAL_ERROR".gettext('Maybe insufficient permissions.')) if $EVAL_ERROR;
}
return;
}
sub destroy
{
# cleanup, unmount and remove mountpoint
my $self = shift;
my $mount = $self->{mount};
# Check if the mountpoint is in use
if (!checkMount ($mount))
{
$self->unmount;
}
if ($mount && -d $mount)
{
eval {remove_tree($mount)};
croak (gettext('Error while deleting')." $mount $EVAL_ERROR") if $EVAL_ERROR;
}
return;
}
### The following subroutines are not specific to block devices
sub scaleIt {
Readonly my $KBYTE => 1024;
my( $size, $n ) =( shift, 0 );
++$n and $size /= $KBYTE until $size < $KBYTE;
if ($size >= 1000){++$n ; $size /= $KBYTE;}
return sprintf "%.3g %s",
$size, ( qw[ bytes KB MB GB TB] )[ $n ];
}
sub checkMount
{
# check if $mountdir is mounted
my $mountdir = shift;
$|=1; # Auto-flush
# copy STDOUT to another filehandle
open (my $STDOLD, '>&', STDOUT);
open(STDOUT, ">/dev/null");
if ( open(MOUNTDIR, "|-", "/bin/findmnt", $mountdir)){;}
# restore STDOUT
open (STDOUT, '>&', $STDOLD);
return (!close(MOUNTDIR));
}
# remove leading and trailing spaces from a string
# this should be moved to a util library.
sub trim
{
my ($string) = @_;
$string =~ s/^\s+|\s+$//g;
return $string;
}
1;
View Git Blame Copy Permalink