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

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

src/http/modules/perl/nginx.xs

@@ -41,16 +41,6 @@ ngx_http_perl_sv2str(pTHX_ ngx_http_request_t *r, ngx_str_t *s, SV *sv)
     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;
@@ -65,6 +55,29 @@ ngx_http_perl_sv2str(pTHX_ ngx_http_request_t *r, ngx_str_t *s, SV *sv)
 }
 
 
+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);
 

src/http/modules/perl/ngx_http_perl_module.c

@@ -308,6 +308,29 @@ ngx_http_perl_sleep_handler(ngx_http_request_t *r)
 }
 
 
+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)

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_ */