pgbackrest/lib/pgBackRest/FileCommon.pm

####################################################################################################################################
# FILE COMMON    MODULE
####################################################################################################################################
package pgBackRest::FileCommon;

use strict;
use warnings FATAL => qw(all);
use Carp qw(confess);

use Digest::SHA;
use Exporter qw(import);
    our @EXPORT = qw();
use Fcntl qw(:mode :flock O_RDONLY O_WRONLY O_CREAT O_TRUNC);
use File::Basename qw(dirname);
use File::Path qw(make_path);
use File::stat;
use IO::Handle;

use lib dirname($0) . '/../lib';
use pgBackRest::Common::Exception;
use pgBackRest::Common::Log;

####################################################################################################################################
# Default modes
####################################################################################################################################
my $strPathModeDefault = '0750';
my $strFileModeDefault = '0640';

####################################################################################################################################
# fileExists
#
# Check if a path or file exists.
####################################################################################################################################
sub fileExists
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFile
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileExists', \@_,
            {name => 'strFile', required => true, trace => true}
        );

    # Working variables
    my $bExists = true;

    # Stat the file/path to determine if it exists
    my $oStat = lstat($strFile);

    # Evaluate error
    if (!defined($oStat))
    {
        my $strError = $!;

        # If the error is not entry missing, then throw error
        if (!$!{ENOENT})
        {
            confess &log(ERROR, "unable to read ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
        }

        $bExists = false;
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'bExists', value => $bExists, trace => true}
    );
}

push @EXPORT, qw(fileExists);

####################################################################################################################################
# fileHash
#
# Get the file hash and size.
####################################################################################################################################
sub fileHash
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFile,
        $bCompressed,
        $strHashType
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileHash', \@_,
            {name => 'strFile', trace => true},
            {name => 'bCompressed', default => false, trace => true},
            {name => 'strHashType', default => 'sha1', trace => true}
        );

    # Working variables
    my ($strHash) = fileHashSize($strFile, $bCompressed, $strHashType);

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'strHash', value => $strHash, trace => true}
    );
}

push @EXPORT, qw(fileHash);

####################################################################################################################################
# fileHashSize
#
# Get the file hash and size.
####################################################################################################################################
sub fileHashSize
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFile,
        $bCompressed,
        $strHashType,
        $oProtocol
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileHashSize', \@_,
            {name => 'strFile', trace => true},
            {name => 'bCompressed', default => false, trace => true},
            {name => 'strHashType', default => 'sha1', trace => true},
            {name => 'oProtocol', required => false, trace => true}
        );

    # Working variables
    my $strHash;
    my $iSize = 0;
    my $hFile;

    if (!sysopen($hFile, $strFile, O_RDONLY))
    {
        my $strError = $!;

        # If file exists then throw the error
        if (fileExists($strFile))
        {
            confess &log(ERROR, "unable to open ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
        }

        confess &log(ERROR, "${strFile} does not exist", ERROR_FILE_MISSING);
    }

    my $oSHA = Digest::SHA->new($strHashType);

    if ($bCompressed)
    {
        # ??? Not crazy about pushing the protocol object in here.  Probably binaryXfer() should be refactored into a standalone
        # function in this file.
        if (!defined($oProtocol))
        {
            confess &log(ASSERT, "oProtocol must be provided to hash compressed file");
        }

        ($strHash, $iSize) =
            $oProtocol->binaryXfer($hFile, 'none', 'in', true, false, false);
    }
    else
    {
        my $iBlockSize;
        my $tBuffer;

        do
        {
            # Read a block from the file
            $iBlockSize = sysread($hFile, $tBuffer, 4194304);

            if (!defined($iBlockSize))
            {
                confess &log(ERROR, "${strFile} could not be read: " . $!, ERROR_FILE_READ);
            }

            $iSize += $iBlockSize;
            $oSHA->add($tBuffer);
        }
        while ($iBlockSize > 0);

        $strHash = $oSHA->hexdigest();
    }

    close($hFile);

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'strHash', value => $strHash, trace => true},
        {name => 'iSize', value => $iSize, trace => true}
    );
}

push @EXPORT, qw(fileHashSize);

