1 package Koha
::App
::Plugin
::CGIBinKoha
;
3 # Copyright 2020 BibLibre
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use Mojo
::Base
'Mojolicious::Plugin';
25 use CGI
::Emulate
::PSGI
;
29 my ($self, $app, $conf) = @_;
31 my $opac = $conf->{opac
};
35 $r->any('/cgi-bin/koha/*script' => sub {
38 my $script = $c->stash('script');
40 # Special case for installer which can takes a long time
41 $c->inactivity_timeout(300) if $script eq 'installer/install.pl';
43 # Remove trailing slash, if any (e.g. .../svc/config/systempreferences/)
47 $script = "opac/$script";
50 unless (-e
$c->app->home->rel_file($script)) {
51 return $c->reply->not_found;
54 my $sub = CGI
::Compile
->compile($script);
55 my $app = CGI
::Emulate
::PSGI
->handler($sub);
56 my $response = $app->($self->_psgi_env($c));
58 $c->res->code($response->[0]);
59 $c->res->headers->from_hash({ @
{ $response->[1] } });
60 $c->res->body(join('', @
{$response->[2]}));
68 my $env = $c->req->env;
70 my $body = $c->req->build_body;
73 'psgi.input' => IO
::Scalar
->new(\
$body),
74 'psgi.errors' => *STDERR
,
75 REQUEST_METHOD
=> $c->req->method,
76 QUERY_STRING
=> $c->req->url->query->to_string,
77 SERVER_NAME
=> $c->req->url->to_abs->host,
78 SERVER_PORT
=> $c->req->url->to_abs->port,
79 SERVER_PROTOCOL
=> 'HTTP/1.1',
80 CONTENT_LENGTH
=> $c->req->headers->content_length,
81 CONTENT_TYPE
=> $c->req->headers->content_type,
82 REMOTE_ADDR
=> $c->tx->remote_address,
83 SCRIPT_NAME
=> $c->req->url->path->to_string,
86 # Starman sets PATH_INFO to the same value of SCRIPT_NAME, which confuses
87 # CGI and causes the redirect after OPAC login to fail
88 delete $env->{PATH_INFO
} if ($env->{PATH_INFO
} && $env->{PATH_INFO
} eq $env->{SCRIPT_NAME
});
90 for my $name (@
{ $c->req->headers->names }) {
91 my $value = $c->req->headers->header($name);
93 $name = 'HTTP_' . uc($name);
94 $env->{$name} = $value;