Call Perl with built-in interpreter instead of execvp().

Exec'ing Perl worked fine but generated a very large command line in the process list and potentially exposed secrets.

build/lib/pgBackRestBuild/Config/Data.pm

@@ -191,8 +191,6 @@ use constant CFGOPT_SPOOL_PATH                                      => 'spool-pa
     push @EXPORT, qw(CFGOPT_SPOOL_PATH);
 
 # Perl
-use constant CFGOPT_PERL_BIN                                        => 'perl-bin';
-    push @EXPORT, qw(CFGOPT_PERL_BIN);
 use constant CFGOPT_PERL_OPTION                                     => 'perl-option';
     push @EXPORT, qw(CFGOPT_PERL_OPTION);
 
@@ -1103,29 +1101,6 @@ my %hConfigDefine =
         },
     },
 
-    &CFGOPT_PERL_BIN =>
-    {
-        &CFGDEF_SECTION => CFGDEF_SECTION_GLOBAL,
-        &CFGDEF_TYPE => CFGDEF_TYPE_STRING,
-        &CFGDEF_REQUIRED => false,
-        &CFGDEF_COMMAND =>
-        {
-            &CFGCMD_ARCHIVE_GET => {},
-            &CFGCMD_ARCHIVE_PUSH => {},
-            &CFGCMD_BACKUP => {},
-            &CFGCMD_CHECK => {},
-            &CFGCMD_EXPIRE => {},
-            &CFGCMD_INFO => {},
-            &CFGCMD_LOCAL => {},
-            &CFGCMD_REMOTE => {},
-            &CFGCMD_RESTORE => {},
-            &CFGCMD_STANZA_CREATE => {},
-            &CFGCMD_STANZA_UPGRADE => {},
-            &CFGCMD_START => {},
-            &CFGCMD_STOP => {},
-        },
-    },
-
     &CFGOPT_PERL_OPTION =>
     {
         &CFGDEF_SECTION => CFGDEF_SECTION_GLOBAL,

doc/xml/reference.xml

@@ -183,15 +183,6 @@
                         <example>/backup/db/spool</example>
                     </config-key>
 
-                    <!-- CONFIG - GENERAL SECTION - PERL-BIN -->
-                    <config-key id="perl-bin" name="Perl Binary">
-                        <summary>Path of Perl binary.</summary>
-
-                        <text>Path of the Perl binary if <file>/usr/bin/env perl</file> won't work.</text>
-
-                        <example>/usr/bin/perl</example>
-                    </config-key>
-
                     <!-- CONFIG - GENERAL SECTION - PROCESS-MAX -->
                     <config-key id="process-max" name="Process Maximum">
                         <summary>Max processes to use for compress/transfer.</summary>

doc/xml/release.xml

@@ -35,10 +35,6 @@
                         <p>Allow any non-command-line option to be reset to default on the command-line.  This allows options in <file>pgbackrest.conf</file> to be reset to default which reduces the need to write new configuration files for specific needs.</p>
                     </release-item>
 
-                    <release-item>
-                        <p>Add <br-option>perl-bin</br-option> option to specify the Perl binary location when <file>/usr/bin/env perl</file> won't work.</p>
-                    </release-item>
-
                     <release-item>
                         <p>The C library is now required. This eliminates conditional loading and eases development of new library features.</p>
                     </release-item>

doc/xml/user-guide.xml

@@ -411,8 +411,6 @@
                 <list-item>The deprecated <br-option>archive-max-mb</br-option> option is no longer valid.  This has been replaced with the <br-option>archive-queue-max</br-option> option which has different semantics.</list-item>
 
                 <list-item>The default for the <br-option>backup-user</br-option> option has changed from <id>backrest</id> to <id>pgbackrest</id>.</list-item>
-
-                <list-item>Perl is executed using <file>/usr/bin/env perl</file> instead of <file>/usr/bin/perl</file>.  The <br-option>perl-bin</br-option> option can be used to specify a perl binary if the default behavior is not working.</list-item>
             </list>
 
             <p>Many option names have changed to improve consistency although the old names from v1 are still accepted.  In general, <id>db-*</id> options have been renamed to <id>pg-*</id> and <id>backup-*</id> options have been renamed to <id>repo-*</id> when appropriate.</p>

libc/lib/pgBackRest/LibCAuto.pm

@@ -146,7 +146,6 @@ sub libcAutoExportTag
             'CFGOPT_NEUTRAL_UMASK',
             'CFGOPT_ONLINE',
             'CFGOPT_OUTPUT',
-            'CFGOPT_PERL_BIN',
             'CFGOPT_PERL_OPTION',
             'CFGOPT_PG_HOST',
             'CFGOPT_PG_HOST_CMD',

libc/xs/config/config.auto.xsh

@@ -60,7 +60,6 @@ Option constants
 #define CFGOPT_NEUTRAL_UMASK                                        cfgOptNeutralUmask
 #define CFGOPT_ONLINE                                               cfgOptOnline
 #define CFGOPT_OUTPUT                                               cfgOptOutput
-#define CFGOPT_PERL_BIN                                             cfgOptPerlBin
 #define CFGOPT_PERL_OPTION                                          cfgOptPerlOption
 #define CFGOPT_PG_HOST                                              cfgOptPgHost
 #define CFGOPT_PG_HOST_CMD                                          cfgOptPgHostCmd

src/Makefile

@@ -1,5 +1,7 @@
 CC=gcc
-CFLAGS=-I. -Wfatal-errors -Wall -Wextra -Wwrite-strings -Wno-clobbered -std=c99 -O2 -funroll-loops -ftree-vectorize
+CFLAGS=-I. -Wfatal-errors -Wall -Wextra -Wwrite-strings -Wno-clobbered -std=c99 -O2 -funroll-loops -ftree-vectorize \
+	`perl -MExtUtils::Embed -e ccopts`
+LDFLAGS=`perl -MExtUtils::Embed -e ldopts`
 DESTDIR=
 
 pgbackrest: \
@@ -57,7 +59,8 @@ pgbackrest: \
 		perl/exec.o \
 		storage/helper.o \
 		storage/storage.o \
-		main.o
+		main.o \
+		$(LDFLAGS)
 
 install: pgbackrest
 	sudo install -d $(DESTDIR)/usr/bin

src/command/archive/push/push.c

@@ -146,7 +146,7 @@ cmdArchivePush()
                         // Only want to see warnings and errors from async process
                         cfgOptionSet(cfgOptLogLevelConsole, cfgSourceParam, varNewStrZ("warn"));
 
-                        perlExec(perlCommand());
+                        perlExec();
                     }
                     // Wait for async process to exit (this should happen quickly) and report any errors
                     else