####################################################################################################################################
# fileList
#
# List a directory with filters and ordering.
####################################################################################################################################
sub fileList
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strPath,
        $strExpression,
        $strSortOrder,
        $bIgnoreMissing
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileList', \@_,
            {name => 'strPath', trace => true},
            {name => 'strExpression', required => false, trace => true},
            {name => 'strSortOrder', default => 'forward', trace => true},
            {name => 'bIgnoreMissing', default => false, trace => true}
        );

    # Working variables
    my @stryFileList;
    my $hPath;

    # Attempt to open the path
    if (opendir($hPath, $strPath))
    {
        @stryFileList = grep(!/^(\.)|(\.\.)$/i, readdir($hPath));
        close($hPath);

        # Apply expression if defined
        if (defined($strExpression))
        {
            @stryFileList = grep(/$strExpression/i, @stryFileList);
        }

        # Reverse sort
        if ($strSortOrder eq 'reverse')
        {
            @stryFileList = sort {$b cmp $a} @stryFileList;
        }
        # Normal sort
        else
        {
            @stryFileList = sort @stryFileList;
        }
    }
    # Else process errors
    else
    {
        my $strError = $!;

        # If path exists then throw the error
        if (fileExists($strPath))
        {
            confess &log(ERROR, "unable to read ${strPath}" . (defined($strError) ? ": $strError" : ''), ERROR_PATH_OPEN);
        }
        # Else throw an error unless missing paths are ignored
        elsif (!$bIgnoreMissing)
        {
            confess &log(ERROR, "${strPath} does not exist", ERROR_PATH_MISSING);
        }
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'stryFileList', value => \@stryFileList, trace => true}
    );
}

push @EXPORT, qw(fileList);

####################################################################################################################################
# fileMode
#
# Set the file mode.
####################################################################################################################################
sub fileMode
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFile,
        $strMode,
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileModeDefaultSet', \@_,
            {name => 'strFile', trace => true},
            {name => 'strMode', default => $strFileModeDefault, trace => true},
        );

    # Change mode
    if(!chmod(oct($strMode), $strFile))
    {
        my $strError = $!;

        # If file exists then throw the error
        if (fileExists($strFile))
        {
            confess &log(ERROR, "unable to chmod ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_MODE);
        }

        confess &log(ERROR, "${strFile} does not exist", ERROR_FILE_MISSING);
    }

    # Return from function and log return values if any
    return logDebugReturn($strOperation);
}

push @EXPORT, qw(fileMode);

####################################################################################################################################
# fileModeDefaultSet
#
# Set the default mode to be used when creating files.
####################################################################################################################################
sub fileModeDefaultSet
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strMode,
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileModeDefaultSet', \@_,
            {name => 'strMode', trace => true},
        );

    $strFileModeDefault = $strMode;

    # Return from function and log return values if any
    return logDebugReturn($strOperation);
}

push @EXPORT, qw(fileModeDefaultSet);

####################################################################################################################################
# fileMove
#
# Move a file.
####################################################################################################################################
sub fileMove
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strSourceFile,
        $strDestinationFile,
        $bDestinationPathCreate
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileMove', \@_,
            {name => 'strSourceFile', trace => true},
            {name => 'strDestinationFile', trace => true},
            {name => 'bDestinationPathCreate', default => false, trace => true}
        );

    # Get source and destination paths
    my $strSourcePath = dirname($strSourceFile);
    my $strDestinationPath = dirname($strDestinationFile);

    # Move the file
    if (!rename($strSourceFile, $strDestinationFile))
    {
        my $strError = $!;
        my $bError = true;

        # If the destination path does not exist and can be created then create it
        if ($bDestinationPathCreate && !fileExists($strDestinationPath))
        {
            $bError = false;

            filePathCreate(dirname($strDestinationFile), undef, true, true);

            # Try the rename again and store the error if it fails
            if (!rename($strSourceFile, $strDestinationFile))
            {
                $strError = $!;
                $bError = true;
            }
        }

        # If there was an error then raise it
        if ($bError)
        {
            confess &log(ERROR, "unable to move file ${strSourceFile} to ${strDestinationFile}" .
                                (defined($strError) ? ": $strError" : ''), ERROR_FILE_MOVE);
        }
    }

    # Always sync the destination directory
    filePathSync(dirname($strDestinationFile));

    # If the source and destination directories are not the same then sync the source directory
    if (dirname($strSourceFile) ne dirname($strDestinationFile))
    {
        filePathSync(dirname($strSourceFile));
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation
    );
}

