From 0b80172a494e4460881ae12d7c7be704e026357d Mon Sep 17 00:00:00 2001
From: Martin Renvoize <martin.renvoize@ptfs-europe.com>
Date: Mon, 28 Mar 2022 10:23:58 +0100
Subject: [PATCH] Bug 29744: Harmonize psgi/plack detection methods

This patch updates and moves the existing psgi_env method out of Auth
and into Context and then replaces any manual references of the same
code to use the new method.

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Signed-off-by: David Cook <dcook@prosentient.com.au>

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
---
 C4/Auth.pm                 | 12 ++++++------
 C4/Auth_with_shibboleth.pm |  6 +++---
 C4/Context.pm              | 14 ++++----------
 Koha/AuthUtils.pm          |  4 +---
 about.pl                   |  2 +-
 5 files changed, 15 insertions(+), 23 deletions(-)

diff --git a/C4/Auth.pm b/C4/Auth.pm
index bb80264e45..fae37b97dc 100644
--- a/C4/Auth.pm
+++ b/C4/Auth.pm
@@ -55,14 +55,14 @@ use Koha::CookieManager;
 
 use vars qw($ldap $cas $caslogout);
 our (@ISA, @EXPORT_OK);
-BEGIN {
-    sub psgi_env { any { /^psgi\./ } keys %ENV }
 
-    sub safe_exit {
-        if   (psgi_env) { die 'psgi:exit' }
-        else            { exit }
-    }
+sub safe_exit {
+    if   (C4::Context::psgi_env) { die 'psgi:exit' }
+    else            { exit }
+}
 
+
+BEGIN {
     C4::Context->set_remote_address;
 
     require Exporter;
diff --git a/C4/Auth_with_shibboleth.pm b/C4/Auth_with_shibboleth.pm
index e214a5307c..1eb14edc67 100644
--- a/C4/Auth_with_shibboleth.pm
+++ b/C4/Auth_with_shibboleth.pm
@@ -81,7 +81,7 @@ sub get_login_shib {
 
     my $matchAttribute = $config->{mapping}->{ $config->{matchpoint} }->{is};
 
-    if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
+    if ( C4::Context::psgi_env ) {
       return $ENV{"HTTP_".uc($matchAttribute)} || '';
     } else {
       return $ENV{$matchAttribute} || '';
@@ -126,7 +126,7 @@ sub _autocreate {
     my %borrower = ( $config->{matchpoint} => $match );
 
     while ( my ( $key, $entry ) = each %{$config->{'mapping'}} ) {
-        if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
+        if ( C4::Context::psgi_env ) {
             $borrower{$key} = ( $entry->{'is'} && $ENV{"HTTP_" . uc($entry->{'is'}) } ) || $entry->{'content'} || '';
         } else {
             $borrower{$key} = ( $entry->{'is'} && $ENV{ $entry->{'is'} } ) || $entry->{'content'} || '';
@@ -144,7 +144,7 @@ sub _sync {
     my %borrower;
     $borrower{'borrowernumber'} = $borrowernumber;
     while ( my ( $key, $entry ) = each %{$config->{'mapping'}} ) {
-        if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
+        if ( C4::Context::psgi_env ) {
             $borrower{$key} = ( $entry->{'is'} && $ENV{"HTTP_" . uc($entry->{'is'}) } ) || $entry->{'content'} || '';
         } else {
             $borrower{$key} = ( $entry->{'is'} && $ENV{ $entry->{'is'} } ) || $entry->{'content'} || '';
diff --git a/C4/Context.pm b/C4/Context.pm
index 654414de3c..823f8cb89c 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -999,21 +999,15 @@ sub needs_install {
     return ($self->preference('Version')) ? 0 : 1;
 }
 
-=head3 is_psgi_or_plack
+=head3 psgi_env
 
-is_psgi_or_plack returns true if there is an environmental variable
+psgi_env returns true if there is an environmental variable
 prefixed with "psgi" or "plack". This is useful for detecting whether
 this is a PSGI app or a CGI app, and implementing code as appropriate.
 
 =cut
 
-sub is_psgi_or_plack {
-    my $is_psgi_or_plack = 0;
-    if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
-        $is_psgi_or_plack = 1;
-    }
-    return $is_psgi_or_plack;
-}
+sub psgi_env { any { /(^psgi\.|^plack\.)/i } keys %ENV };
 
 =head3 is_internal_PSGI_request
 
@@ -1026,7 +1020,7 @@ app
 #NOTE: This is not a very robust method but it's the best we have so far
 sub is_internal_PSGI_request {
     my $is_internal = 0;
-    if ( (__PACKAGE__->is_psgi_or_plack) && ( $ENV{REQUEST_URI} !~ /^(\/intranet|\/opac)/ ) ){
+    if ( (__PACKAGE__->psgi_env) && ( $ENV{REQUEST_URI} !~ /^(\/intranet|\/opac)/ ) ){
         $is_internal = 1;
     }
     return $is_internal;
diff --git a/Koha/AuthUtils.pm b/Koha/AuthUtils.pm
index 8345f50a5f..1a1ccba830 100644
--- a/Koha/AuthUtils.pm
+++ b/Koha/AuthUtils.pm
@@ -208,9 +208,7 @@ outside this context.
 =cut
 
 sub get_script_name {
-    # This is the method about.pl uses to detect Plack; now that two places use it, it MUST be
-    # right.
-    if ( ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) && $ENV{SCRIPT_NAME} =~ m,^/(intranet|opac)(.*), ) {
+    if ( ( C4::Context::psgi_env ) && $ENV{SCRIPT_NAME} =~ m,^/(intranet|opac)(.*), ) {
         return '/cgi-bin/koha' . $2;
     } else {
         return $ENV{SCRIPT_NAME};
diff --git a/about.pl b/about.pl
index 8adf1c94c0..20ee2ea881 100755
--- a/about.pl
+++ b/about.pl
@@ -125,7 +125,7 @@ if ($^O ne 'VMS') {
 my $zebraVersion = `zebraidx -V`;
 
 # Check running PSGI env
-if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
+if ( C4::Context::psgi_env ) {
     $template->param(
         is_psgi => 1,
         psgi_server => ($ENV{ PLACK_ENV }) ? "Plack ($ENV{PLACK_ENV})" :
-- 
2.39.5