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 6acc4f8a0427d53af4391cb6e13afe0645601c0a..af854966132b5a5b0e8907d943062c2b0fcc97ec 100644 (file)
--- 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 946ddf84671b063bbb81ef87ddea75f8f3a47028..300cd5e0a4b98b7f2f7fbc0d6cfa31c0484be525 100644 (file)
--- 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 27eea9adad8db51406334482b59ee3bef496463e..2747389a93063d30f1799ba3dd664a22635382fd 100644 (file)
--- 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