push @EXPORT, qw(fileMove);

####################################################################################################################################
# fileOpen
#
# Open a file.
####################################################################################################################################
sub fileOpen
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFile,
        $lFlags,
        $strMode,
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileOpen', \@_,
            {name => 'strFile', trace => true},
            {name => 'lFlags', trace => true},
            {name => 'strMode', default => $strFileModeDefault, trace => true},
        );

    my $hFile;

    if (!sysopen($hFile, $strFile, $lFlags, oct($strMode)))
    {
        my $strError = $!;

        # If file exists then throw the error
        if (fileExists($strFile))
        {
            confess &log(ERROR, "unable to open ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
        }

        confess &log(ERROR, "${strFile} does not exist", ERROR_FILE_MISSING);
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'hFile', value => $hFile, trace => true}
    );
}

push @EXPORT, qw(fileOpen);

####################################################################################################################################
# filePathSync
#
# Sync a directory.
####################################################################################################################################
sub filePathSync
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strPath
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::filePathSync', \@_,
            {name => 'strPath', trace => true}
        );

    open(my $hPath, "<", $strPath)
        or confess &log(ERROR, "unable to open ${strPath}", ERROR_PATH_OPEN);
    open(my $hPathDup, ">&", $hPath)
        or confess &log(ERROR, "unable to duplicate handle for ${strPath}", ERROR_PATH_OPEN);

    $hPathDup->sync
        or confess &log(ERROR, "unable to sync ${strPath}", ERROR_PATH_SYNC);

    # Return from function and log return values if any
    return logDebugReturn($strOperation);
}

push @EXPORT, qw(filePathSync);

####################################################################################################################################
# fileRemove
#
# Remove a file from the file system.
####################################################################################################################################
sub fileRemove
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strPath,
        $bIgnoreMissing
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileRemove', \@_,
            {name => 'strPath', trace => true},
            {name => 'bIgnoreMissing', default => false, trace => true}
        );

    # Working variables
    my $bRemoved = true;

    # Remove the file
    if (unlink($strPath) != 1)
    {
        $bRemoved = false;
        my $strError = $!;

        # If path exists then throw the error
        if (fileExists($strPath))
        {
            confess &log(ERROR, "unable to remove ${strPath}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
        }
        # Else throw an error unless missing paths are ignored
        elsif (!$bIgnoreMissing)
        {
            confess &log(ERROR, "${strPath} does not exist", ERROR_FILE_MISSING);
        }
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'bRemoved', value => $bRemoved, trace => true}
    );
}

push @EXPORT, qw(fileRemove);


####################################################################################################################################
# fileStat
#
# Stat a file.
####################################################################################################################################
sub fileStat
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFile
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileStat', \@_,
            {name => 'strFile', required => true, trace => true}
        );

    # Stat the file/path to determine if it exists
    my $oStat = lstat($strFile);

    # Evaluate error
    if (!defined($oStat))
    {
        my $strError = $!;
        confess &log(ERROR, "unable to read ${strFile}" . (defined($strError) ? ": $strError" : ''), ERROR_FILE_OPEN);
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'oStat', value => $oStat, trace => true}
    );
}

push @EXPORT, qw(fileStat);

####################################################################################################################################
# fileStringRead
#
# Read the specified file as a string.
####################################################################################################################################
sub fileStringRead
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFileName
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileStringRead', \@_,
            {name => 'strFileName', trace => true}
        );

    # Open the file for writing
    sysopen(my $hFile, $strFileName, O_RDONLY)
        or confess &log(ERROR, "unable to open ${strFileName}");

    # Read the string
    my $iBytesRead;
    my $iBytesTotal = 0;
    my $strContent;

    do
    {
        $iBytesRead = sysread($hFile, $strContent, 65536, $iBytesTotal);

        if (!defined($iBytesRead))
        {
            confess &log(ERROR, "unable to read string from ${strFileName}: $!", ERROR_FILE_READ);
        }

        $iBytesTotal += $iBytesRead;
    }
    while ($iBytesRead != 0);

    close($hFile);

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'strContent', value => $strContent, trace => true}
    );
}

push @EXPORT, qw(fileStringRead);

