[nginx] Perl: introduced reference counting for perl scalars.
Maxim Dounin
mdounin at mdounin.ru
Fri Jun 26 19:35:43 UTC 2026
details: http://freenginx.org/hg/nginx/rev/7a3dbb7905ad
branches:
changeset: 9569:7a3dbb7905ad
user: Maxim Dounin <mdounin at mdounin.ru>
date: Fri Jun 26 22:23:28 2026 +0300
description:
Perl: introduced reference counting for perl scalars.
Perl scalars might have a limited lifetime, and using them without
appropriate reference counting is incorrect. In particular, heap
use-after-free was observed in the following configuration (note the
"eval", which limits lifetime of the string being printed), which
demonstrates that the previously used SvREADONLY() optimizations are
incorrect:
location / {
perl 'sub {
my $r = shift;
$r->send_http_header;
eval q!$r->print("it works")!;
return OK;
}';
}
Similarly, errors were observed with handlers in $r->sleep() and
$r->has_request_body() when a handler comes from an eval, such as in the
following configuration:
location / {
perl 'sub {
my $r = shift;
$r->sleep(100, eval q!sub {
my $r = shift;
$r->send_http_header;
$r->print("it works");
return OK;
}!);
return OK;
}';
}
Accordingly, the SvREADONLY() optimization was removed in
ngx_http_perl_sv2str(), since it is expected to be used for small
strings, and using proper reference counting likely will be more costly
than just copying the string. In $r->print(), $r->sleep(), and
$r->has_request_body() proper reference counting was implemented, with
decrement operations being performed by pool cleanup handlers.
As a positive side effect, $r->print() can now avoid copying any single
scalar, not just read-only scalars.
Reported by Evan Hellman,
https://github.com/freenginx/nginx/issues/26
diffstat:
src/http/modules/perl/nginx.xs | 56 +++++++++++++++++++++------
src/http/modules/perl/ngx_http_perl_module.c | 23 +++++++++++
src/http/modules/perl/ngx_http_perl_module.h | 7 +++
3 files changed, 73 insertions(+), 13 deletions(-)
diffs (172 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
@@ -41,16 +41,6 @@ ngx_http_perl_sv2str(pTHX_ ngx_http_requ
p = (u_char *) SvPV(sv, len);
s->len = len;
-
- if (SvREADONLY(sv) && SvPOK(sv)) {
- s->data = p;
-
- ngx_log_debug2(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
- "perl sv2str: %08XD \"%V\"", sv->sv_flags, s);
-
- return NGX_OK;
- }
-
s->data = ngx_pnalloc(r->pool, len);
if (s->data == NULL) {
return NGX_ERROR;
@@ -66,6 +56,29 @@ ngx_http_perl_sv2str(pTHX_ ngx_http_requ
static ngx_int_t
+ngx_http_perl_refcount(pTHX_ ngx_http_request_t *r, SV *sv)
+{
+ ngx_pool_cleanup_t *cln;
+ ngx_http_perl_cleanup_t *clnp;
+
+ cln = ngx_pool_cleanup_add(r->pool, sizeof(ngx_http_perl_cleanup_t));
+ if (cln == NULL) {
+ return NGX_ERROR;
+ }
+
+ cln->handler = ngx_http_perl_refcount_cleanup;
+
+ clnp = cln->data;
+ clnp->request = r;
+ clnp->sv = sv;
+
+ SvREFCNT_inc(sv);
+
+ return NGX_OK;
+}
+
+
+static ngx_int_t
ngx_http_perl_output(ngx_http_request_t *r, ngx_http_perl_ctx_t *ctx,
ngx_buf_t *b)
{
@@ -420,6 +433,12 @@ has_request_body(r, next)
ctx->next = SvRV(next);
+ if (ngx_http_perl_refcount(aTHX_ r, ctx->next) != NGX_OK) {
+ ctx->error = 1;
+ ctx->next = NULL;
+ croak("ngx_http_perl_refcount() failed");
+ }
+
r->request_body_in_single_buf = 1;
r->request_body_in_persistent_file = 1;
r->request_body_in_clean_file = 1;
@@ -670,7 +689,7 @@ print(r, ...)
if (items == 2) {
/*
- * do zero copy for prolate single read-only SV:
+ * do zero copy for prolate single SV:
* $r->print("some text\n");
*/
@@ -680,7 +699,7 @@ print(r, ...)
sv = SvRV(sv);
}
- if (SvREADONLY(sv) && SvPOK(sv)) {
+ if (SvPOK(sv)) {
p = (u_char *) SvPV(sv, len);
@@ -688,6 +707,11 @@ print(r, ...)
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;
@@ -701,7 +725,7 @@ print(r, ...)
b->end = b->last;
ngx_log_debug1(NGX_LOG_DEBUG_HTTP, r->connection->log, 0,
- "$r->print: read-only SV: %z", len);
+ "$r->print: single SV: %z", len);
goto out;
}
@@ -1162,6 +1186,12 @@ sleep(r, sleep, next)
ctx->next = SvRV(next);
+ if (ngx_http_perl_refcount(aTHX_ r, ctx->next) != NGX_OK) {
+ ctx->error = 1;
+ ctx->next = NULL;
+ croak("ngx_http_perl_refcount() failed");
+ }
+
r->connection->write->delayed = 1;
ngx_add_timer(r->connection->write, sleep);
diff --git a/src/http/modules/perl/ngx_http_perl_module.c b/src/http/modules/perl/ngx_http_perl_module.c
--- a/src/http/modules/perl/ngx_http_perl_module.c
+++ b/src/http/modules/perl/ngx_http_perl_module.c
@@ -308,6 +308,29 @@ ngx_http_perl_sleep_handler(ngx_http_req
}
+void
+ngx_http_perl_refcount_cleanup(void *data)
+{
+ ngx_http_perl_cleanup_t *clnp = data;
+
+ ngx_http_request_t *r;
+ ngx_http_perl_main_conf_t *pmcf;
+
+ r = clnp->request;
+ pmcf = ngx_http_get_module_main_conf(r, ngx_http_perl_module);
+
+ {
+
+ dTHXa(pmcf->perl);
+ PERL_SET_CONTEXT(pmcf->perl);
+ PERL_SET_INTERP(pmcf->perl);
+
+ SvREFCNT_dec(clnp->sv);
+
+ }
+}
+
+
static ngx_int_t
ngx_http_perl_variable(ngx_http_request_t *r, ngx_http_variable_value_t *v,
uintptr_t data)
diff --git a/src/http/modules/perl/ngx_http_perl_module.h b/src/http/modules/perl/ngx_http_perl_module.h
--- a/src/http/modules/perl/ngx_http_perl_module.h
+++ b/src/http/modules/perl/ngx_http_perl_module.h
@@ -50,6 +50,12 @@ typedef struct {
} ngx_http_perl_var_t;
+typedef struct {
+ ngx_http_request_t *request;
+ SV *sv;
+} ngx_http_perl_cleanup_t;
+
+
extern ngx_module_t ngx_http_perl_module;
@@ -68,6 +74,7 @@ extern void boot_DynaLoader(pTHX_ CV* cv
void ngx_http_perl_handle_request(ngx_http_request_t *r);
void ngx_http_perl_sleep_handler(ngx_http_request_t *r);
+void ngx_http_perl_refcount_cleanup(void *data);
#endif /* _NGX_HTTP_PERL_MODULE_H_INCLUDED_ */
More information about the nginx-devel
mailing list