From cf4b6002b914a5e0bc8d7d9f5a7a23148eaead3e Mon Sep 17 00:00:00 2001 From: Srdjan Date: Mon, 28 Jul 2014 15:17:09 +1200 Subject: [PATCH] bug_15562: Multi-host helper for plack installations Sort of an apocalypse * C4::Context->new() must be called with at least config file param. If you want current context, call C4::Context->current(). C4::Context->some_method() will still work as is. * Koha::Database->new_schema() now takes optional context param. * C4::Context->set_context() and restore_context() are synched with database set_schema() and restore_schema(). Created run_within_context() that wraps set_context() and restore_context() around code. * Created Koha::Handler::Plack* to facilitate running same code within different (database) contexts. * This initial version does not run with memcached turned on. Next patch will correct that. https://bugs.koha-community.org/show_bug.cgi?id=15562 Signed-off-by: Kyle M Hall --- C4/Auth_with_ldap.pm | 2 +- C4/Context.pm | 283 +++++++++++++---------------- Koha/Caches.pm | 13 +- Koha/Database.pm | 38 +++- Koha/Handler/Plack.pm | 163 +++++++++++++++++ Koha/Handler/Plack/CGI.pm | 228 +++++++++++++++++++++++ about.pl | 2 +- admin/systempreferences.pl | 2 +- misc/cronjobs/check-url.pl | 2 +- misc/plack/koha-multi.psgi | 34 ++++ misc/translator/LangInstaller.pm | 4 +- t/Koha_Handler_Plack.t | 136 ++++++++++++++ t/conf/dummy/koha-conf.xml | 7 + t/conf/koha1/koha-conf.xml | 7 + t/conf/koha2/koha-conf.xml | 5 + t/db_dependent/Amazon.t | 2 +- t/db_dependent/Context.t | 2 +- t/db_dependent/Template/Plugin/KohaDates.t | 2 +- t/db_dependent/XISBN.t | 2 +- t/db_dependent/sysprefs.t | 13 +- 20 files changed, 771 insertions(+), 176 deletions(-) create mode 100644 Koha/Handler/Plack.pm create mode 100644 Koha/Handler/Plack/CGI.pm create mode 100644 misc/plack/koha-multi.psgi create mode 100644 t/Koha_Handler_Plack.t create mode 100644 t/conf/dummy/koha-conf.xml create mode 100644 t/conf/koha1/koha-conf.xml create mode 100644 t/conf/koha2/koha-conf.xml diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index bbb1094..bb21ad1 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -54,7 +54,7 @@ sub ldapserver_error { } use vars qw($mapping @ldaphosts $base $ldapname $ldappassword); -my $context = C4::Context->new() or die 'C4::Context->new failed'; +my $context = C4::Context->current() or die 'No current context'; my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF}; my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname'); my $base = $ldap->{base} or die ldapserver_error('base'); diff --git a/C4/Context.pm b/C4/Context.pm index 1aa08be..d880b2c 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -32,7 +32,7 @@ BEGIN { eval {C4::Context->dbh();}; if ($@){ $debug_level = 1; - } + } else { $debug_level = C4::Context->preference("DebugLevel"); } @@ -50,7 +50,7 @@ BEGIN { # a little example table with various version info"; print "

Koha error

-

The following fatal error has occurred:

+

The following fatal error has occurred:

