From c30a978dcd71e2b8b3718c69476f4ded36098174 Mon Sep 17 00:00:00 2001 From: Julian Maurice Date: Fri, 23 May 2025 09:19:54 +0000 Subject: [PATCH] Bug 39980: Fix vendors pages when using Koha as a Mojo app Bug 38010 broke the vendors pages when Koha is running as a Mojolicious application This adds new routes to Koha::App::Intranet to mimic the Apache rewrite rules added in bug 38010. To be able to do that, the CGIBinKoha plugin's code had to be moved to a controller. The logic remains the same. Test plan: 1. Run `bin/intranet daemon -l http://*:3000/` 2. Point your browser to http://localhost:3000 (replace localhost by the hostname/IP of koha's container, if needed) 3. Go to Acquisitions and search for a vendor. You should see the list of vendors. 4. Click on "New vendor" button. Notice the URL changed to .../acquisition/vendors/add. 5. Reload the page. You should still see the form to create a new vendor 6. Verify that you can create a vendor and that you are then redirected to the list of vendors --- Koha/App/Controller/CGI.pm | 96 +++++++++++++++++++++++++ Koha/App/Intranet.pm | 11 +-- Koha/App/Opac.pm | 9 +-- Koha/App/Plugin/CGIBinKoha.pm | 132 ---------------------------------- 4 files changed, 108 insertions(+), 140 deletions(-) create mode 100644 Koha/App/Controller/CGI.pm delete mode 100644 Koha/App/Plugin/CGIBinKoha.pm diff --git a/Koha/App/Controller/CGI.pm b/Koha/App/Controller/CGI.pm new file mode 100644 index 0000000000..54b3d411e7 --- /dev/null +++ b/Koha/App/Controller/CGI.pm @@ -0,0 +1,96 @@ +package Koha::App::Controller::CGI; + +use Mojo::Base 'Mojolicious::Controller'; + +use CGI::Compile; +use CGI::Emulate::PSGI; +use CGI; + +# CGI::Compile calls CGI::initialize_globals before each request, which resets PARAM_UTF8 to 0 +# We need to set it back to the correct value +{ + no warnings 'redefine'; + my $old_new = \&CGI::new; + *CGI::new = sub { + $CGI::PARAM_UTF8 = 1; + return $old_new->(@_); + }; +} + +sub intranet { + my ($c) = @_; + + my $script = $c->stash('script'); + + # Special case for installer which can takes a long time + $c->inactivity_timeout(300) if $script eq 'installer/install.pl'; + + $c->_render_script($script); +} + +sub opac { + my ($c) = @_; + + my $script = $c->stash('script'); + $script = "opac/$script"; + + $c->_render_script($script); +} + +sub _render_script { + my ($c, $script) = @_; + + # Remove trailing slash, if any (e.g. .../svc/config/systempreferences/) + $script =~ s|/$||; + + unless ( -e $c->app->home->rel_file($script) ) { + return $c->reply->not_found; + } + + my $sub = CGI::Compile->compile($script); + my $app = CGI::Emulate::PSGI->handler($sub); + my $response = $app->( $c->_psgi_env() ); + + $c->res->code( $response->[0] ); + $c->res->headers->from_hash( { @{ $response->[1] } } ); + $c->res->body( join( '', @{ $response->[2] } ) ); + $c->rendered; +} + +sub _psgi_env { + my ($c) = @_; + + my $env = $c->req->env; + + my $body = $c->req->build_body; + open my $input, '<', \$body or die "Can't open in-memory scalar: $!"; + $env = { + %$env, + 'psgi.input' => $input, + 'psgi.errors' => *STDERR, + REQUEST_METHOD => $c->req->method, + QUERY_STRING => $c->req->url->query->to_string, + SERVER_NAME => $c->req->url->to_abs->host, + SERVER_PORT => $c->req->url->to_abs->port, + SERVER_PROTOCOL => 'HTTP/1.1', + CONTENT_LENGTH => $c->req->headers->content_length, + CONTENT_TYPE => $c->req->headers->content_type, + REMOTE_ADDR => $c->tx->remote_address, + SCRIPT_NAME => $c->req->url->path->to_string, + }; + + # Starman sets PATH_INFO to the same value of SCRIPT_NAME, which confuses + # CGI and causes the redirect after OPAC login to fail + delete $env->{PATH_INFO} if ( $env->{PATH_INFO} && $env->{PATH_INFO} eq $env->{SCRIPT_NAME} ); + + for my $name ( @{ $c->req->headers->names } ) { + my $value = $c->req->headers->header($name); + $name =~ s/-/_/g; + $name = 'HTTP_' . uc($name); + $env->{$name} = $value; + } + + return $env; +} + +1; diff --git a/Koha/App/Intranet.pm b/Koha/App/Intranet.pm index 06bfa34f62..cdf2be2387 100644 --- a/Koha/App/Intranet.pm +++ b/Koha/App/Intranet.pm @@ -21,6 +21,8 @@ use Modern::Perl; use Mojo::Base 'Mojolicious'; +use CGI::Compile; # This module needs to be loaded early; do not remove + use Koha::Caches; use Koha::Cache::Memory::Lite; @@ -29,10 +31,7 @@ sub startup { push @{ $self->plugins->namespaces }, 'Koha::App::Plugin'; push @{ $self->static->paths }, $self->home->rel_file('koha-tmpl'); - - # Create route for all CGI scripts, need to be loaded first because of - # CGI::Compile - $self->plugin('CGIBinKoha'); + $self->routes->namespaces( ['Koha::App::Controller'] ); # Create routes for API $self->plugin('RESTV1'); @@ -45,6 +44,10 @@ sub startup { my $r = $self->routes; + $r->any('/cgi-bin/koha/acquisition/vendors')->to('CGI#intranet', { script => 'acqui/vendors.pl' }); + $r->any('/cgi-bin/koha/acquisition/vendors/*')->to('CGI#intranet', { script => 'acqui/vendors.pl' }); + $r->any('/cgi-bin/koha/*script')->to('CGI#intranet')->name('cgi'); + $r->any('/')->to( cb => sub { shift->redirect_to('/cgi-bin/koha/mainpage.pl') } ); } diff --git a/Koha/App/Opac.pm b/Koha/App/Opac.pm index 5b73aedf23..1bf928ecc5 100644 --- a/Koha/App/Opac.pm +++ b/Koha/App/Opac.pm @@ -21,6 +21,8 @@ use Modern::Perl; use Mojo::Base 'Mojolicious'; +use CGI::Compile; # This module needs to be loaded early; do not remove + use Koha::Caches; use Koha::Cache::Memory::Lite; @@ -29,10 +31,7 @@ sub startup { push @{ $self->plugins->namespaces }, 'Koha::App::Plugin'; push @{ $self->static->paths }, $self->home->rel_file('koha-tmpl'); - - # Create route for all CGI scripts, need to be loaded first because of - # CGI::Compile - $self->plugin( 'CGIBinKoha', opac => 1 ); + $self->routes->namespaces( ['Koha::App::Controller'] ); # Create routes for API $self->plugin('RESTV1'); @@ -45,6 +44,8 @@ sub startup { my $r = $self->routes; + $r->any('/cgi-bin/koha/*script')->to('CGI#opac')->name('cgi'); + $r->any('/')->to( cb => sub { shift->redirect_to('/cgi-bin/koha/opac-main.pl') } ); } diff --git a/Koha/App/Plugin/CGIBinKoha.pm b/Koha/App/Plugin/CGIBinKoha.pm deleted file mode 100644 index 6d9fd5cc02..0000000000 --- a/Koha/App/Plugin/CGIBinKoha.pm +++ /dev/null @@ -1,132 +0,0 @@ -package Koha::App::Plugin::CGIBinKoha; - -# Copyright 2020 BibLibre -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# Koha is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with Koha; if not, see . - -use Modern::Perl; - -use Mojo::Base 'Mojolicious::Plugin'; - -use CGI; -use CGI::Compile; -use CGI::Emulate::PSGI; - -sub register { - my ( $self, $app, $conf ) = @_; - - # CGI::Compile calls CGI::initialize_globals before each request, which resets PARAM_UTF8 to 0 - # We need to set it back to the correct value - { - no warnings 'redefine'; - my $old_new = \&CGI::new; - *CGI::new = sub { - $CGI::PARAM_UTF8 = 1; - return $old_new->(@_); - }; - } - - my $opac = $conf->{opac}; - - my $r = $app->routes; - - $r->any( - '/cgi-bin/koha/*script' => sub { - my ($c) = @_; - - my $script = $c->stash('script'); - - # Special case for installer which can takes a long time - $c->inactivity_timeout(300) if $script eq 'installer/install.pl'; - - # Remove trailing slash, if any (e.g. .../svc/config/systempreferences/) - $script =~ s|/$||; - - if ($opac) { - $script = "opac/$script"; - } - - unless ( -e $c->app->home->rel_file($script) ) { - return $c->reply->not_found; - } - - my $sub = CGI::Compile->compile($script); - my $app = CGI::Emulate::PSGI->handler($sub); - my $response = $app->( $self->_psgi_env($c) ); - - $c->res->code( $response->[0] ); - $c->res->headers->from_hash( { @{ $response->[1] } } ); - $c->res->body( join( '', @{ $response->[2] } ) ); - $c->rendered; - } - )->name('cgi'); -} - -sub _psgi_env { - my ( $self, $c ) = @_; - - my $env = $c->req->env; - - my $body = $c->req->build_body; - open my $input, '<', \$body or die "Can't open in-memory scalar: $!"; - $env = { - %$env, - 'psgi.input' => $input, - 'psgi.errors' => *STDERR, - REQUEST_METHOD => $c->req->method, - QUERY_STRING => $c->req->url->query->to_string, - SERVER_NAME => $c->req->url->to_abs->host, - SERVER_PORT => $c->req->url->to_abs->port, - SERVER_PROTOCOL => 'HTTP/1.1', - CONTENT_LENGTH => $c->req->headers->content_length, - CONTENT_TYPE => $c->req->headers->content_type, - REMOTE_ADDR => $c->tx->remote_address, - SCRIPT_NAME => $c->req->url->path->to_string, - }; - - # Starman sets PATH_INFO to the same value of SCRIPT_NAME, which confuses - # CGI and causes the redirect after OPAC login to fail - delete $env->{PATH_INFO} if ( $env->{PATH_INFO} && $env->{PATH_INFO} eq $env->{SCRIPT_NAME} ); - - for my $name ( @{ $c->req->headers->names } ) { - my $value = $c->req->headers->header($name); - $name =~ s/-/_/g; - $name = 'HTTP_' . uc($name); - $env->{$name} = $value; - } - - return $env; -} - -1; - -=encoding utf8 - -=head1 NAME - -Koha::App::Plugin::CGIBinKoha - -=head1 DESCRIPTION - -Koha App Plugin used to wrap Koha CGI scripts for backwards compatibility whilst we migrate from CGI to using the Mojolicious Web Application Framework. - -=head1 METHODS - -=head2 register - -Called at application startup; Sets up a catch-all router to identify CGI scripts and loads the found script using CGI::Compile before running it under CGI::Emulate::PSGI. - -=cut -- 2.39.5