####################################################################################################################################
# fileStringWrite
#
# Write a string to the specified file.
####################################################################################################################################
sub fileStringWrite
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strFileName,
        $strContent,
        $bSync
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::fileStringWrite', \@_,
            {name => 'strFileName', trace => true},
            {name => 'strContent', trace => true},
            {name => 'bSync', default => true, trace => true},
        );

    # Open the file for writing
    sysopen(my $hFile, $strFileName, O_WRONLY | O_CREAT | O_TRUNC, oct(640))
        or confess &log(ERROR, "unable to open ${strFileName}");

    # Write the string
    syswrite($hFile, $strContent)
        or confess &log(ERROR, "unable to write string to ${strFileName}: $!", ERROR_FILE_WRITE);

    # Sync file
    $hFile->sync() if $bSync;

    # Close file
    close($hFile);

    # Sync directory
    filePathSync(dirname($strFileName)) if $bSync;

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation
    );
}

push @EXPORT, qw(fileStringWrite);

####################################################################################################################################
# pathAbsolute
#
# Generate an absolute path from an absolute base path and a relative path.
####################################################################################################################################
sub pathAbsolute
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strBasePath,
        $strPath
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::pathAbsolute', \@_,
            {name => 'strBasePath', trace => true},
            {name => 'strPath', trace => true}
        );

    # Working variables
    my $strAbsolutePath;

    # If the path is already absolute
    if (index($strPath, '/') == 0)
    {
        $strAbsolutePath = $strPath;
    }
    # Else make it absolute using the base path
    else
    {
        # Make sure the absolute path is really absolute
        if (index($strBasePath, '/') != 0 || index($strBasePath, '/..') != -1)
        {
            confess &log(ERROR, "${strBasePath} is not an absolute path", ERROR_PATH_TYPE);
        }

        while (index($strPath, '..') == 0)
        {
            $strBasePath = dirname($strBasePath);
            $strPath = substr($strPath, 2);

            if (index($strPath, '/') == 0)
            {
                $strPath = substr($strPath, 1);
            }
        }

        $strAbsolutePath = "${strBasePath}/${strPath}";
    }

    # Make sure the result is really an absolute path
    if (index($strAbsolutePath, '/') != 0 || index($strAbsolutePath, '/..') != -1)
    {
        confess &log(ERROR, "result ${strAbsolutePath} was not an absolute path", ERROR_PATH_TYPE);
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation,
        {name => 'strAbsolutePath', value => $strAbsolutePath, trace => true}
    );
}

push @EXPORT, qw(pathAbsolute);

####################################################################################################################################
# pathModeDefaultSet
#
# Set the default mode to be used when creating paths.
####################################################################################################################################
sub pathModeDefaultSet
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strMode
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::pathModeDefaultSet', \@_,
            {name => 'strMode', trace => true},
        );

    $strPathModeDefault = $strMode;

    # Return from function and log return values if any
    return logDebugReturn($strOperation);
}

push @EXPORT, qw(pathModeDefaultSet);

####################################################################################################################################
# filePathCreate
#
# Create a path.
####################################################################################################################################
sub filePathCreate
{
    # Assign function parameters, defaults, and log debug info
    my
    (
        $strOperation,
        $strPath,
        $strMode,
        $bIgnoreExists,
        $bCreateParents
    ) =
        logDebugParam
        (
            __PACKAGE__ . '::filePathCreate', \@_,
            {name => 'strPath', trace => true},
            {name => 'strMode', default => $strPathModeDefault, trace => true},
            {name => 'bIgnoreExists', default => false, trace => true},
            {name => 'bCreateParents', default => false, trace => true}
        );

    if (!($bIgnoreExists && fileExists($strPath)))
    {
        # Attempt to create the directory
        my $stryError;

        if (!$bCreateParents && !fileExists(dirname($strPath)))
        {
            confess &log(ERROR, "unable to create ${strPath} because parent path does not exist", ERROR_PATH_CREATE);
        }

        make_path($strPath, {mode => oct($strMode), error => \$stryError});

        # Throw any errrors that were returned
        if (@$stryError)
        {
            my ($strErrorPath, $strErrorMessage) = %{@$stryError[0]};
            confess &log(ERROR, "unable to create ${strPath}: ${strErrorMessage}", ERROR_PATH_CREATE);
        }
    }

    # Return from function and log return values if any
    return logDebugReturn
    (
        $strOperation
    );
}

push @EXPORT, qw(filePathCreate);

1;