$msg
@@ -64,11 +64,11 @@ BEGIN { } elsif ($debug_level eq "1"){ print "

Koha error

-

The following fatal error has occurred:

+

The following fatal error has occurred:

$msg
"; } else { print "

production mode - trapped fatal error

"; - } + } print ""; } #CGI::Carp::set_message(\&handle_errors); @@ -96,6 +96,7 @@ use Koha::Caches; use POSIX (); use DateTime::TimeZone; use Module::Load::Conditional qw(can_load); +use Data::Dumper; use Carp; use C4::Boolean; @@ -164,14 +165,28 @@ environment variable to the pathname of a configuration file to use. # file (/etc/koha/koha-conf.xml). # dbh # A handle to the appropriate database for this context. -# dbh_stack -# Used by &set_dbh and &restore_dbh to hold other database -# handles for this context. -# Zconn # A connection object for the Zebra server -$context = undef; # Initially, no context is set -@context_stack = (); # Initially, no saved contexts +@context_stack = (); # Initially, no saved contexts + +=head2 current + +Returns the current context + +=cut + +sub current { + return $context; +} + +sub db_driver { + my $self = shift; + + $self = $context unless ref ($self); + return unless $self; + + return $self->{db_driver}; +} =head2 db_scheme2dbi @@ -193,32 +208,44 @@ sub import { # Create the default context ($C4::Context::Context) # the first time the module is called # (a config file can be optionaly passed) + # If ":no_config" is passed, no config load will be attempted + # It saves the context values in the declared memcached server(s) + # if currently available and uses those values until them expire and + # re-reads them. + + my ($pkg,$config_file) = @_; # default context already exists? return if $context; - # no ? so load it! - my ($pkg,$config_file) = @_ ; - my $new_ctx = __PACKAGE__->new($config_file); - return unless $new_ctx; + # multihost, we don't want/have one default config + return if $config_file && $config_file eq ":no_config"; - # if successfully loaded, use it by default - $new_ctx->set_context; - 1; + my $conf_cache = Koha::Caches->get_instance('config'); + if ( $conf_cache->cache ) { + if ( $context = $conf_cache->get_from_cache('koha_conf') ) { + return; + } + } + + undef $config_file if $config_file && !-s $config_file; + $config_file ||= Koha::Config->guess_koha_conf(); + $context = __PACKAGE__->new($config_file); + return unless $context; + + if ( $conf_cache->memcached_cache ) { + # FIXME it may be better to use the memcached servers from the config file + # to cache it + $conf_cache->set_in_cache('koha_conf', $context) + } } =head2 new - $context = new C4::Context; $context = new C4::Context("/path/to/koha-conf.xml"); Allocates a new context. Initializes the context from the specified -file, which defaults to either the file given by the C<$KOHA_CONF> -environment variable, or F. - -It saves the koha-conf.xml values in the declared memcached server(s) -if currently available and uses those values until them expire and -re-reads them. +file. C<&new> does not set this context as the new default context; for that, use C<&set_context>. @@ -230,38 +257,17 @@ that, use C<&set_context>. # 2004-08-10 A. Tarallo: Added check if the conf file is not empty sub new { my $class = shift; - my $conf_fname = shift; # Config file to load - my $self = {}; - - # check that the specified config file exists and is not empty - undef $conf_fname unless - (defined $conf_fname && -s $conf_fname); - # Figure out a good config file to load if none was specified. - unless ( defined $conf_fname ) { - $conf_fname = Koha::Config->guess_koha_conf; - unless ( $conf_fname ) { - warn "unable to locate Koha configuration file koha-conf.xml"; - return; - } - } + my $conf_fname = shift or croak "No conf"; + my $namespace = shift; - my $conf_cache = Koha::Caches->get_instance('config'); - my $config_from_cache; - if ( $conf_cache->cache ) { - $self = $conf_cache->get_from_cache('koha_conf'); - } - unless ( $self and %$self ) { - $self = Koha::Config->read_from_file($conf_fname); - if ( $conf_cache->memcached_cache ) { - # FIXME it may be better to use the memcached servers from the config file - # to cache it - $conf_cache->set_in_cache('koha_conf', $self) - } - } - unless ( exists $self->{config} or defined $self->{config} ) { - warn "The config file ($conf_fname) has not been parsed correctly"; - return; - } + my $self = Koha::Config->read_from_file($conf_fname); + die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) + unless ref($self) && $self->{"config"}; + + $self->{config_file} = $conf_fname; + $self->{namespace} = $namespace; + $self->{use_syspref_cache} = 1; + $self->{syspref_cache} = Koha::Caches->get_instance('syspref', $namespace); $self->{"Zconn"} = undef; # Zebra Connections $self->{"userenv"} = undef; # User env @@ -276,7 +282,6 @@ sub new { =head2 set_context - $context = new C4::Context; $context->set_context(); or set_context C4::Context $context; @@ -309,17 +314,21 @@ sub set_context if (ref($self) eq "") { # Class method. The new context is the next argument. - $new_context = shift; + $new_context = shift or croak "No new context"; } else { # Instance method. The new context is $self. $new_context = $self; } - # Save the old context, if any, on the stack - push @context_stack, $context if defined($context); + # undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping + my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context); + + # Save the old context on the stack + push @context_stack, $context; # Set the new context $context = $new_context; + Koha::Database->set_schema($schema); } =head2 restore_context @@ -335,19 +344,38 @@ sub restore_context { my $self = shift; - if ($#context_stack < 0) - { - # Stack underflow. - die "Context stack underflow"; - } - # Pop the old context and set it. $context = pop @context_stack; + Koha::Database->restore_schema(); # FIXME - Should this return something, like maybe the context # that was current when this was called? } +=head2 run_within_context + + $context->run_within_context(sub {...}); + +Runs code within context + +=cut + +#' +sub run_within_context +{ + my $self = shift; + my $code = shift or croak "No code"; + + $self->set_context; + + local $@; + my $ret = eval { $code->(@_) }; + my $died = $@; + $self->restore_context; + die $died if $died; + return $ret; +} + =head2 config $value = C4::Context->config("config_variable"); @@ -364,26 +392,32 @@ Cnew> will not return it. =cut sub _common_config { - my $var = shift; - my $term = shift; - return if !defined($context->{$term}); + my $self = shift; + my $var = shift; + my $term = shift; + + $self = $context unless ref $self; + return if !defined($self->{$term}); # Presumably $self->{$term} might be # undefined if the config file given to &new # didn't exist, and the caller didn't bother # to check the return value. # Return the value of the requested config variable - return $context->{$term}->{$var}; + return $self->{$term}->{$var}; } sub config { - return _common_config($_[1],'config'); + my $self = shift; + return $self->_common_config($_[0],'config'); } sub zebraconfig { - return _common_config($_[1],'server'); + my $self = shift; + return $self->_common_config($_[0],'server'); } sub ModZebrations { - return _common_config($_[1],'serverinfo'); + my $self = shift; + return $self->_common_config($_[0],'serverinfo'); } =head2 preference @@ -402,29 +436,27 @@ with this method. =cut -my $syspref_cache = Koha::Caches->get_instance('syspref'); -my $use_syspref_cache = 1; sub preference { my $self = shift; + $self = $context unless ref $self; my $var = shift; # The system preference to return + $var = lc $var; + return $ENV{"OVERRIDE_SYSPREF_$var"} if defined $ENV{"OVERRIDE_SYSPREF_$var"}; - $var = lc $var; - - if ($use_syspref_cache) { - $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache; - my $cached_var = $syspref_cache->get_from_cache("syspref_$var"); - return $cached_var if defined $cached_var; - } + my $cached_var = $self->{use_syspref_cache} + ? $self->{syspref_cache}->get_from_cache("syspref_$var") + : undef; + return $cached_var if defined $cached_var; my $syspref; eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; my $value = $syspref ? $syspref->value() : undef; - if ( $use_syspref_cache ) { - $syspref_cache->set_in_cache("syspref_$var", $value); + if ( $self->{use_syspref_cache} ) { + $self->{syspref_cache}->set_in_cache("syspref_$var", $value); } return $value; } @@ -447,7 +479,8 @@ default behavior. sub enable_syspref_cache { my ($self) = @_; - $use_syspref_cache = 1; + $self = $context unless ref $self; + $self->{use_syspref_cache} = 1; # We need to clear the cache to have it up-to-date $self->clear_syspref_cache(); } @@ -463,7 +496,8 @@ used with Plack and other persistent environments. sub disable_syspref_cache { my ($self) = @_; - $use_syspref_cache = 0; + $self = $context unless ref $self; + $self->{use_syspref_cache} = 0; $self->clear_syspref_cache(); } @@ -478,8 +512,10 @@ will not be seen by this process. =cut sub clear_syspref_cache { - return unless $use_syspref_cache; - $syspref_cache->flush_all; + my ($self) = @_; + $self = $context unless ref $self; + return unless $self->{use_syspref_cache}; + $self->{syspref_cache}->flush_all; } =head2 set_preference @@ -495,6 +531,7 @@ preference. sub set_preference { my ( $self, $variable, $value, $explanation, $type, $options ) = @_; + $self = $context unless ref $self; $variable = lc $variable; @@ -530,8 +567,8 @@ sub set_preference { )->store(); } - if ( $use_syspref_cache ) { - $syspref_cache->set_in_cache( "syspref_$variable", $value ); + if ( $self->{use_syspref_cache} ) { + $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); } return $syspref; @@ -549,10 +586,11 @@ was no syspref of the name. sub delete_preference { my ( $self, $var ) = @_; + $self = $context unless ref $self; if ( Koha::Config::SysPrefs->find( $var )->delete ) { - if ( $use_syspref_cache ) { - $syspref_cache->clear_from_cache("syspref_$var"); + if ( $self->{use_syspref_cache} ) { + $self->{syspref_cache}->clear_from_cache("syspref_$var"); } return 1; @@ -566,7 +604,7 @@ sub delete_preference { Returns a connection to the Zebra database -C<$self> +C<$self> C<$server> one of the servers defined in the koha-conf.xml file @@ -677,8 +715,7 @@ creates one, and connects to the database. This database handle is cached for future use: if you call Cdbh> twice, you will get the same handle both -times. If you need a second database handle, use C<&new_dbh> and -possibly C<&set_dbh>. +times. If you need a second database handle, use C<&new_dbh>. =cut @@ -717,64 +754,6 @@ sub new_dbh return &dbh({ new => 1 }); } -=head2 set_dbh - - $my_dbh = C4::Connect->new_dbh; - C4::Connect->set_dbh($my_dbh); - ... - C4::Connect->restore_dbh; - -C<&set_dbh> and C<&restore_dbh> work in a manner analogous to -C<&set_context> and C<&restore_context>. - -C<&set_dbh> saves the current database handle on a stack, then sets -the current database handle to C<$my_dbh>. - -C<$my_dbh> is assumed to be a good database handle. - -=cut - -#' -sub set_dbh -{ - my $self = shift; - my $new_dbh = shift; - - # Save the current database handle on the handle stack. - # We assume that $new_dbh is all good: if the caller wants to - # screw himself by passing an invalid handle, that's fine by - # us. - push @{$context->{"dbh_stack"}}, $context->{"dbh"}; - $context->{"dbh"} = $new_dbh; -} - -=head2 restore_dbh - - C4::Context->restore_dbh; - -Restores the database handle saved by an earlier call to -Cset_dbh>. - -=cut - -#' -sub restore_dbh -{ - my $self = shift; - - if ($#{$context->{"dbh_stack"}} < 0) - { - # Stack underflow - die "DBH stack underflow"; - } - - # Pop the old database handle and set it. - $context->{"dbh"} = pop @{$context->{"dbh_stack"}}; - - # FIXME - If it is determined that restore_context should - # return something, then this function should, too. -} - =head2 queryparser $queryparser = C4::Context->queryparser diff --git a/Koha/Caches.pm b/Koha/Caches.pm index 8940925..51ab816 100644 --- a/Koha/Caches.pm +++ b/Koha/Caches.pm @@ -46,11 +46,11 @@ persistent across multiple instances. =cut sub get_instance { - my ($class, $subnamespace) = @_; + my ($class, $subnamespace, $namespace) = @_; $subnamespace //= ''; - $singleton_caches->{$subnamespace} = Koha::Cache->new({}, { subnamespace => $subnamespace } ) - unless $singleton_caches->{$subnamespace}; - return $singleton_caches->{$subnamespace}; + $namespace //= ''; + return $singleton_caches->{$namespace}{$subnamespace} + ||= Koha::Cache->new({ namespace => $namespace }, { subnamespace => $subnamespace }); } =head2 flush_L1_caches @@ -58,8 +58,11 @@ sub get_instance { =cut sub flush_L1_caches { + my ($class, $subnamespace, $namespace) = @_; + $namespace //= ''; + return unless $singleton_caches; - for my $cache ( values %$singleton_caches ) { + for my $cache ( values %{$singleton_caches->{$namespace}} ) { $cache->flush_L1_cache; } } diff --git a/Koha/Database.pm b/Koha/Database.pm index 26d1c96..9503147 100644 --- a/Koha/Database.pm +++ b/Koha/Database.pm @@ -47,10 +47,9 @@ __PACKAGE__->mk_accessors(qw( )); # database connection from the data given in the current context, and # returns it. sub _new_schema { + my $context = shift || C4::Context->current(); - my $context = C4::Context->new(); - - my $db_driver = $context->{db_driver}; + my $db_driver = $context->db_driver; my $db_name = $context->config("database"); my $db_host = $context->config("hostname"); @@ -136,16 +135,16 @@ sub schema { return $database->{schema} if defined $database->{schema}; } - $database->{schema} = &_new_schema(); + $database->{schema} = &_new_schema($params->{context}); return $database->{schema}; } =head2 new_schema - $schema = $database->new_schema; + $schema = $database->new_schema($context); -Creates a new connection to the Koha database for the current context, -and returns the database handle (a C object). +Creates a new connection to the Koha database for the context +(current is default), and returns the database handle (a C object). The handle is not saved anywhere: this method is strictly a convenience function; the point is that it knows which database to @@ -157,7 +156,7 @@ connect to so that the caller doesn't have to know. sub new_schema { my $self = shift; - return &_new_schema(); + return &_new_schema(@_); } =head2 set_schema @@ -231,6 +230,29 @@ sub flush_schema_cache { return 1; } +=head2 run_with_schema + + $database->run_with_schema( $schema, sub {...} ); + +Restores the database handle saved by an earlier call to +C<$database-Eset_schema> C<$database-Erestore_schema> wrapper. + +=cut + +sub run_with_schema { + my $self = shift; + my $schema = shift or croak "No schema"; + my $code = shift or croak "No sub"; + + $self->set_schema; + local $@; + my $ret = eval { $code->(@_) }; + my $died = $@; + $self->restore_schema; + die $died if $died; + return $ret; +} + =head2 EXPORT None by default. diff --git a/Koha/Handler/Plack.pm b/Koha/Handler/Plack.pm new file mode 100644 index 0000000..af3f6cb --- /dev/null +++ b/Koha/Handler/Plack.pm @@ -0,0 +1,163 @@ +package Koha::Handler::Plack; + +# Copyright (c) 2016 Catalyst IT +# +# 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + + Koha::Handler::Plack - Plack helper + +=head1 SYNOPSIS + + koha.psgi: + use Koha::Handler::Plack; + + my %HOST_CONF = ( + 'koha1.com' => { ... }, + 'koha2.com' => { ... }, + ... + ); + # last line + Koha::Handler::Plack->app_per_host(\%HOST_CONF); + + See C below + +=head1 DESCRIPTION + + Some handy function to help with Koha/Plack in a multi-host situation. + + The problem: + Koha app relies on env vars. This should be changed, ie C4::Context should + be upgraded to Koha::App, but until then we need a gap filler. That's + because once up, there's no way to pass on new env to a psgi container. + In Apache, for instance, we can specify env vars per virtual host. Plack + has no such concept. + + Solution: + We need to modify the environment in situ, per virtual host - app_per_host(). + We specify env for each hostname, and apply. + +=cut + +use Modern::Perl; +use Carp; + +use Plack::App::URLMap; + +=head1 CLASS METHODS + +=head2 app_per_host($host_apps) + + App wrapper for per virtual host scenario. + + C<$host_apps>: + { + hostname => 'koha1.com', + app => $app1, + context => $context1, + }, + { + hostname => ['koha2.com', 'www.koha2.com'], + app => $app2, + context => $context2, + }, + ... + + C is mandatory. + + koha.psgi: + + use Plack::Builder; + use Plack::App::CGIBin; + + use C4::Context; + + my $opac_app = builder { + enable "Plack::Middleware::Static", + path => qr{^/opac-tmpl/}, root => '/usr/share/koha/opac/htdocs/'; + + enable 'StackTrace'; + mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/opac/cgi-bin/opac"); + }; + my $intranet_app = builder { + enable "Plack::Middleware::Static", + path => qr{^/intranet-tmpl/}, root => '/usr/share/koha/intranet/htdocs/'; + + enable 'StackTrace'; + mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/cgi-bin"); + }; + + my @host_def; + + my $conf_file_1 = "/etc/koha/site-1/koha_conf.xml"; + my $context_1 = C4::Context->new($conf_file_1); + push @host_def, + { + hostname => [ "public.host.for.site-1", "www.public.host.for.site-1" ], + app => $opac_app, + context => $context_1, + }, + { + hostname => "intranet.host.for.site-1", + app => $intranet_app, + context => $context_1, + }; + + my $conf_file_2 = "/etc/koha/site-1/koha_conf.xml"; + my $context_2 = C4::Context->new($conf_file_2); + push @host_def, + { + hostname => "public.host.for.site-2", + app => $opac_app, + context => $context_2, + }, + { + hostname => "intranet.host.for.site-2", + app => $intranet_app, + context => $context_2, + }; + + ... + + Koha::Handler::Plack->app_per_host( \@host_def ); + +=cut + +sub app_per_host { + my $class = shift; + my $sites = shift or die "No sites spec"; + + my $map = Plack::App::URLMap->new; + foreach my $site_params ( @$sites ) { + my $hosts = $site_params->{hostname} or croak "No hostname"; + $hosts = [$hosts] unless ref $hosts; + + my $app = $site_params->{app} or croak "No app"; + my $context = $site_params->{context} or croak "No Koha Context"; + + foreach my $host (@$hosts) { + $map->map("http://$host/" => sub { + my $env = shift; + + return $context->run_within_context(sub { $app->($env) }); + }); + } + } + return $map->to_app; +} + +1; diff --git a/Koha/Handler/Plack/CGI.pm b/Koha/Handler/Plack/CGI.pm new file mode 100644 index 0000000..36c6907 --- /dev/null +++ b/Koha/Handler/Plack/CGI.pm @@ -0,0 +1,228 @@ +package Koha::Handler::Plack::CGI; + +# Copyright (c) 2016 Catalyst IT +# +# 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + + Koha::Handler::Plack::CGI - Plack helper for CGI scripts + +=head1 SYNOPSIS + + koha.psgi: + use Koha::Handler::Plack::CGI; + + my %koha_env = ( + opac => { + static_root => '/usr/share/koha/opac/htdocs', + script_root => '/usr/share/koha/opac', + }, + intranet => { + static_root => '/usr/share/koha/intranet/htdocs', + script_root => '/usr/share/koha/intranet' + } + ); + my @sites = ( + { + opac_hostname => 'koha1-opac.com', + intranet_hostname => 'koha1-intranet.com', + config = '/etc/koha/koha1/koha-conf.xml' + }, + { + opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'], + intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'], + config = '/etc/koha/koha2/koha-conf.xml' + }, + ); + + # last line + Koha::Handler::Plack::CGI->app_per_host(\%HOST_CONF); + + See C below + +=head1 DESCRIPTION + + CGI script runner. + + One beautiful day wiwill move away from that and have proper App module + with router and handlers + + See C + +=cut + +use Modern::Perl; +use Carp; + +use Plack::Builder; +use Plack::App::CGIBin; + +use parent "Koha::Handler::Plack"; + +use C4::Context; + +=head1 CLASS METHODS + +=head2 app($context, $env) + + Plack app builder fora CGI app + + C<$context>: "opac" or "intranet" + C<$env>: + { + static_root => '...', + script_root => '...', + pugins => [ + [ 'StackTrace' ], + ... + ], + } + + koha.psgi: + + Koha::Handler::Plack::CGI->app( "opac", \%opac_app_env ); + +=cut + +sub app { + my $class = shift; + my $context = shift; + croak "Invalid app context '$context' - must be 'opac' or 'intranet'" + unless $context =~ m/^(opac|intranet)$/; + my $env = shift or croak "No $context env details"; + + my $static_root = $env->{static_root} or croak "No $context static_root"; + $static_root = "$static_root/" unless $static_root =~ m!/$!; + my $script_root = $env->{script_root} or croak "No $context script_root"; + $script_root =~ s!/$!!; + my $plugins = $env->{plugins} || []; + my $is_intranet = $context eq "intranet"; + + builder { + enable "Plack::Middleware::Static", + path => qr{^/$context-tmpl/}, root => $static_root; + + map enable(@$_), @$plugins; + + mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => $script_root)->to_app; + mount "/" => sub { + return [ 302, [ Location => '/cgi-bin/koha/' . ( $is_intranet ? 'mainpage.pl' : 'opac-main.pl' ) ], [] ]; + }; + }; +} + +=head2 multi_site($env, $sites) + + App wrapper for per virtual host scenario. + + C<$env>: + { + opac => { + static_root => '/usr/share/koha/opac/htdocs', + script_root => '/usr/share/koha/opac/cgi-bin/opac', + pugins => [ + [ 'StackTrace' ], + ], + }, + intranet => { + static_root => '/usr/share/koha/intranet/htdocs', + script_root => '/usr/share/koha/cgi-bin' + } + } + C<$sites>: + { + namespace => 'koha1', + opac_hostname => 'koha1-opac.com', + intranet_hostname => 'koha1-intranet.com', + config => '/etc/koha/sites/koha1/koha-conf.xml', + shared_config => 1 + }, + { + namespace => 'koha2', + opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'], + intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'], + config => '/etc/koha/sites/koha2/koha-conf.xml' + }, + ... + + koha.psgi: + + Koha::Handler::Plack::CGI->multi_site( \%koha_app_env, \@sites ); + +=cut + +my $DUMMY_KOHA_CONF = "DUMMY"; +sub multi_site { + my $class = shift; + my $env = shift or croak "No Koha env details"; + my $sites = shift or croak "No sites spec"; + + my ($opac_app, $intranet_app); + + if (my $opac = $env->{opac}) { + $opac_app = $class->app('opac', $opac); + } + + if (my $intranet = $env->{intranet}) { + $intranet_app = $class->app('intranet', $intranet); + } + + my @host_def = map { + my $namespace = $_->{namespace} or croak "No namespace"; + my $config = $_->{config} or croak "Site without config"; + my $shared_context = $_->{shared_context}; + + my $context = C4::Context->new($config, $namespace); + + my @hd; + if (my $hostname = $_->{opac_hostname}) { + croak "You have OPAC hosts without OPAC env details" unless $opac_app; + push @hd, { + hostname => $hostname, + app => sub { + # XXX this may need some rethinking + local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF; + local $ENV{MEMCACHED_NAMESPACE} = $namespace; + + $opac_app->(@_); + }, + context => $context, + shared_context => $shared_context, + }; + } + if (my $hostname = $_->{intranet_hostname}) { + croak "You have Intranet hosts without Intranet env details" unless $intranet_app; + push @hd, { + hostname => $hostname, + app => sub { + # XXX this may need some rethinking + local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF; + local $ENV{MEMCACHED_NAMESPACE} = $namespace; + + $intranet_app->(@_); + }, + context => $context, + shared_context => $shared_context, + }; + } + @hd; + } @$sites; + + return $class->app_per_host( \@host_def ); +} + +1; diff --git a/about.pl b/about.pl index 1fd28e4..e41759f 100755 --- a/about.pl +++ b/about.pl @@ -131,7 +131,7 @@ my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active) my @xml_config_warnings; -my $context = new C4::Context; +my $context = C4::Context->current; if ( ! defined C4::Context->config('zebra_bib_index_mode') ) { push @xml_config_warnings, { diff --git a/admin/systempreferences.pl b/admin/systempreferences.pl index 67e0638..861508f 100755 --- a/admin/systempreferences.pl +++ b/admin/systempreferences.pl @@ -387,7 +387,7 @@ output_html_with_http_headers $input, $cookie, $template->output; # .pref files. sub get_prefs_from_files { - my $context = C4::Context->new(); + my $context = C4::Context->current(); my $path_pref_en = $context->config('intrahtdocs') . '/prog/en/modules/admin/preferences'; # Get all .pref file names diff --git a/misc/cronjobs/check-url.pl b/misc/cronjobs/check-url.pl index 71885ab..2869446 100755 --- a/misc/cronjobs/check-url.pl +++ b/misc/cronjobs/check-url.pl @@ -190,7 +190,7 @@ sub check_all_url { my $checker = C4::URL::Checker->new($timeout,$agent); $checker->{ host_default } = $host; - my $context = new C4::Context( ); + my $context = C4::Context->current(); my $dbh = $context->dbh; my $sth = $dbh->prepare( "SELECT biblionumber FROM biblioitems WHERE url <> ''" ); diff --git a/misc/plack/koha-multi.psgi b/misc/plack/koha-multi.psgi new file mode 100644 index 0000000..dbf09e6 --- /dev/null +++ b/misc/plack/koha-multi.psgi @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use Koha::Handler::Plack::CGI; + +# If modules are not in a standard location +# use lib '/usr/share/koha/lib' or set PERL5LIB or plackup -I + +# This is a minimal example. You can include all frills from koha.psgi +# To try it: +# plackup --port 5010 koha-multi.psgi + +my %KOHA_ENV = ( + opac => { + static_root => '/usr/share/koha/opac/htdocs', + script_root => '/usr/share/koha/opac/cgi-bin/opac', + pugins => [ + # don't enable this plugin in production, since stack traces reveal too much information + # about system to potential attackers! + [ 'StackTrace' ], + ], + }, + intranet => { + static_root => '/usr/share/koha/intranet/htdocs', + script_root => '/usr/share/koha/intranet/cgi-bin', + } +); +my @SITES = map { + namespace => $_, + opac_hostname => "opac.$_.my-koha-multisite.net", + intranet_hostname => "intranet.$_.my-koha-multisite.net", + config => "/etc/koha/sites/$_/koha-conf.xml" +}, qw(koha1 koha2 koha3); + +Koha::Handler::Plack::CGI->multi_site( \%KOHA_ENV, \@SITES ); diff --git a/misc/translator/LangInstaller.pm b/misc/translator/LangInstaller.pm index cd947fc..78c5821 100644 --- a/misc/translator/LangInstaller.pm +++ b/misc/translator/LangInstaller.pm @@ -56,7 +56,7 @@ sub new { my $self = { }; - my $context = C4::Context->new(); + my $context = C4::Context->current(); $self->{context} = $context; $self->{path_pref_en} = $context->config('intrahtdocs') . '/prog/en/modules/admin/preferences'; @@ -140,7 +140,7 @@ sub new { sub po_filename { my $self = shift; - my $context = C4::Context->new; + my $context = C4::Context->current(); my $trans_path = $Bin . '/po'; my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po"; return $trans_file; diff --git a/t/Koha_Handler_Plack.t b/t/Koha_Handler_Plack.t new file mode 100644 index 0000000..8172940 --- /dev/null +++ b/t/Koha_Handler_Plack.t @@ -0,0 +1,136 @@ +#!/usr/bin/perl + +use Test::More tests => 15; +use Plack::Test; +use Plack::Test::MockHTTP; +use Test::Mock::LWP::Dispatch; +use Test::MockModule; +use HTTP::Request::Common; +use FindBin qw($Bin); +use Data::Dumper; + +use_ok("Koha::Handler::Plack"); +use_ok("Koha::Handler::Plack::CGI"); + +use C4::Context; + +my $db = Test::MockModule->new('Koha::Database'); +$db->mock( + _new_schema => sub { + return $_[0]; + } +); + +sub make_response { + return join ";", map defined($_) ? $_ : "", @_; +} +sub dummy_val { + return C4::Context->config("dummy"); +} +sub check_context { + my $dummy_val = dummy_val(); + is $dummy_val, undef, "context preserved" + or diag("dummy val: $dummy_val"); +} + +my $app = sub { + return [ + 200, + [ 'Content-Type' => 'text/plain' ], + [ make_response(dummy_val()) ] + ]; +}; +my $generic_url = "http://dummyhost.com/"; + +my $KOHA_CONF_XML = < + + test + XML + . + + +EOS + +my @HOST_CONF = ( + { + hostname => ['koha-file.com', 'www.koha-file.com'], + app => $app, + context => C4::Context->new("$Bin/conf/koha1/koha-conf.xml"), + _dummy => "KOHA1" + }, + { + hostname => ['koha-xml.com', 'www.koha-xml.com'], + app => $app, + context => C4::Context->new(\$KOHA_CONF_XML), + _dummy => "XML" + }, +); +test_psgi + app => Koha::Handler::Plack->app_per_host(\@HOST_CONF), + client => sub { + my $cb = shift; + + foreach my $site_params ( @HOST_CONF ) { + my $valid_response = make_response( + $site_params->{_dummy} + ); + foreach (@{$site_params->{hostname}}) { + my $res = $cb->(GET "http://$_/"); + is $res->content, $valid_response, $_ + or diag(Dumper($site_params, $_, $res->as_string)); + check_context(); + } + } + + $res = $cb->(GET $generic_url); + is $res->code, 404, "app_per_host unknown host" + or diag($res->as_string); + }; + +my %MULTI_HOST_ENV = ( + opac => { + static_root => "$Bin/../koha-tmpl/opac-tmpl/bootstrap", + script_root => "$Bin/../opac", + }, + intranet => { + static_root => "$Bin/../koha-tmpl/intranet-tmpl/bootstrap", + script_root => "$Bin/.." + } +); +my @MULTI_HOST_SITES = ( + { + namespace => 'koha1', + opac_hostname => ['opac.koha1.com', 'www.opac.koha1.com'], + intranet_hostname => ['intranet.koha1.com', 'www.intranet.koha1.com'], + config => "$Bin/conf/koha1/koha-conf.xml", + }, + { + namespace => 'koha2', + opac_hostname => ['opac.koha2.com', 'www.opac.koha2.com'], + intranet_hostname => ['intranet.koha2.com', 'www.intranet.koha2.com'], + config => "$Bin/conf/koha2/koha-conf.xml", + shared_context => 1, + }, +); +test_psgi + app => Koha::Handler::Plack::CGI->multi_site(\%MULTI_HOST_ENV, \@MULTI_HOST_SITES), + client => sub { + my $cb = shift; + + foreach my $site (@MULTI_HOST_SITES) { + my $opac = $site->{opac_hostname}; + foreach my $host (@$opac) { +# this is not really a test, but cannot do any better atm +# TODO: a complex test involving two database connections + my $res = $cb->(GET "http://$host/"); + # A future implementation may not redirect + if ($res->is_redirect) { + my $loc = $res->header("Location"); + $res = $cb->(GET "http://$host$loc"); + } + is $res->code, 500, "multi_site() $host" + or diag($res->as_string); + } + } + }; diff --git a/t/conf/dummy/koha-conf.xml b/t/conf/dummy/koha-conf.xml new file mode 100644 index 0000000..d4c96b0 --- /dev/null +++ b/t/conf/dummy/koha-conf.xml @@ -0,0 +1,7 @@ + + + dummy + DUMMY + . + + diff --git a/t/conf/koha1/koha-conf.xml b/t/conf/koha1/koha-conf.xml new file mode 100644 index 0000000..371d039 --- /dev/null +++ b/t/conf/koha1/koha-conf.xml @@ -0,0 +1,7 @@ + + + koha1 + KOHA1 + . + + diff --git a/t/conf/koha2/koha-conf.xml b/t/conf/koha2/koha-conf.xml new file mode 100644 index 0000000..437e772 --- /dev/null +++ b/t/conf/koha2/koha-conf.xml @@ -0,0 +1,5 @@ + + + KOHA2 + + diff --git a/t/db_dependent/Amazon.t b/t/db_dependent/Amazon.t index 2304073..a5b316f 100755 --- a/t/db_dependent/Amazon.t +++ b/t/db_dependent/Amazon.t @@ -14,7 +14,7 @@ BEGIN { use_ok('C4::External::Amazon'); } -my $context = C4::Context->new(); +my $context = C4::Context->current(); my $locale = $context->preference('AmazonLocale'); diff --git a/t/db_dependent/Context.t b/t/db_dependent/Context.t index 5a75acd..36ef4d7 100755 --- a/t/db_dependent/Context.t +++ b/t/db_dependent/Context.t @@ -51,7 +51,7 @@ C4::Context->clear_syspref_cache(); C4::Context->enable_syspref_cache(); $dbh->rollback; -ok($koha = C4::Context->new, 'C4::Context->new'); +ok($koha = C4::Context->current, 'C4::Context->current'); my @keys = keys %$koha; my $width = 0; if (ok(@keys)) { diff --git a/t/db_dependent/Template/Plugin/KohaDates.t b/t/db_dependent/Template/Plugin/KohaDates.t index fe18836..2088347 100644 --- a/t/db_dependent/Template/Plugin/KohaDates.t +++ b/t/db_dependent/Template/Plugin/KohaDates.t @@ -14,7 +14,7 @@ BEGIN { my $module_context = new Test::MockModule('C4::Context'); my $date = "1973-05-21"; -my $context = C4::Context->new(); +my $context = C4::Context->current(); my $filter = Koha::Template::Plugin::KohaDates->new(); ok ($filter, "new()"); diff --git a/t/db_dependent/XISBN.t b/t/db_dependent/XISBN.t index 2f6d63b..45e01dd 100755 --- a/t/db_dependent/XISBN.t +++ b/t/db_dependent/XISBN.t @@ -26,7 +26,7 @@ my $search_module = new Test::MockModule('C4::Search'); $search_module->mock('SimpleSearch', \&Mock_SimpleSearch ); -my $context = C4::Context->new; +my $context = C4::Context->current; my ( $biblionumber_tag, $biblionumber_subfield ) = GetMarcFromKohaField( 'biblio.biblionumber', '' ); diff --git a/t/db_dependent/sysprefs.t b/t/db_dependent/sysprefs.t index 340e89a..07552f1 100755 --- a/t/db_dependent/sysprefs.t +++ b/t/db_dependent/sysprefs.t @@ -19,7 +19,7 @@ # along with Koha; if not, see . use Modern::Perl; -use Test::More tests => 8; +use Test::More tests => 11; use C4::Context; # Start transaction @@ -60,4 +60,15 @@ is(C4::Context->preference('testpreference'), 'def', 'caching preferences'); C4::Context->clear_syspref_cache(); is(C4::Context->preference('testpreference'), undef, 'clearing preference cache'); +delete $ENV{OVERRIDE_SYSPREF_opacheader}; + +my $DUMMY_KOHA_CONF = "DUMMY"; +my $context1 = C4::Context->new($DUMMY_KOHA_CONF, "context1"); +is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"'); + +my $context2 = C4::Context->new($DUMMY_KOHA_CONF, "context2"); +$context2->set_preference( 'opacheader', $newopacheader ); +is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"'); +is( $context2->preference('opacheader'), $newopacheader, 'context2 "opacheader"'); + $dbh->rollback; -- 2.7.4
Apache $versions{apacheVersion}