[nginx] Perl: removed zero copy of scalars in $r->print().

[Maxim Dounin]

details:   http://freenginx.org/hg/nginx/rev/629f14fee33e
branches:  
changeset: 9583:629f14fee33e
user:      Maxim Dounin <mdounin at mdounin.ru>
date:      Fri Aug 14 09:10:44 2026 +0300
description:
Perl: removed zero copy of scalars in $r->print().

In 9569:7a3dbb7905ad, zero copying of arbitrary single SV values was
introduced along with reference counting.  It turns out it was an
incorrect change though, since non-read-only scalars can be changed
after the $r->print() call while the buffer is still needed, leading to
corrupted output, such as in the following example:

    location / {
        perl 'sub {
            my $r = shift;
            $r->send_http_header;
            my $foo = "it";
            $foo .= " works";
            $r->print($foo);
            $foo = " changed";
            $r->print($foo);
            return OK;
        }';
    }

Further, checking SvREADONLY() as it was done previously also seems to
be incorrect in some edge cases, and might lead to similar issues.  In
particular, SvREADONLY() can be set and cleared directly by Perl code
with Internals::SvREADONLY():

    location / {
        perl 'sub {
            my $r = shift;
            $r->send_http_header;
            my $foo = "it";
            $foo .= " works";
            Internals::SvREADONLY($foo, 1);
            $r->print($foo);
            Internals::SvREADONLY($foo, 0);
            $foo = " changed";
            $r->print($foo);
            return OK;
        }';
    }

The fix is to remove the zero copy optimization in $r->print()
completely, similarly to how it was done in ngx_http_perl_sv2str() in
9569:7a3dbb7905ad.

An alternative approach would be to create a private copy-on-write SV,
thus preserving the buffer until the SV is destroyed, but Perl as of now
provides no documented interfaces to create copy-on-write SVs from XS
code.

See also:
https://github.com/nginx/nginx/commit/5e0deb7018b06cdebafab5570b2e9fdf7c3f22de

diffstat:

 src/http/modules/perl/nginx.xs |  47 ------------------------------------------
 1 files changed, 0 insertions(+), 47 deletions(-)

diffs (64 lines):

diff --git a/src/http/modules/perl/nginx.xs b/src/http/modules/perl/nginx.xs
--- a/src/http/modules/perl/nginx.xs
+++ b/src/http/modules/perl/nginx.xs
@@ -689,51 +689,6 @@ print(r, ...)
         croak("print(): header not sent");
     }
 
-    if (items == 2) {
-
-        /*
-         * do zero copy for prolate single SV:
-         *     $r->print("some text\n");
-         */
-
-        sv = ST(1);
-
-        if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PV) {
-            sv = SvRV(sv);
-        }
-
-        if (SvPOK(sv)) {
-
-            p = (u_char *) SvPV(sv, len);
-
-            if (len == 0) {
-                XSRETURN_EMPTY;
-            }
-
-            if (ngx_http_perl_refcount(aTHX_ r, sv) != NGX_OK) {
-                ctx->error = 1;
-                croak("ngx_http_perl_refcount() failed");
-            }
-
-            b = ngx_calloc_buf(r->pool);
-            if (b == NULL) {
-                ctx->error = 1;
-                croak("ngx_calloc_buf() failed");
-            }
-
-            b->memory = 1;
-            b->pos = p;
-            b->last = p + len;
-            b->start = p;
-            b->end = b->last;
-
-            ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
-                           "$r->print: single SV: %z", len);
-
-            goto out;
-        }
-    }
-
     size = 0;
 
     for (i = 1; i < items; i++) {
@@ -773,8 +728,6 @@ print(r, ...)
         b->last = ngx_cpymem(b->last, p, len);
     }
 
-    out:
-
     rc = ngx_http_perl_output(r, ctx, b);
 
     if (rc == NGX_ERROR) {