db/pgbackrest
1
0
Fork 0
mirror of https://github.com/pgbackrest/pgbackrest.git synced 2025-10-30 23:37:45 +02:00
Code Issues Releases Activity

Perl error handler recognizes errors thrown from the C library.

Browse Source
This commit is contained in:
David Steele
2017-10-16 10:47:31 -04:00
parent f1e739b4aa
commit 904b83747c
18 changed files with 114 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
doc/doc.pl
View File

@@ -336,7 +336,7 @@ eval
or do
{
# If a backrest exception then return the code
exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
print $EVAL_ERROR;

2
doc/release.pl
View File

@@ -196,7 +196,7 @@ eval
or do
{
# If a backrest exception then return the code
exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
print $EVAL_ERROR;

4
doc/xml/release.xml
View File

@@ -32,6 +32,10 @@
<release-item>
<p>Add C error handler.</p>
</release-item>
<release-item>
<p>Perl error handler recognizes errors thrown from the C library.</p>
</release-item>
</release-refactor-list>
</release-core-list>

2
lib/pgBackRest/Archive/Info.pm
View File

@@ -102,7 +102,7 @@ sub new
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
$strResultMessage = exceptionMessage($EVAL_ERROR->message());
$strResultMessage = exceptionMessage($EVAL_ERROR);
};
if ($iResult != 0)

2
lib/pgBackRest/Backup/Info.pm
View File

@@ -146,7 +146,7 @@ sub new
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
$strResultMessage = exceptionMessage($EVAL_ERROR->message());
$strResultMessage = exceptionMessage($EVAL_ERROR);
};
if ($iResult != 0)

6
lib/pgBackRest/Check/Check.pm
View File

@@ -88,7 +88,7 @@ sub process
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
$strResultMessage = exceptionMessage($EVAL_ERROR->message());
$strResultMessage = exceptionMessage($EVAL_ERROR);
};
# Check archive.info
@@ -104,7 +104,7 @@ sub process
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
$strResultMessage = exceptionMessage($EVAL_ERROR->message());
$strResultMessage = exceptionMessage($EVAL_ERROR);
};
}
@@ -123,7 +123,7 @@ sub process
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
$strResultMessage = exceptionMessage($EVAL_ERROR->message());
$strResultMessage = exceptionMessage($EVAL_ERROR);
};
}

31
lib/pgBackRest/Common/Exception.pm
View File

@@ -248,15 +248,32 @@ sub trace
}
####################################################################################################################################
# isException
#
# Is this a structured exception?
# isException - is this a structured exception or a default Perl exception?
####################################################################################################################################
sub isException
{
my $oException = shift;
my $roException = shift;
return defined($oException) && blessed($oException) && $oException->isa('pgBackRest::Common::Exception') ? 1 : 0;
# Only check if defined
if (defined($roException) && defined($$roException))
{
# If a standard Exception
if (blessed($$roException))
{
return $$roException->isa('pgBackRest::Common::Exception') ? 1 : 0;
}
# Else if a specially formatted string from the C library
elsif ($$roException =~ /^PGBRCLIB\:[0-9]+\:/)
{
my @stryException = split(/\:/, $$roException);
$$roException = new pgBackRest::Common::Exception(
"ERROR", $stryException[1] + 0, $stryException[4], $stryException[2] . qw{:} . $stryException[3]);
return 1;
}
}
return 0;
}
push @EXPORT, qw(isException);
@@ -270,7 +287,7 @@ sub exceptionCode
{
my $oException = shift;
return isException($oException) ? $oException->code() : ERROR_UNKNOWN;
return isException(\$oException) ? $oException->code() : ERROR_UNKNOWN;
}
push @EXPORT, qw(exceptionCode);
@@ -284,7 +301,7 @@ sub exceptionMessage
{
my $oException = shift;
return isException($oException) ? $oException->message() : $oException;
return isException(\$oException) ? $oException->message() : $oException;
}
push @EXPORT, qw(exceptionMessage);

2
lib/pgBackRest/Common/Exit.pm
View File

@@ -73,7 +73,7 @@ sub exitSafe
if (!defined($iExitCode))
{
# If a backrest exception
if (isException($oException))
if (isException(\$oException))
{
$iExitCode = $oException->code();
logException($oException);

4
lib/pgBackRest/Protocol/Base/Minion.pm
View File

@@ -92,7 +92,7 @@ sub errorWrite
my $oException = shift;
# Throw hard error if this is not a standard exception
if (!isException($oException))
if (!isException(\$oException))
{
confess &log(ERROR, 'unknown error: ' . $oException, ERROR_UNKNOWN);
}
@@ -189,7 +189,7 @@ sub process
logLevelSet(undef, undef, PROTOCOL);
# If standard exception
if (isException($oException))
if (isException(\$oException))
{
confess &log($oException->level(), $oException->message(), $oException->code());
}

2
lib/pgBackRest/Protocol/Command/Master.pm
View File

@@ -112,7 +112,7 @@ sub close
my $strError = 'unable to shutdown protocol';
my $strHint = 'HINT: the process completed all operations successfully but protocol-timeout may need to be increased.';
if (isException($oException))
if (isException(\$oException))
{
$iExitStatus = $oException->code();
}

2
lib/pgBackRest/Protocol/Local/Process.pm
View File

@@ -334,7 +334,7 @@ sub process
my $oException = $EVAL_ERROR;
# If not a backrest exception then always confess it - something has gone very wrong
confess $oException if (!isException($oException));
confess $oException if (!isException(\$oException));
# If the process is has terminated throw the exception
if (!defined($hLocal->{oLocal}->io()->processId()))

4
lib/pgBackRest/Stanza.pm
View File

@@ -322,7 +322,7 @@ sub infoObject
# Reset console logging and capture error information
logEnable();
$iResult = exceptionCode($EVAL_ERROR);
$strResultMessage = exceptionMessage($EVAL_ERROR->message());
$strResultMessage = exceptionMessage($EVAL_ERROR);
};
if ($iResult != 0)
@@ -445,7 +445,7 @@ sub infoFileCreate
# Reset console logging and capture error information
logEnable();
$iResult = exceptionCode($EVAL_ERROR);
$strResultMessage = exceptionMessage($EVAL_ERROR->message());
$strResultMessage = exceptionMessage($EVAL_ERROR);
};
# If we got here without error then save the reconstructed file

