#----------------------------------------------------------------------
# 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;