src/config/config.auto.c

@@ -343,14 +343,6 @@ static ConfigOptionData configOptionData[CFG_OPTION_TOTAL] = CONFIG_OPTION_LIST
         CONFIG_OPTION_DEFINE_ID(cfgDefOptOutput)
     )
 
-    //------------------------------------------------------------------------------------------------------------------------------
-    CONFIG_OPTION
-    (
-        CONFIG_OPTION_NAME("perl-bin")
-        CONFIG_OPTION_INDEX(0)
-        CONFIG_OPTION_DEFINE_ID(cfgDefOptPerlBin)
-    )
-
     //------------------------------------------------------------------------------------------------------------------------------
     CONFIG_OPTION
     (

src/config/config.auto.h

@@ -14,7 +14,7 @@ Command constants
 /***********************************************************************************************************************************
 Option constants
 ***********************************************************************************************************************************/
-#define CFG_OPTION_TOTAL                                            140
+#define CFG_OPTION_TOTAL                                            139
 
 /***********************************************************************************************************************************
 Command enum
@@ -76,17 +76,16 @@ typedef enum
     cfgOptNeutralUmask,
     cfgOptOnline,
     cfgOptOutput,
-    cfgOptPerlBin,
     cfgOptPerlOption,
     cfgOptPgHost,
-    cfgOptPgHostCmd =                                               41,
+    cfgOptPgHostCmd =                                               40,
-    cfgOptPgHostConfig =                                            49,
+    cfgOptPgHostConfig =                                            48,
-    cfgOptPgHostPort =                                              57,
+    cfgOptPgHostPort =                                              56,
-    cfgOptPgHostUser =                                              65,
+    cfgOptPgHostUser =                                              64,
-    cfgOptPgPath =                                                  73,
+    cfgOptPgPath =                                                  72,
-    cfgOptPgPort =                                                  81,
+    cfgOptPgPort =                                                  80,
-    cfgOptPgSocketPath =                                            89,
+    cfgOptPgSocketPath =                                            88,
-    cfgOptProcess =                                                 97,
+    cfgOptProcess =                                                 96,
     cfgOptProcessMax,
     cfgOptProtocolTimeout,
     cfgOptRecoveryOption,

src/config/define.auto.c

@@ -1569,43 +1569,6 @@ static ConfigDefineOptionData configDefineOptionData[] = CFGDEFDATA_OPTION_LIST
         )
     )
 
-    // -----------------------------------------------------------------------------------------------------------------------------
-    CFGDEFDATA_OPTION
-    (
-        CFGDEFDATA_OPTION_NAME("perl-bin")
-        CFGDEFDATA_OPTION_REQUIRED(false)
-        CFGDEFDATA_OPTION_SECTION(cfgDefSectionGlobal)
-        CFGDEFDATA_OPTION_TYPE(cfgDefOptTypeString)
-        CFGDEFDATA_OPTION_INTERNAL(false)
-
-        CFGDEFDATA_OPTION_INDEX_TOTAL(1)
-        CFGDEFDATA_OPTION_SECURE(false)
-
-        CFGDEFDATA_OPTION_HELP_SECTION("general")
-        CFGDEFDATA_OPTION_HELP_SUMMARY("Path of Perl binary.")
-        CFGDEFDATA_OPTION_HELP_DESCRIPTION
-        (
-            "Path of the Perl binary if /usr/bin/env perl won't work."
-        )
-
-        CFGDEFDATA_OPTION_COMMAND_LIST
-        (
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdArchiveGet)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdArchivePush)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdBackup)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdCheck)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdExpire)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdInfo)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdLocal)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdRemote)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdRestore)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdStanzaCreate)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdStanzaUpgrade)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdStart)
-            CFGDEFDATA_OPTION_COMMAND(cfgDefCmdStop)
-        )
-    )
-
     // -----------------------------------------------------------------------------------------------------------------------------
     CFGDEFDATA_OPTION
     (

src/config/define.auto.h

@@ -78,7 +78,6 @@ typedef enum
     cfgDefOptNeutralUmask,
     cfgDefOptOnline,
     cfgDefOptOutput,
-    cfgDefOptPerlBin,
     cfgDefOptPerlOption,
     cfgDefOptPgHost,
     cfgDefOptPgHostCmd,

src/config/parse.auto.c

@@ -385,18 +385,6 @@ static const struct option optionList[] =
         .val = PARSE_OPTION_FLAG | cfgOptOutput,
     },
 
-    // perl-bin option
-    // -----------------------------------------------------------------------------------------------------------------------------
-    {
-        .name = "perl-bin",
-        .has_arg = required_argument,
-        .val = PARSE_OPTION_FLAG | cfgOptPerlBin,
-    },
-    {
-        .name = "reset-perl-bin",
-        .val = PARSE_OPTION_FLAG | PARSE_RESET_FLAG | cfgOptPerlBin,
-    },
-
     // perl-option option
     // -----------------------------------------------------------------------------------------------------------------------------
     {

src/main.c

@@ -51,7 +51,7 @@ main(int argListSize, const char *argList[])
 
         // Execute Perl for commands not implemented in C
         // -------------------------------------------------------------------------------------------------------------------------
-        perlExec(perlCommand());
+        perlExec();
     }
     CATCH_ANY()
     {

src/perl/exec.c

@@ -14,73 +14,91 @@ Execute Perl for Legacy Functionality
 #include "config/config.h"
 #include "perl/config.h"
 
+#if __GNUC__ > 4 || (__GNUC__ == 4 &&  __GNUC_MINOR__ >= 8)
+    #define WARNING_PEDANTIC 1
+#endif
+
+#if WARNING_PEDANTIC
+    #pragma GCC diagnostic ignored "-Wpedantic"
+#endif
+
+#ifndef HAS_BOOL
+#  define HAS_BOOL 1
+#endif
+
+#include <EXTERN.h>
+#include <perl.h>
+
+#if WARNING_PEDANTIC
+    #pragma GCC diagnostic warning "-Wpedantic"
+#endif
+
 /***********************************************************************************************************************************
 Constants used to build perl options
 ***********************************************************************************************************************************/
-#define PERL_EXE                                                    "perl"
-#define ENV_EXE                                                     "/usr/bin/env"
-
-#define PARAM_PERL_OPTION                                           "perl-option"
-
 #define PGBACKREST_MODULE                                           PGBACKREST_NAME "::Main"
 #define PGBACKREST_MAIN                                             PGBACKREST_MODULE "::main"
 
 /***********************************************************************************************************************************
-Build list of perl options to use for exec
+Build list of parameters to use for perl main
 ***********************************************************************************************************************************/
-StringList *
+String *
-perlCommand()
+perlMain()
 {
-    // Begin arg list for perl exec
-    StringList *perlArgList = strLstNew();
-
-    // Use specific perl bin if passed
-    if (cfgOption(cfgOptPerlBin) != NULL)
-        strLstAdd(perlArgList, strDup(cfgOptionStr(cfgOptPerlBin)));
-    // Otherwise use env to find it
-    else
-    {
-        strLstAdd(perlArgList, strNew(ENV_EXE));
-        strLstAdd(perlArgList, strNew(PERL_EXE));
-    }
-
     // Add command arguments to pass to main
     String *commandParam = strNew("");
 
     for (unsigned int paramIdx = 0; paramIdx < strLstSize(cfgCommandParam()); paramIdx++)
         strCatFmt(commandParam, ",'%s'", strPtr(strLstGet(cfgCommandParam(), paramIdx)));
 
-    // Add Perl options
-    StringList *perlOptionList = strLstNewVarLst(cfgOptionLst(cfgOptPerlOption));
-
-    if (perlOptionList != NULL)
-        for (unsigned int argIdx = 0; argIdx < strLstSize(perlOptionList); argIdx++)
-            strLstAdd(perlArgList, strLstGet(perlOptionList, argIdx));
-
     // Construct Perl main call
     String *mainCall = strNewFmt(
         PGBACKREST_MAIN "('%s','%s','%s'%s)", strPtr(cfgExe()), cfgCommandName(cfgCommand()), strPtr(perlOptionJson()),
         strPtr(commandParam));
 
-    // End arg list for perl exec
+    return mainCall;
-    strLstAdd(perlArgList, strNew("-M" PGBACKREST_MODULE));
-    strLstAdd(perlArgList, strNew("-e"));
-    strLstAdd(perlArgList, mainCall);
-    strLstAdd(perlArgList, NULL);
-
-    return perlArgList;
 }
 
 /***********************************************************************************************************************************
-Exec supplied Perl options
+Init the dynaloader so other C modules can be loaded
+***********************************************************************************************************************************/
+EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
+
+static void xs_init(pTHX)
+{
+    const char *file = __FILE__;
+    dXSUB_SYS;
+    PERL_UNUSED_CONTEXT;
+
+    /* DynaLoader is a special case */
+    newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
+/***********************************************************************************************************************************
+Execute main function in Perl
 ***********************************************************************************************************************************/
 void
-perlExec(StringList *perlArgList)
+perlExec()
 {
-    // Exec perl with supplied arguments
+    // Initialize Perl with dummy args and environment
-    execvp(strPtr(strLstGet(perlArgList, 0)), (char **)strLstPtr(perlArgList));
+    int argc = 1;
+    const char *argv[1] = {strPtr(cfgExe())};
+    const char *env[1] = {NULL};
+    PERL_SYS_INIT3(&argc, (char ***)&argv, (char ***)&env);
 
-    // The previous command only returns on error so throw it
+    // Create the interpreter
-    int errNo = errno;
+    const char *embedding[] = {"", "-M"PGBACKREST_MODULE, "-e", "0"};
-    THROW(AssertError, "unable to exec %s: %s", strPtr(strLstGet(perlArgList, 0)), strerror(errNo));
+    PerlInterpreter *my_perl = perl_alloc();
+    perl_construct(my_perl);
+
+    // Don't let $0 assignment update the proctitle or embedding[0]
+    PL_origalen = 1;
+
+    // Start the interpreter
+    perl_parse(my_perl, xs_init, 3, (char **)embedding, NULL);
+    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+    perl_run(my_perl);
+
+    // Run perl main function
+    eval_pv(strPtr(perlMain()), TRUE);
 }                                                                   // {uncoverable - perlExec() does not return}

src/perl/exec.h

@@ -4,13 +4,9 @@ Execute Perl for Legacy Functionality
 #ifndef PERL_EXEC_H
 #define PERL_EXEC_H
 
-#include "common/type.h"
-
 /***********************************************************************************************************************************
 Functions
 ***********************************************************************************************************************************/
-String *perlOptionJson();
+void perlExec();
-StringList *perlCommand();
-void perlExec(StringList *perlArgList);
 
 #endif

test/expect/real-help-001.log

@@ -67,7 +67,6 @@ compress=n [default=3]
 [default=/etc/pgbackrest.conf]
   --lock-path               path where lock files are stored
 [default=/tmp/pgbackrest]
-  --perl-bin                path of Perl binary
   --protocol-timeout        protocol timeout [default=1830]
   --stanza                  defines the stanza [current=main]
 
@@ -164,7 +163,6 @@ compress=n [default=3]
 [default=/etc/pgbackrest.conf]
   --db-timeout              database query timeout [default=1800]
   --neutral-umask           use a neutral umask [default=y]
-  --perl-bin                path of Perl binary
   --protocol-timeout        protocol timeout [default=1830]
   --stanza                  defines the stanza
 

test/lib/pgBackRestTest/Common/ContainerTest.pm

@@ -334,7 +334,7 @@ sub containerBuild
                 "    yum -y update && \\\n" .
                 "    yum -y install openssh-server openssh-clients wget sudo python-pip build-essential valgrind git \\\n" .
                 "        perl perl-Digest-SHA perl-DBD-Pg perl-XML-LibXML perl-IO-Socket-SSL \\\n" .
-                "        gcc make perl-ExtUtils-MakeMaker perl-Test-Simple openssl-devel";
+                "        gcc make perl-ExtUtils-MakeMaker perl-Test-Simple openssl-devel perl-ExtUtils-Embed";
 
             if ($strOS eq VM_CO6)
             {
@@ -353,11 +353,11 @@ sub containerBuild
                 "    wget --no-check-certificate -O /root/get-pip.py https://bootstrap.pypa.io/get-pip.py && \\\n" .
                 "    python /root/get-pip.py && \\\n" .
                 "    apt-get -y install openssh-server wget sudo python-pip build-essential valgrind git \\\n" .
-                "        libdbd-pg-perl libhtml-parser-perl libio-socket-ssl-perl libxml-libxml-perl libssl-dev";
+                "        libdbd-pg-perl libhtml-parser-perl libio-socket-ssl-perl libxml-libxml-perl libssl-dev libperl-dev";
 
-            if ($strOS eq VM_U14)
+            if ($strOS eq VM_U12)
             {
-                $strScript .= ' libnet-daemon-perl libplrpc-perl';
+                $strScript .= ' libperl5.14';
             }
         }
 

test/lib/pgBackRestTest/Common/DefineTest.pm

@@ -406,6 +406,7 @@ my $oTestDef =
                     &TESTDEF_NAME => 'exec',
                     &TESTDEF_TOTAL => 2,
                     &TESTDEF_C => true,
+                    &TESTDEF_PERL_REQ => true,
 
                     &TESTDEF_COVERAGE =>
                     {
@@ -693,15 +694,15 @@ my $oTestDef =
                     {
                         'Archive/Push/Push' => TESTDEF_COVERAGE_FULL,
                         'Archive/Push/Async' => TESTDEF_COVERAGE_PARTIAL,
-                        'Archive/Push/File' => TESTDEF_COVERAGE_FULL,
+                        'Archive/Push/File' => TESTDEF_COVERAGE_PARTIAL,
                         'Protocol/Local/Master' => TESTDEF_COVERAGE_FULL,
-                        'Protocol/Local/Minion' => TESTDEF_COVERAGE_PARTIAL,
                     },
                 },
                 {
                     &TESTDEF_NAME => 'push',
                     &TESTDEF_TOTAL => 2,
                     &TESTDEF_C => true,
+                    &TESTDEF_PERL_REQ => true,
 
                     &TESTDEF_COVERAGE =>
                     {

test/lib/pgBackRestTest/Common/JobTest.pm

@@ -325,8 +325,10 @@ sub run
                     "CC=gcc\n" .
                     "CFLAGS=-I. -std=c99 -fPIC -g \\\n" .
                     "       -Werror -Wfatal-errors -Wall -Wextra -Wwrite-strings -Wno-clobbered" .
-                    ($self->{oTest}->{&TEST_VM} ne VM_CO6 && $self->{oTest}->{&TEST_VM} ne VM_U12 ? ' -Wpedantic' : '') . "\n" .
+                    ($self->{oTest}->{&TEST_VM} ne VM_CO6 && $self->{oTest}->{&TEST_VM} ne VM_U12 ? ' -Wpedantic' : '') . "\\\n" .
-                    "LDFLAGS=-lcrypto" . (vmCoverage($self->{oTest}->{&TEST_VM}) ? " -lgcov" : '') . "\n" .
+                    "       `perl -MExtUtils::Embed -e ccopts`\n" .
+                    "LDFLAGS=-lcrypto" . (vmCoverage($self->{oTest}->{&TEST_VM}) ? " -lgcov" : '') .
+                        " `perl -MExtUtils::Embed -e ldopts`\n" .
                     'TESTFLAGS=' . ($self->{oTest}->{&TEST_CDEF} ? "$self->{oTest}->{&TEST_CDEF}" : '') .
                     "\n" .
                     "\nSRCS=" . join(' ', @stryCFile) . "\n" .

test/src/module/archive/pushTest.c

@@ -85,8 +85,6 @@ testRun()
     // *****************************************************************************************************************************
     if (testBegin("cmdArchivePush()"))
     {
-        int processId = getpid();
-
         StringList *argList = strLstNew();
         strLstAddZ(argList, "pgbackrest");
         strLstAddZ(argList, "--archive-timeout=1");
@@ -104,11 +102,10 @@ testRun()
 
         // Test that a bogus perl bin generates the correct errors
         // -------------------------------------------------------------------------------------------------------------------------
-        String *perlBin = strNewFmt("%s/perl-test.sh", testPath());
-
-        strLstAdd(argList, strNewFmt("--perl-bin=%s", strPtr(perlBin)));
         strLstAdd(argList, strNewFmt("--spool-path=%s", testPath()));
         strLstAddZ(argList, "--archive-async");
+        strLstAddZ(argList, "--log-level-console=off");
+        strLstAddZ(argList, "--log-level-stderr=off");
         cfgLoad(strLstSize(argList), strLstPtr(argList));
         logInit(logLevelInfo, logLevelOff, false);
 
@@ -120,51 +117,38 @@ testRun()
         }
         CATCH_ANY()
         {
-            // Exit with error if this is the child process
-            if (getpid() != processId)
-                exit(errorCode());
-
             // Check expected error on the parent process
             TEST_RESULT_INT(errorCode(), errorTypeCode(&AssertError), "error code matches after failed Perl exec");
-            TEST_RESULT_STR(errorMessage(), "perl exited with error 25", "error message matches after failed Perl exec");
+            TEST_RESULT_STR(errorMessage(), "perl exited with error 37", "error message matches after failed Perl exec");
         }
         TRY_END();
 
-        // Write a blank script for the perl bin and make sure the process times out
+        // Make sure the process times out when there is nothing to archive
         // -------------------------------------------------------------------------------------------------------------------------
-        Storage *storage = storageNew(strNew(testPath()), 0750, 65536, NULL);
+        strLstAdd(argList, strNewFmt("--pg1-path=%s/db", testPath()));
-        storagePut(storage, perlBin, bufNewStr(strNew("")));
+        cfgLoad(strLstSize(argList), strLstPtr(argList));
+        logInit(logLevelInfo, logLevelOff, false);
 
         TEST_ERROR(
             cmdArchivePush(), ArchiveTimeoutError,
             "unable to push WAL segment '000000010000000100000001' asynchronously after 1 second(s)");
 
-        // Write out a bogus .error file to make sure it is ignored on the first loop.  The perl bin will write the real one when it
+        // Write out a bogus .error file to make sure it is ignored on the first loop
-        // executes.
         // -------------------------------------------------------------------------------------------------------------------------
         String *errorFile = storagePath(storageSpool(), strNew(STORAGE_SPOOL_ARCHIVE_OUT "/000000010000000100000001.error"));
 
         mkdir(strPtr(strNewFmt("%s/archive", testPath())), 0750);
         mkdir(strPtr(strNewFmt("%s/archive/db", testPath())), 0750);
         mkdir(strPtr(strNewFmt("%s/archive/db/out", testPath())), 0750);
-        storagePut(storageSpool(), errorFile, bufNewStr(strNew("")));
+        storagePut(storageSpool(), errorFile, bufNewStr(strNew("25\n" BOGUS_STR)));
 
-        storagePut(storage, perlBin, bufNewStr(strNewFmt(
+        TEST_ERROR(cmdArchivePush(), AssertError, BOGUS_STR);
-            "set -e\n"
-            "echo '25' > %s\n"
-            "echo 'generic error message' >> %s\n",
-            strPtr(errorFile), strPtr(errorFile))));
-
-        TEST_ERROR(cmdArchivePush(), AssertError, "generic error message");
 
         unlink(strPtr(errorFile));
 
-        // Modify script to write out a valid ok file
+        // Write out a valid ok file and test for success
         // -------------------------------------------------------------------------------------------------------------------------
-        storagePut(storage, perlBin, bufNewStr(strNewFmt(
+        storagePut(storageSpool(), strNew(STORAGE_SPOOL_ARCHIVE_OUT "/000000010000000100000001.ok"), bufNewStr(strNew("")));
-            "set -e\n"
-            "touch %s\n",
-            strPtr(storagePath(storageSpool(), strNew(STORAGE_SPOOL_ARCHIVE_OUT "/000000010000000100000001.ok"))))));
 
         TEST_RESULT_VOID(cmdArchivePush(), "successful push");
         testLogResult("P00   INFO: pushed WAL segment 000000010000000100000001 asynchronously");

test/src/module/help/helpTest.c

@@ -122,7 +122,6 @@ testRun()
             "  --lock-path               path where lock files are stored\n"
             "                            [default=/tmp/pgbackrest]\n"
             "  --neutral-umask           use a neutral umask [default=y]\n"
-            "  --perl-bin                path of Perl binary\n"
             "  --process-max             max processes to use for compress/transfer\n"
             "                            [default=1]\n"
             "  --protocol-timeout        protocol timeout [default=1830]\n"
@@ -230,19 +229,20 @@ testRun()
 
         // -------------------------------------------------------------------------------------------------------------------------
         optionHelp = strPtr(strNewFmt(
-            "%s - 'archive-push' command - 'perl-bin' option help\n"
+            "%s - 'archive-push' command - 'repo1-s3-host' option help\n"
             "\n"
-            "Path of Perl binary.\n"
+            "S3 repository host.\n"
             "\n"
-            "Path of the Perl binary if /usr/bin/env perl won't work.\n",
+            "Connect to a host other than the end point. This is typically used for testing.\n",
             helpVersion));
 
         argList = strLstNew();
         strLstAddZ(argList, "/path/to/pgbackrest");
         strLstAddZ(argList, "help");
         strLstAddZ(argList, "archive-push");
-        strLstAddZ(argList, "perl-bin");
+        strLstAddZ(argList, "repo1-s3-host");
-        TEST_RESULT_VOID(configParse(strLstSize(argList), strLstPtr(argList)), "help for archive-push command, perl-bin option");
+        TEST_RESULT_VOID(
+            configParse(strLstSize(argList), strLstPtr(argList)), "help for archive-push command, repo1-s3-host option");
         TEST_RESULT_STR(strPtr(helpRender()), optionHelp, "    check text");
 
         // -------------------------------------------------------------------------------------------------------------------------

test/src/module/perl/execTest.c

@@ -13,19 +13,15 @@ testRun()
     // -----------------------------------------------------------------------------------------------------------------------------
     if (testBegin("perlMain()"))
     {
+        // -------------------------------------------------------------------------------------------------------------------------
         cfgInit();
         cfgCommandSet(cfgCmdInfo);
         cfgExeSet(strNew("/path/to/pgbackrest"));
-        cfgOptionSet(cfgOptPerlBin, cfgSourceParam, varNewStrZ("/usr/bin/perl"));
 
         TEST_RESULT_STR(
-            strPtr(strLstJoin(perlCommand(), "|")),
+            strPtr(perlMain()), "pgBackRest::Main::main('/path/to/pgbackrest','info','{}')", "command with no options");
-            "/usr/bin/perl|-MpgBackRest::Main|-e|pgBackRest::Main::main('/path/to/pgbackrest','info','{}')|[NULL]",
-            "custom command with no options");
 
         // -------------------------------------------------------------------------------------------------------------------------
-        cfgOptionSet(cfgOptPerlBin, cfgSourceParam, NULL);
-
         cfgOptionValidSet(cfgOptCompress, true);
         cfgOptionSet(cfgOptCompress, cfgSourceParam, varNewBool(true));
 
@@ -34,27 +30,39 @@ testRun()
         strLstAdd(commandParamList, strNew("B"));
         cfgCommandParamSet(commandParamList);
 
-        cfgOptionValidSet(cfgOptPerlOption, true);
-        StringList *perlList = strLstNew();
-        strLstAdd(perlList, strNew("-I."));
-        strLstAdd(perlList, strNew("-MDevel::Cover=-silent,1"));
-        cfgOptionSet(cfgOptPerlOption, cfgSourceParam, varNewVarLst(varLstNewStrLst(perlList)));
-
         TEST_RESULT_STR(
-            strPtr(strLstJoin(perlCommand(), "|")),
+            strPtr(perlMain()),
-            "/usr/bin/env|perl|-I.|-MDevel::Cover=-silent,1|-MpgBackRest::Main|-e|pgBackRest::Main::main("
+            "pgBackRest::Main::main('/path/to/pgbackrest','info','{\"compress\":{\"source\":\"param\",\"value\":true}}','A','B')",
-            "'/path/to/pgbackrest','info','{"
-            "\"compress\":{\"source\":\"param\",\"value\":true},"
-            "\"perl-option\":{\"source\":\"param\",\"value\":{\"-I.\":true,\"-MDevel::Cover=-silent,1\":true}}"
-            "}','A','B')|[NULL]",
             "command with one option and params");
     }
 
     // -----------------------------------------------------------------------------------------------------------------------------
     if (testBegin("perlExec()"))
     {
-        StringList *param = strLstAdd(strLstAdd(strLstNew(), strNew(BOGUS_STR)), NULL);
+        StringList *argList = strLstNew();
+        strLstAdd(argList, strNew("pgbackrest"));
+        strLstAdd(argList, strNew("--stanza=db"));
+        strLstAdd(argList, strNew("--log-level-console=off"));
+        strLstAdd(argList, strNew("--log-level-stderr=off"));
+        strLstAdd(argList, strNew("archive-push"));
 
-        TEST_ERROR(perlExec(param), AssertError, "unable to exec BOGUS: No such file or directory");
+        TEST_RESULT_VOID(cfgLoad(strLstSize(argList), strLstPtr(argList)), "load archive-push config");
+
+        int processId = 0;
+
+        if ((processId = fork()) == 0)
+        {
+            perlExec();
+        }
+        // Wait for async process to exit (this should happen quickly) and report any errors
+        else
+        {
+            int processStatus;
+
+            THROW_ON_SYS_ERROR(
+                waitpid(processId, &processStatus, 0) != processId, AssertError, "unable to find perl child process");
+
+            TEST_RESULT_INT(WEXITSTATUS(processStatus), errorTypeCode(&ParamRequiredError), "check error code");
+        }
     }
 }

test/src/valgrind.suppress

@@ -4,3 +4,15 @@
     ...
     obj:*/libcrypto.so*
 }
+{
+    ignore_libperl_leaks
+    Memcheck:Leak
+    ...
+    obj:*/libperl.so*
+}
+{
+    ignore_libperl_uninit_cond_jump
+    Memcheck:Cond
+    ...
+    obj:*/libperl.so*
+}