62
libc/LibC.h Normal file
View File

@@ -0,0 +1,62 @@
/***********************************************************************************************************************************
Helper macros for LibC.xs
***********************************************************************************************************************************/
/***********************************************************************************************************************************
Package Names
***********************************************************************************************************************************/
#define PACKAGE_NAME "pgBackRest"
#define PACKAGE_NAME_LIBC PACKAGE_NAME "::LibC"
/***********************************************************************************************************************************
Load C error into ERROR_SV_error
#define FUNCTION_NAME_ERROR "libcExceptionNew"
#define ERROR_SV() \
SV *ERROR_SV_error; \
\
{ \
// Push parameters onto the Perl stack \
ENTER; \
SAVETMPS; \
PUSHMARK(SP); \
EXTEND(SP, 2); \
PUSHs(sv_2mortal(newSViv(errorCode()))); \
PUSHs(sv_2mortal(newSVpv(errorMessage(), 0))); \
PUTBACK; \
\
// Call error function \
int count = call_pv(PACKAGE_NAME_LIBC "::" FUNCTION_NAME_ERROR, G_SCALAR); \
SPAGAIN; \
\
// Check that correct number of parameters was returned \
if (count != 1) \
croak("expected 1 return value from " FUNCTION_NAME_ERROR "()"); \
\
// Make a copy of the error that can be returned \
ERROR_SV_error = newSVsv(POPs); \
\
// Clean up the stack \
PUTBACK; \
FREETMPS; \
LEAVE; \
}
This turned out to be a dead end because Perl 5.10 does not support croak_sv(), but this code has been kept for example purposes.
***********************************************************************************************************************************/
/***********************************************************************************************************************************
Error handling macros that throw a Perl error when a C error is caught
***********************************************************************************************************************************/
#define ERROR_XS_BEGIN() \
ERROR_TRY()
#define ERROR_XS() \
croak("PGBRCLIB:%d:%s:%d:%s", errorCode(), errorFileName(), errorFileLine(), errorMessage());
#define ERROR_XS_END() \
ERROR_CATCH_ANY() \
{ \
ERROR_XS(); \
}

6
libc/LibC.xs
View File

@@ -26,11 +26,15 @@ C includes
These includes are from the src directory. There is no Perl-specific code in them.
***********************************************************************************************************************************/
#include "common/error.h"
#include "common/type.h"
#include "config/config.h"
#include "config/configRule.h"
#include "postgres/pageChecksum.h"
/***********************************************************************************************************************************
Helper macros
***********************************************************************************************************************************/
#include "LibC.h"
/***********************************************************************************************************************************
Constant include

4
test/lib/pgBackRestTest/Common/RunTest.pm
View File

@@ -344,7 +344,7 @@ sub testResult
# Restore the log level
logLevelSet($strLogLevelFile, $strLogLevelConsole, $strLogLevelStdErr, $bLogTimestamp);
if (!isException($EVAL_ERROR))
if (!isException(\$EVAL_ERROR))
{
confess "unexpected standard Perl exception" . (defined($EVAL_ERROR) ? ": ${EVAL_ERROR}" : '');
}
@@ -421,7 +421,7 @@ sub testException
{
logEnable();
if (!isException($EVAL_ERROR))
if (!isException(\$EVAL_ERROR))
{
confess "${strError} but actual was standard Perl exception" . (defined($EVAL_ERROR) ? ": ${EVAL_ERROR}" : '');
}

2
test/lib/pgBackRestTest/Env/ConfigEnvTest.pm
View File

@@ -158,7 +158,7 @@ sub configTestLoadExpect
$bErrorFound = true;
if (isException($oException))
if (isException(\$oException))
{
if ($oException->code() != $iExpectedError)
{

2
test/test.pl
View File

@@ -968,7 +968,7 @@ eval
or do
{
# If a backrest exception then return the code
exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
syswrite(*STDOUT, $EVAL_ERROR);

2
test/travis.pl
View File

@@ -181,7 +181,7 @@ eval
or do
{
# If a backrest exception then return the code
exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
print $EVAL_ERROR;