Correct Perl-expression: Failed to parse script

[bbon]

Hi, I have a correct perl-script, that nginx-unit can't run:

use strict;
use warnings;

use Plack;
use Plack::Builder;
use Plack::Request;
use HTTP::Status qw(:constants);

my $app = sub {
    my $env = shift;
    my $req = Plack::Request->new($env);

    my $res = $req->new_response(HTTP_OK);

    ##### see here #####
    # any modules, for example JSON
    my $class = 'JSON';
    eval "require $class";
    my $json = new $class(); # error
    #my $json = $class->new(); # success
    ##### end #####

    $res->body('ok');
    return $res->finalize();
};

my $main_app = builder {
    mount '/' => builder { $app };
};

Output from unit.log:

2024/10/10 18:03:11 [notice] 21515#21515 module: perl 5.36.0 "/usr/lib/unit/modules/perl.unit.so"
......
2024/10/10 19:03:53 [alert] 0#24073 [unit] PSGI: Failed to parse script: /home/bbon/www/test/test.psgi
syntax error at /home/bbon/www/test/test.psgi line 18, near "$class("
Type of arg 1 to Plack::Builder::builder must be block or sub {} (not reference constructor) at /home/bbon/www/test/test.psgi line 26, near "};"
Type of arg 1 to Plack::Builder::builder must be block or sub {} (not reference constructor) at /home/bbon/www/test/test.psgi line 27, near "};"

If I'll replace

my $json = new $class();

by (equivalent expression)

my $json = $class->new();

then - OK

--
OS: Debian 12 (amd64)
nginx-unit installed from:

deb-src [signed-by=/usr/share/keyrings/nginx-keyring.gpg] http://packages.nginx.org/unit/debian/ bookworm unit

[ac000]

Interesting...

In trying to create a minimal reproducer I've hacked up

/*
 * pi.c - Unit embedded Perl 'new' issue
 *
 * Compile to make it work
 *
 * cc -o pi pi.c -DSCRIPT=\"/path/to/script.pl\" `perl -MExtUtils::Embed -e ccopts -e ldopts`
 *
 * Compile to make it broken
 *
 * cc -o pi pi.c -DFUBAR -DSCRIPT=\"/path/to/script.pl\" `perl -MExtUtils::Embed -e ccopts -e ldopts`
 *
 * Run
 *
 * ./pi
 */

#include <EXTERN.h>
#include <stdio.h>
#include <stdlib.h>
#include <perl.h>

static PerlInterpreter *my_perl;

#define PREFIX \
	"package NGINX::Unit::Sandbox;" \
	"sub new {" \
	"   return bless {}, $_[0];" \
	"}" \
	"{my $app = do \""

#define SUFFIX \
	"\";" \
	"unless ($app) {" \
	"    if($@ || $1) {die $@ || $1}" \
	"    else {die \"File not found or compilation error.\"}" \
	"} " \
	"return $app}"

#if FUBAR
#define MODULE	(PREFIX SCRIPT SUFFIX)
#else
#define MODULE	("do \"" SCRIPT "\";")
#endif

EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);

static void xs_init(pTHX)
{
	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
}

int main(int argc, char *argv[], char *env[])
{
	int ret = EXIT_SUCCESS;
	char *embedding[] = { "", "-e", "0" };

	PERL_SYS_INIT3(&argc, &argv, &env);
	my_perl = perl_alloc();
	perl_construct(my_perl);
	PERL_SET_CONTEXT(my_perl);

	PL_exit_flags |= PERL_EXIT_DESTRUCT_END;

	perl_parse(my_perl, xs_init, 3, embedding, NULL);

	printf("executing :\n%s\n", MODULE);
	eval_pv(MODULE, FALSE);
	if (SvTRUE(ERRSV)) {
		fprintf(stderr,
			"eval_sv() has failed with :\n%s\nfor the code:\n%s\n",
			SvPVx_nolen(ERRSV), MODULE);
		ret = EXIT_FAILURE;
	}

	perl_destruct(my_perl);
	perl_free(my_perl);
	PERL_SYS_TERM();

	exit(ret);
 }

# new-test.pl                                                                   
                                                                                
use JSON;                                                                       
                                                                                
my $class = 'JSON';                                                             
my $json = new $class(); # error                                                
#my $json = $class->new(); # success                                            
                                                                                
printf("OK\n");

$ cc -o pi pi.c -DFUBAR -DSCRIPT=\"/home/andrew/src/perl/new-test.pl\" `perl -MExtUtils::Embed -e ccopts -e ldopts
$ ./pi 
executing :
package NGINX::Unit::Sandbox;sub new {   return bless {}, $_[0];}{my $app = do "/home/andrew/src/perl/new-test.pl";unless ($app) {    if($@ || $1) {die $@ || $1}    else {die "File not found or compilation error."}} return $app}
eval_sv() has failed with :
syntax error at /home/andrew/src/perl/new-test.pl line 4, near "$class("
Execution of /home/andrew/src/perl/new-test.pl aborted due to compilation errors.

for the code:
package NGINX::Unit::Sandbox;sub new {   return bless {}, $_[0];}{my $app = do "/home/andrew/src/perl/new-test.pl";unless ($app) {    if($@ || $1) {die $@ || $1}    else {die "File not found or compilation error."}} return $app}

$ cc -o pi pi.c -DSCRIPT=\"/home/andrew/src/perl/new-test.pl\" `perl -MExtUtils::Embed -e ccopts -e ldopts`
$ ./pi 
executing :
do "/home/andrew/src/perl/new-test.pl";
OK

The only obvious thing is the use of the new keyword in the PREFIX. Indeed, if we remove that sub {} bit altogether

I.e. run the following script

package NGINX::Unit::Sandbox;

	my $app = do "/home/andrew/src/perl/new-test.pl"; unless ($app) {
		if($@ || $1) {die $@ || $1}
		else {die "File not found or compilation error."}
	} return $app

It does somewhat run

$ perl ./borked.pl 
OK
Can't return outside a subroutine at ./borked.pl line 6.

From what I can tell the name for sub doesn't really matter, indeed if I change it from new to unit_new, your example now works.

I.e. with this patch to Unit

diff --git ./src/perl/nxt_perl_psgi.c ./src/perl/nxt_perl_psgi.c
index 271494ac..c2f59a25 100644
--- ./src/perl/nxt_perl_psgi.c
+++ ./src/perl/nxt_perl_psgi.c
@@ -409,7 +409,7 @@ nxt_perl_psgi_module_create(const char *script)
 
     static const nxt_str_t  prefix = nxt_string(
         "package NGINX::Unit::Sandbox;"
-        "sub new {"
+        "sub unit_new {"
         "   return bless {}, $_[0];"
         "}"
         "{my $app = do \""

$ curl localhost:8080
ok

[ac000]

Looking deeper into this.

+        "sub new {"
+        "   return bless {}, $_[0];"
+        "}"

Was added in commit 3b2c1d0

However I can' t see that this is actually used. If it's simply removed then things still seem to work and the Perl tests still pass (we have tests for delayed responses & streaming bodies).

...
test/test_perl_application.py::test_perl_streaming_body_multiple_responses[5.38.2] PASSED
...
test/test_perl_application.py::test_perl_delayed_response[5.38.2] PASSED
test/test_perl_application.py::test_perl_streaming_body[5.38.2] PASSED
...