From 5d338cfb3ac12c9bc5d5a3bd5f8bbffde4c03363 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?=
 <avarab@gmail.com>
Date: Mon, 10 Nov 2014 18:53:10 +0000
Subject: [PATCH] psgi: Ensure that we call any DESTROY hooks on
 psgix.harakiri.commit

Before this we'd just exit(0) and let the OS clean up after us, but
e.g. with post-buffering=1 we'll end up with a temporary file in /tmp
that we won't clean up when we exit unless DESTROY is called.

This resulted in us leaking files in /tmp if we ever had a request where
the last request before a harakiri was a POST request with a body we'd
buffer to /tmp.

We'd have similar leaks in any user-defined code that required DESTROY
to run.

Aside from this I'm still not very comfortable with what this whole code
here in psgi_plugin.c and psgi_loader.c is doing when managing the
interpreter(s). It:

 * Doesn't consistently call PERL_SET_CONTEXT() as described in "perldoc
   perlembed".

 * Nothing calls PERL_SYS_TERM() either.

 * Should we be calling uwsgi_perl_free_stashes() here too?

To test this:

    UWSGI_PROFILE=psgi python uwsgiconfig.py --build
    ./uwsgi --master --http-socket localhost:1234 --psgi t/perl/test_harakiri.psgi

Then elsewhere:

    curl 'localhost:1234?0'
    curl 'localhost:1234?1'

Both of those should emit "Calling DESTROY".
---
 plugins/psgi/psgi_plugin.c | 17 +++++++++++++++++
 t/perl/test_harakiri.psgi  | 19 +++++++++++++++++++
 2 files changed, 36 insertions(+)
 create mode 100644 t/perl/test_harakiri.psgi

diff --git a/plugins/psgi/psgi_plugin.c b/plugins/psgi/psgi_plugin.c
index 7b39bf7c..a6da23ac 100644
--- a/plugins/psgi/psgi_plugin.c
+++ b/plugins/psgi/psgi_plugin.c
@@ -663,7 +663,24 @@ void uwsgi_perl_after_request(struct wsgi_request *wsgi_req) {
 
 	// async plagued could be defined in other areas...
 	if (wsgi_req->async_plagued) {
+		int i;
+
 		uwsgi_log("*** psgix.harakiri.commit requested ***\n");
+
+		// clear the env, make sure any DESTROY attached to it will
+		// run.
+		SvREFCNT_dec(wsgi_req->async_environ);
+
+		// We must free our perl context(s) so any DESTROY hooks
+		// etc. will run.
+		for(i=0;i<uwsgi.threads;i++) {
+			perl_destruct(uperl.main[i]);
+			perl_free(uperl.main[i]);
+		}
+		free(uperl.main);
+
+		// This will call simple_goodbye_cruel_world() which'll
+		// exit(0). So we won't run anything below.
 		goodbye_cruel_world();
 	}
 
diff --git a/t/perl/test_harakiri.psgi b/t/perl/test_harakiri.psgi
new file mode 100644
index 00000000..7680944a
--- /dev/null
+++ b/t/perl/test_harakiri.psgi
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+{
+    package psgix::harakiri::tester;
+    sub DESTROY { print STDERR "$$: Calling DESTROY\n" }
+}
+
+sub {
+    my $env = shift;
+
+    die "PANIC: We should support psgix.harakiri here" unless $env->{'psgix.harakiri'};
+
+    $env->{'psgix.harakiri.tester'} = bless {} => 'psgix::harakiri::tester';
+    my $harakiri = $env->{QUERY_STRING};
+    $env->{'psgix.harakiri.commit'} = $harakiri ? 1 : 0;
+
+    return [200, [], [ $harakiri ? "We are about to destroy ourselves\n" : "We will live for another request\n" ]];
+}