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

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
 
 

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,

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