 @@ -50,4 +50,29 @@ sub mock_dbh {
      return $context;
  }
- 
+
 +package t::lib::Mocks::Mock;
 +use Data::Dumper;
 +

+}
+
 1;
From 8981e911aedb4310913a8c1e403a9369766df6dd Mon Sep 17 00:00:00 2001
From: Francesco Rivetti <oha@oha.it>
Date: Mon, 27 Mar 2017 14:46:11 +0200
Subject: [PATCH 1/3] cgi->redir emulation

---
 Koha/Middleware/App.pm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/Koha/Middleware/App.pm b/Koha/Middleware/App.pm
index 359be67..298edca 100644
--- a/Koha/Middleware/App.pm
+++ b/Koha/Middleware/App.pm
@@ -130,6 +130,8 @@ sub cgi_emulation {
         return [$code => [] => [$err]];
     }
 
+    $code = 307 if $headers->{Location} and $code < 300;
+
     return [$code => [%$headers] => [$out]];
 
 }

From 258308388f2e0a06ec862d7c4c9e8ca8f2c8b35c Mon Sep 17 00:00:00 2001
From: Francesco Rivetti <oha@oha.it>
Date: Mon, 27 Mar 2017 14:59:38 +0200
Subject: [PATCH 2/3] trap exit() from CGI

---
 Koha/Middleware/App.pm | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/Koha/Middleware/App.pm b/Koha/Middleware/App.pm
index 298edca..8b777b6 100644
--- a/Koha/Middleware/App.pm
+++ b/Koha/Middleware/App.pm
@@ -72,6 +72,14 @@ sub cgi_subprocess {
     my $out;
     local *STDOUT;
     open STDOUT, '>', \$out or die "can't redirect stdout: $!";
+    warn "exec $file";
+
+    no warnings 'redefine';
+    local *CORE::GLOBAL::exit = sub (;$) {
+        warn "CHILD[$$] exiting";
+        return $out, $headers;
+    };
+
     require $file;
     return $out, $headers;
 }

From d5c7c8c7a49e948e9bd7413443f45618fca5c657 Mon Sep 17 00:00:00 2001
From: Francesco Rivetti <oha@oha.it>
Date: Mon, 27 Mar 2017 15:38:03 +0200
Subject: [PATCH 3/3] better handling of script exit()

---
 Koha/Middleware/App.pm | 47 +++++++++++++++++++++++++----------------------
 1 file changed, 25 insertions(+), 22 deletions(-)

diff --git a/Koha/Middleware/App.pm b/Koha/Middleware/App.pm
index 8b777b6..38585d9 100644
--- a/Koha/Middleware/App.pm
+++ b/Koha/Middleware/App.pm
@@ -7,16 +7,14 @@ use Data::Dumper;
 use IO::Pipe;
 use JSON; our $JSON = JSON->new()->utf8(1);
 
+our ($out, $headers, $err);
+
 sub cgi_subprocess {
     my ($self, $env, $file) = @_;
     my $session = $env->{SESSION};
     my $req     = Plack::Request->new($env);
-    my $headers = {};
-    no warnings;
 
-    local *::exit = sub {
-        die "EXIT?";
-    };
+    no warnings;
     local *CGI::new = sub {
         return Koha::Middleware::Session::Mock->new(
             param => sub {
@@ -69,19 +67,11 @@ sub cgi_subprocess {
     };
     use warnings;
 
-    my $out;
     local *STDOUT;
     open STDOUT, '>', \$out or die "can't redirect stdout: $!";
     warn "exec $file";
 
-    no warnings 'redefine';
-    local *CORE::GLOBAL::exit = sub (;$) {
-        warn "CHILD[$$] exiting";
-        return $out, $headers;
-    };
-
     require $file;
-    return $out, $headers;
 }
 
 sub slurp($) {
@@ -98,19 +88,31 @@ sub cgi_emulation {
 
     if (0==$pid) { # CHILD
         $pipe->writer;
-        eval {
-            my ($out, $headers, $err);
+
+        # scripts might exit(), and there is no way to prevent that without changing the script behavior
+        # so instead, let it exit, but first send the data back to the parent
+        # (note: this might now work with END {} blocks)
+        local $out = '';
+        local $headers = {};
+        local $err;
+        no warnings;
+        local *CORE::GLOBAL::exit = sub {
             eval {
-                ($out, $headers) =
-                    $self->cgi_subprocess($env, $file);
+                $pipe->print($JSON->encode([$out, $headers, $err]));
+                $pipe->close;
                 1;
-            } or $err = "$@";
-
-            $pipe->print($JSON->encode([$out, $headers, $err]));
+            } or warn $@;
+            CORE::exit($_[0]//0);
+        };
+        use warnings;
 
-            $pipe->close;
+        eval {
+            $self->cgi_subprocess($env, $file);
+            1;
+        } or do {
+            $err = "$@";
+            warn $@;
         };
-        #warn "CHILD[$$] exit";
         exit;
     }
 
@@ -128,6 +130,7 @@ sub cgi_emulation {
         }
         waitpid($pid, 0);
     }
+
     #warn "decoding($data)";
     my ($out, $headers, $err) = @{ $JSON->decode($data) };
 

+++ b/C4/Auth.pm
@@ -155,6 +155,9 @@ Output.pm module.
 =cut

 sub get_template_and_user {
+    _get_template_and_user(@_);
+}
+sub _get_template_and_user {

     my $in = shift;
     my ( $user, $cookie, $sessionID, $flags );
@@ -1592,6 +1595,9 @@ Possible return values in C<$status> are:
 =cut

 sub check_cookie_auth {
+    _check_cookie_auth(@_);
+}
