From: Maxim Dounin <mdounin@mdounin.ru>
Date: Mon, 6 Jul 2026 04:14:28 +0000 (+0300)
Subject: Perl: request object validation
X-Git-Tag: release-1.31.3~16
X-Git-Url: http://git.kaiwu.me/http/$%7BGITURL%7D/doc/static/gitweb.js?a=commitdiff_plain;h=cf94d5691a895994714efc288e07b3fec3af5089;p=nginx.git

Perl: request object validation

Previously, using stale request objects resulted in accesses to already
freed memory, causing segmentation faults:

    location /stale {
        perl 'sub {
            my $r = shift;
            $prev->log_error(0, "next request arrived") if $prev;
            $prev = $r;
            $r->send_http_header;
            return OK;
        }';
    }

Similarly, incorrectly blessed objects might cause segmentation faults,
such as in the following configuration:

    location /bless {
        perl 'sub {
            my $v = 10;
            my $r = bless \$v, "nginx";
            $r->send_http_header;
            return OK;
        }';
    }

With this change, active request object is recorded in the
ngx_http_perl_call_handler() function, and checked by
ngx_http_perl_set_request() to prevent use of unexpected request
objects.

Reported by Axel Mierczuk, Keith Hoodlet, 1Password’s Off-by-1 Labs.

Signed-off-by: Sergey Kandaurov <pluknet@nginx.com>
Origin: https://freenginx.org/hg/nginx/rev/86a2685756ae
---

diff --git a/src/http/modules/perl/nginx.xs b/src/http/modules/perl/nginx.xs
index 6acc4f8a0..af8549661 100644
--- a/src/http/modules/perl/nginx.xs
+++ b/src/http/modules/perl/nginx.xs
@@ -18,6 +18,9 @@
 #define ngx_http_perl_set_request(r, ctx)                                     \
                                                                               \
     ctx = INT2PTR(ngx_http_perl_ctx_t *, SvIV((SV *) SvRV(ST(0))));           \
+    if (ctx != ngx_http_perl_active_context || ctx == NULL) {                 \
+        croak("invalid request object");                                      \
+    }                                                                         \
     r = ctx->request
 
 
diff --git a/src/http/modules/perl/ngx_http_perl_module.c b/src/http/modules/perl/ngx_http_perl_module.c
index 946ddf846..300cd5e0a 100644
--- a/src/http/modules/perl/ngx_http_perl_module.c
+++ b/src/http/modules/perl/ngx_http_perl_module.c
@@ -148,6 +148,9 @@ static ngx_http_ssi_command_t  ngx_http_perl_ssi_command = {
 #endif
 
 
+ngx_http_perl_ctx_t     *ngx_http_perl_active_context;
+
+
 static ngx_str_t         ngx_null_name = ngx_null_string;
 static HV               *nginx_stash;
 
@@ -746,6 +749,8 @@ ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r,
 
     PUSHMARK(sp);
 
+    ngx_http_perl_active_context = ctx;
+
     sv = sv_2mortal(sv_bless(newRV_noinc(newSViv(PTR2IV(ctx))), nginx));
     XPUSHs(sv);
 
@@ -790,6 +795,8 @@ ngx_http_perl_call_handler(pTHX_ ngx_http_request_t *r,
     FREETMPS;
     LEAVE;
 
+    ngx_http_perl_active_context = NULL;
+
     if (ctx->error) {
 
         ngx_log_debug1(NGX_LOG_DEBUG_HTTP, c->log, 0,
diff --git a/src/http/modules/perl/ngx_http_perl_module.h b/src/http/modules/perl/ngx_http_perl_module.h
index 27eea9ada..2747389a9 100644
--- a/src/http/modules/perl/ngx_http_perl_module.h
+++ b/src/http/modules/perl/ngx_http_perl_module.h
@@ -59,6 +59,9 @@ typedef struct {
 extern ngx_module_t  ngx_http_perl_module;
 
 
+extern ngx_http_perl_ctx_t  *ngx_http_perl_active_context;
+
+
 /*
  * workaround for "unused variable `Perl___notused'" warning
  * when building with perl 5.6.1