kivitendo/SL/Dispatcher.pm @ a21cec52
| 94899fc9 | Moritz Bunkus | package SL::Dispatcher;
|
||
use strict;
|
||||
| bbb67c4a | Moritz Bunkus | # Force scripts/locales.pl to parse these templates:
|
||
# parse_html_template('login_screen/auth_db_unreachable')
|
||||
# parse_html_template('login_screen/user_login')
|
||||
# parse_html_template('generic/error')
|
||||
| ee71d315 | Moritz Bunkus | use Carp;
|
||
| 94899fc9 | Moritz Bunkus | use CGI qw( -no_xhtml);
|
||
| f04a7950 | Moritz Bunkus | use Config::Std;
|
||
| cad439ef | Moritz Bunkus | use DateTime;
|
||
| f04a7950 | Moritz Bunkus | use Encode;
|
||
| 94899fc9 | Moritz Bunkus | use English qw(-no_match_vars);
|
||
| a680ea0c | Moritz Bunkus | use FCGI;
|
||
| 77ee93fc | Moritz Bunkus | use File::Basename;
|
||
| a680ea0c | Moritz Bunkus | use IO::File;
|
||
| 77ee93fc | Moritz Bunkus | use List::MoreUtils qw(all);
|
||
use List::Util qw(first);
|
||||
| 497b9801 | Moritz Bunkus | use POSIX qw(setlocale);
|
||
| fab47672 | Moritz Bunkus | use SL::ArchiveZipFixes;
|
||
| 94899fc9 | Moritz Bunkus | use SL::Auth;
|
||
| 6afd06ad | Moritz Bunkus | use SL::Dispatcher::AuthHandler;
|
||
| 94899fc9 | Moritz Bunkus | use SL::LXDebug;
|
||
| 67b21d42 | Moritz Bunkus | use SL::LxOfficeConf;
|
||
| 94899fc9 | Moritz Bunkus | use SL::Locale;
|
||
| b9740e8a | Moritz Bunkus | use SL::ClientJS;
|
||
| 94899fc9 | Moritz Bunkus | use SL::Common;
|
||
| 12dadc47 | Sven Schöling | use SL::Form;
|
||
| cad439ef | Moritz Bunkus | use SL::Helper::DateTime;
|
||
| 891411c1 | Moritz Bunkus | use SL::InstanceConfiguration;
|
||
| a4c8924a | Bernd Bleßmann | use SL::MoreCommon qw(uri_encode);
|
||
| e257fa36 | Moritz Bunkus | use SL::Template::Plugin::HTMLFixes;
|
||
| 313367d3 | Moritz Bunkus | use SL::User;
|
||
| 94899fc9 | Moritz Bunkus | |||
| bcc99615 | Moritz Bunkus | use Rose::Object::MakeMethods::Generic (
|
||
scalar => [ qw(restart_after_request) ],
|
||||
);
|
||||
| b2945bf6 | Sven Schöling | # Trailing new line is added so that Perl will not add the line
|
||
# number 'die' was called in.
|
||||
use constant END_OF_REQUEST => "END-OF-REQUEST\n";
|
||||
| 77ee93fc | Moritz Bunkus | my %fcgi_file_cache;
|
||
| 23f79a87 | Moritz Bunkus | sub new {
|
||
my ($class, $interface) = @_;
|
||||
my $self = bless {}, $class;
|
||||
$self->{interface} = lc($interface || 'cgi');
|
||||
| 6afd06ad | Moritz Bunkus | $self->{auth_handler} = SL::Dispatcher::AuthHandler->new;
|
||
| 23f79a87 | Moritz Bunkus | |||
| fab47672 | Moritz Bunkus | SL::ArchiveZipFixes->apply_fixes;
|
||
| 497b9801 | Moritz Bunkus | # Initialize character type locale to be UTF-8 instead of C:
|
||
foreach my $locale (qw(de_DE.UTF-8 en_US.UTF-8)) {
|
||||
last if setlocale('LC_CTYPE', $locale);
|
||||
}
|
||||
| 23f79a87 | Moritz Bunkus | return $self;
|
||
}
|
||||
| bb800c52 | Moritz Bunkus | sub interface_type {
|
||
my ($self) = @_;
|
||||
return $self->{interface} eq 'cgi' ? 'CGI' : 'FastCGI';
|
||||
}
|
||||
| d8ac0828 | Moritz Bunkus | sub is_admin_request {
|
||
my %params = @_;
|
||||
return ($params{script} eq 'admin.pl') || (($params{routing_type} eq 'controller') && ($params{script_name} eq 'Admin'));
|
||||
}
|
||||
| 94899fc9 | Moritz Bunkus | sub pre_request_checks {
|
||
| d8ac0828 | Moritz Bunkus | my (%params) = @_;
|
||
| f416a998 | Moritz Bunkus | _check_for_old_config_files();
|
||
| d8ac0828 | Moritz Bunkus | if (!$::auth->session_tables_present && !is_admin_request(%params)) {
|
||
show_error('login_screen/auth_db_unreachable');
|
||||
| 879abbad | Sven Schöling | }
|
||
| 8c6871be | Moritz Bunkus | |||
if ($::request->type !~ m/^ (?: html | js | json ) $/x) {
|
||||
die $::locale->text("Invalid request type '#1'", $::request->type);
|
||||
}
|
||||
| 94899fc9 | Moritz Bunkus | }
|
||
| 99601196 | Moritz Bunkus | sub pre_request_initialization {
|
||
my ($self, %params) = @_;
|
||||
$self->unrequire_bin_mozilla;
|
||||
$::locale = Locale->new($::lx_office_conf{system}->{language});
|
||||
$::form = Form->new;
|
||||
$::instance_conf = SL::InstanceConfiguration->new;
|
||||
$::request = SL::Request->new(
|
||||
cgi => CGI->new({}),
|
||||
layout => SL::Layout::None->new,
|
||||
);
|
||||
my $session_result = $::auth->restore_session;
|
||||
$::auth->create_or_refresh_session;
|
||||
if ($params{client}) {
|
||||
$::auth->set_client($params{client}) || die("cannot find client " . $params{client});
|
||||
if ($params{login}) {
|
||||
die "cannot find user " . $params{login} unless %::myconfig = $::auth->read_user(login => $params{login});
|
||||
die "cannot find locale for user " . $params{login} unless $::locale = Locale->new($::myconfig{countrycode});
|
||||
$::form->{login} = $params{login}; # normaly implicit at login
|
||||
}
|
||||
}
|
||||
return $session_result;
|
||||
}
|
||||
| b9740e8a | Moritz Bunkus | sub render_error_ajax {
|
||
my ($error) = @_;
|
||||
SL::ClientJS->new
|
||||
->error($error)
|
||||
->render(SL::Controller::Base->new);
|
||||
}
|
||||
| 94899fc9 | Moritz Bunkus | sub show_error {
|
||
$::lxdebug->enter_sub;
|
||||
| 881cc205 | Moritz Bunkus | my $template = shift;
|
||
my $error_type = shift || '';
|
||||
| 6afd06ad | Moritz Bunkus | my %params = @_;
|
||
| 881cc205 | Moritz Bunkus | |||
| 540c0b5e | Moritz Bunkus | $::myconfig{countrycode} = delete($params{countrycode}) || $::lx_office_conf{system}->{language};
|
||
$::locale = Locale->new($::myconfig{countrycode});
|
||||
| 881cc205 | Moritz Bunkus | $::form->{error} = $::locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
|
||
| 540c0b5e | Moritz Bunkus | $::form->{error} = $::locale->text('Incorrect password!') if ($error_type eq 'password');
|
||
| 63b5c301 | Moritz Bunkus | $::form->{error} = $::locale->text('The action is missing or invalid.') if ($error_type eq 'action');
|
||
| 94899fc9 | Moritz Bunkus | |||
| b9740e8a | Moritz Bunkus | return render_error_ajax($::form->{error}) if $::request->is_ajax;
|
||
| 7647d46a | Moritz Bunkus | $::form->header;
|
||
| 6afd06ad | Moritz Bunkus | print $::form->parse_html_template($template, \%params);
|
||
| 94899fc9 | Moritz Bunkus | $::lxdebug->leave_sub;
|
||
| 09479f02 | Moritz Bunkus | end_request();
|
||
| 94899fc9 | Moritz Bunkus | }
|
||
sub pre_startup_setup {
|
||||
| 77ee93fc | Moritz Bunkus | my ($self) = @_;
|
||
| 67b21d42 | Moritz Bunkus | SL::LxOfficeConf->read;
|
||
| ed7bfc4a | Moritz Bunkus | |||
| 94899fc9 | Moritz Bunkus | eval {
|
||
package main;
|
||||
require "bin/mozilla/common.pl";
|
||||
require "bin/mozilla/installationcheck.pl";
|
||||
} or die $EVAL_ERROR;
|
||||
| 1c8bbb4e | Sven Schöling | # canonial globals. if it's not here, chances are it will get refactored someday.
|
||
| 94899fc9 | Moritz Bunkus | {
|
||
no warnings 'once';
|
||||
| 1c8bbb4e | Sven Schöling | $::lxdebug = LXDebug->new;
|
||
| a0945527 | Sven Schöling | $::auth = SL::Auth->new;
|
||
| 1c8bbb4e | Sven Schöling | $::form = undef;
|
||
| 772f08d0 | Sven Schöling | $::request = undef;
|
||
| 313367d3 | Moritz Bunkus | %::myconfig = User->get_default_myconfig;
|
||
| 94899fc9 | Moritz Bunkus | }
|
||
| 847d924b | Sven Schöling | |||
$SIG{__WARN__} = sub {
|
||||
$::lxdebug->warn(@_);
|
||||
| 77ee93fc | Moritz Bunkus | };
|
||
| ee71d315 | Moritz Bunkus | $SIG{__DIE__} = sub { Carp::confess( @_ ) } if $::lx_office_conf{debug}->{backtrace_on_die};
|
||
| 77ee93fc | Moritz Bunkus | $self->_cache_file_modification_times;
|
||
| 94899fc9 | Moritz Bunkus | }
|
||
sub pre_startup_checks {
|
||||
::verify_installation();
|
||||
}
|
||||
sub pre_startup {
|
||||
| 77ee93fc | Moritz Bunkus | my ($self) = @_;
|
||
$self->pre_startup_setup;
|
||||
$self->pre_startup_checks;
|
||||
| 94899fc9 | Moritz Bunkus | }
|
||
sub require_main_code {
|
||||
| 193b1e4e | Sven Schöling | $::lxdebug->enter_sub;
|
||
| 94899fc9 | Moritz Bunkus | my ($script, $suffix) = @_;
|
||
eval {
|
||||
package main;
|
||||
require "bin/mozilla/$script$suffix";
|
||||
} or die $EVAL_ERROR;
|
||||
if (-f "bin/mozilla/custom_$script$suffix") {
|
||||
eval {
|
||||
package main;
|
||||
require "bin/mozilla/custom_$script$suffix";
|
||||
};
|
||||
$::form->error($EVAL_ERROR) if ($EVAL_ERROR);
|
||||
}
|
||||
| d4f9d559 | Moritz Bunkus | if ($::form->{login} && -f "bin/mozilla/$::form->{login}_$script") {
|
||
| 94899fc9 | Moritz Bunkus | eval {
|
||
package main;
|
||||
| d4f9d559 | Moritz Bunkus | require "bin/mozilla/$::form->{login}_$script";
|
||
| 94899fc9 | Moritz Bunkus | };
|
||
$::form->error($EVAL_ERROR) if ($EVAL_ERROR);
|
||||
}
|
||||
| 193b1e4e | Sven Schöling | $::lxdebug->leave_sub;
|
||
| 94899fc9 | Moritz Bunkus | }
|
||
| 41400107 | Moritz Bunkus | sub _require_controller {
|
||
my $controller = shift;
|
||||
$controller =~ s|[^A-Za-z0-9_]||g;
|
||||
| 6afd06ad | Moritz Bunkus | $controller = "SL/Controller/${controller}";
|
||
| 41400107 | Moritz Bunkus | |||
eval {
|
||||
package main;
|
||||
| 6afd06ad | Moritz Bunkus | require "${controller}.pm";
|
||
| 41400107 | Moritz Bunkus | } or die $EVAL_ERROR;
|
||
}
|
||||
sub _run_controller {
|
||||
"SL::Controller::$_[0]"->new->_run_action($_[1]);
|
||||
}
|
||||
| a680ea0c | Moritz Bunkus | sub handle_all_requests {
|
||
my ($self) = @_;
|
||||
my $request = FCGI::Request();
|
||||
while ($request->Accept() >= 0) {
|
||||
$self->handle_request($request);
|
||||
| bcc99615 | Moritz Bunkus | |||
| 253d7562 | Sven Schöling | $self->restart_after_request(1) if $self->_interface_is_fcgi && SL::System::Process::memory_usage_is_too_high();
|
||
| bcc99615 | Moritz Bunkus | $request->LastCall if $self->restart_after_request;
|
||
| a680ea0c | Moritz Bunkus | }
|
||
| 24f6b9ed | Moritz Bunkus | |||
| bcc99615 | Moritz Bunkus | exec $0 if $self->restart_after_request;
|
||
| a680ea0c | Moritz Bunkus | }
|
||
| 94899fc9 | Moritz Bunkus | sub handle_request {
|
||
| 7a0da5ac | Moritz Bunkus | my $self = shift;
|
||
$self->{request} = shift;
|
||||
| 23f79a87 | Moritz Bunkus | |||
| 94899fc9 | Moritz Bunkus | $::lxdebug->enter_sub;
|
||
$::lxdebug->begin_request;
|
||||
| 41400107 | Moritz Bunkus | my ($script, $path, $suffix, $script_name, $action, $routing_type);
|
||
| 94899fc9 | Moritz Bunkus | |||
| 99601196 | Moritz Bunkus | my $session_result = $self->pre_request_initialization;
|
||
| 75f69249 | Moritz Bunkus | |||
$::form->read_cgi_input;
|
||||
| 8c6871be | Moritz Bunkus | my %routing;
|
||
| 63b5c301 | Moritz Bunkus | eval { %routing = $self->_route_request($ENV{SCRIPT_NAME}); 1; } or return;
|
||
| 8c6871be | Moritz Bunkus | ($routing_type, $script_name, $action) = @routing{qw(type controller action)};
|
||
| e8557567 | Sven Schöling | $::lxdebug->log_request($routing_type, $script_name, $action);
|
||
| 8c6871be | Moritz Bunkus | |||
$::request->type(lc($routing{request_type} || 'html'));
|
||||
| 7a604472 | Moritz Bunkus | |||
| 41400107 | Moritz Bunkus | if ($routing_type eq 'old') {
|
||
$::form->{action} = lc $::form->{action};
|
||||
$::form->{action} =~ s/( |-|,|\#)/_/g;
|
||||
| 94899fc9 | Moritz Bunkus | |||
| 41400107 | Moritz Bunkus | ($script, $path, $suffix) = fileparse($script_name, ".pl");
|
||
| cb347e6a | Moritz Bunkus | require_main_code($script, $suffix) unless $script eq 'admin';
|
||
| 41400107 | Moritz Bunkus | |||
$::form->{script} = $script . $suffix;
|
||||
} else {
|
||||
_require_controller($script_name);
|
||||
$::form->{script} = "controller.pl";
|
||||
}
|
||||
| 94899fc9 | Moritz Bunkus | |||
eval {
|
||||
| d8ac0828 | Moritz Bunkus | pre_request_checks(script => $script, action => $action, routing_type => $routing_type, script_name => $script_name);
|
||
| 579d651f | Moritz Bunkus | |||
| 66c08b64 | Moritz Bunkus | if ( SL::System::InstallationLock->is_locked
|
||
| d8ac0828 | Moritz Bunkus | && !is_admin_request(script => $script, script_name => $script_name, routing_type => $routing_type)) {
|
||
$::form->error($::locale->text('System currently down for maintenance!'));
|
||||
}
|
||||
| cb114b28 | Moritz Bunkus | |||
| a54282a9 | Moritz Bunkus | # For compatibility with a lot of database upgrade scripts etc:
|
||
# Re-write request to old 'login.pl?action=login' to new
|
||||
# 'LoginScreen' controller. Make sure to load its code!
|
||||
if (($script eq 'login') && ($action eq 'login')) {
|
||||
($routing_type, $script, $script_name, $action) = qw(controller controller LoginScreen login);
|
||||
_require_controller('LoginScreen');
|
||||
}
|
||||
| 540c0b5e | Moritz Bunkus | |||
| a85404a4 | Moritz Bunkus | if ( (($script eq 'login') && !$action)
|
||
|| ($script eq 'admin')
|
||||
|| (SL::Auth::SESSION_EXPIRED() == $session_result)) {
|
||||
| a4c8924a | Bernd Bleßmann | $self->handle_login_error(routing_type => $routing_type,
|
||
script => $script,
|
||||
controller => $script_name,
|
||||
action => $action,
|
||||
error => 'session');
|
||||
| a85404a4 | Moritz Bunkus | }
|
||
| eb8ba476 | Sven Schöling | |||
| a85404a4 | Moritz Bunkus | my %auth_result = $self->{auth_handler}->handle(
|
||
routing_type => $routing_type,
|
||||
script => $script,
|
||||
controller => $script_name,
|
||||
action => $action,
|
||||
);
|
||||
| 94899fc9 | Moritz Bunkus | |||
| 09479f02 | Moritz Bunkus | $self->end_request unless $auth_result{auth_ok};
|
||
| 0e451e1b | Moritz Bunkus | |||
| a85404a4 | Moritz Bunkus | delete @{ $::form }{ grep { m/^\{AUTH\}/ } keys %{ $::form } } unless $auth_result{keep_auth_vars};
|
||
| 670f76a8 | Moritz Bunkus | |||
| a85404a4 | Moritz Bunkus | if ($action) {
|
||
$::form->set_standard_title;
|
||||
if ($routing_type eq 'old') {
|
||||
::call_sub('::' . $::locale->findsub($action));
|
||||
| aa2bdd23 | Moritz Bunkus | } else {
|
||
| a85404a4 | Moritz Bunkus | _run_controller($script_name, $action);
|
||
| aa2bdd23 | Moritz Bunkus | }
|
||
| a85404a4 | Moritz Bunkus | } else {
|
||
$::form->error($::locale->text('action= not defined!'));
|
||||
| 94899fc9 | Moritz Bunkus | }
|
||
1;
|
||||
} or do {
|
||||
| 620cb63e | Moritz Bunkus | if (substr($EVAL_ERROR, 0, length(END_OF_REQUEST())) ne END_OF_REQUEST()) {
|
||
| b9740e8a | Moritz Bunkus | my $error = $EVAL_ERROR;
|
||
print STDERR $error;
|
||||
if ($::request->is_ajax) {
|
||||
eval { render_error_ajax($error) };
|
||||
} else {
|
||||
$::form->{label_error} = $::request->{cgi}->pre($error);
|
||||
chdir SL::System::Process::exe_dir;
|
||||
eval { show_error('generic/error') };
|
||||
}
|
||||
| b2945bf6 | Sven Schöling | }
|
||
| 94899fc9 | Moritz Bunkus | };
|
||
| 2219d158 | Sven Schöling | $::form->footer;
|
||
| 70242f1e | Sven Schöling | if ($self->_interface_is_fcgi) {
|
||
# fcgi? send send reponse on its way before cleanup.
|
||||
$self->{request}->Flush;
|
||||
$self->{request}->Finish;
|
||||
}
|
||||
| 028cd4a6 | Moritz Bunkus | $::lxdebug->end_request(routing_type => $routing_type, script_name => $script_name, action => $action);
|
||
| 70242f1e | Sven Schöling | |||
| 94899fc9 | Moritz Bunkus | # cleanup
|
||
| e0ba33ff | Moritz Bunkus | $::auth->save_session;
|
||
| 91c07c66 | Sven Schöling | $::auth->expire_sessions;
|
||
$::auth->reset;
|
||||
| 94899fc9 | Moritz Bunkus | $::locale = undef;
|
||
$::form = undef;
|
||||
| 0c1b51b8 | Sven Schöling | %::myconfig = ();
|
||
| 772f08d0 | Sven Schöling | $::request = undef;
|
||
| 835e3fd9 | Sven Schöling | |||
SL::DBConnect::Cache->reset_all;
|
||||
| 94899fc9 | Moritz Bunkus | |||
| 77ee93fc | Moritz Bunkus | $self->_watch_for_changed_files;
|
||
| 94899fc9 | Moritz Bunkus | $::lxdebug->leave_sub;
|
||
}
|
||||
| 2a496ad8 | Moritz Bunkus | sub reply_with_json_error {
|
||
| 63b5c301 | Moritz Bunkus | my ($self, %params) = @_;
|
||
| 2a496ad8 | Moritz Bunkus | |||
my %errors = (
|
||||
session => { code => '401 Unauthorized', text => 'session expired' },
|
||||
password => { code => '401 Unauthorized', text => 'incorrect username or password' },
|
||||
action => { code => '400 Bad request', text => 'incorrect or missing action' },
|
||||
access => { code => '403 Forbidden', text => 'no permissions for accessing this function' },
|
||||
_default => { code => '500 Internal server error', text => 'general server-side error' },
|
||||
);
|
||||
my $error = $errors{$params{error}} // $errors{_default};
|
||||
my $reply = SL::JSON::to_json({ status => 'failed', error => $error->{text} });
|
||||
print $::request->cgi->header(
|
||||
-type => 'application/json',
|
||||
-charset => 'utf-8',
|
||||
-status => $error->{code},
|
||||
);
|
||||
print $reply;
|
||||
$self->end_request;
|
||||
}
|
||||
sub handle_login_error {
|
||||
my ($self, %params) = @_;
|
||||
return $self->reply_with_json_error(error => $params{error}) if $::request->type eq 'json';
|
||||
| 63b5c301 | Moritz Bunkus | my $action = ($params{script} // '') =~ m/^admin/i ? 'Admin/login' : 'LoginScreen/user_login';
|
||
$action .= '&error=' . $params{error} if $params{error};
|
||||
| a4c8924a | Bernd Bleßmann | my $redirect_url = "controller.pl?action=${action}";
|
||
| a21cec52 | Bernd Bleßmann | if ( $action =~ m/LoginScreen\/user_login/
|
||
&& $params{action}
|
||||
&& 'get' eq lc($ENV{REQUEST_METHOD})
|
||||
) {
|
||||
| a4c8924a | Bernd Bleßmann | require SL::Controller::Base;
|
||
my $controller = SL::Controller::Base->new;
|
||||
delete $params{error};
|
||||
| a21cec52 | Bernd Bleßmann | delete $params{routing_type};
|
||
| a4c8924a | Bernd Bleßmann | delete @{ $::form }{ grep { m/^\{AUTH\}/ } keys %{ $::form } };
|
||
| a21cec52 | Bernd Bleßmann | |||
| a4c8924a | Bernd Bleßmann | my $callback = $controller->url_for(%params, %{$::form});
|
||
$redirect_url .= '&callback=' . uri_encode($callback);
|
||||
}
|
||||
print $::request->cgi->redirect($redirect_url);
|
||||
| 09479f02 | Moritz Bunkus | $self->end_request;
|
||
| d8ac0828 | Moritz Bunkus | }
|
||
| 94899fc9 | Moritz Bunkus | sub unrequire_bin_mozilla {
|
||
| 23f79a87 | Moritz Bunkus | my $self = shift;
|
||
| 2a19f220 | Moritz Bunkus | return unless $self->_interface_is_fcgi;
|
||
| 9ea6d163 | Sven Schöling | |||
| 94899fc9 | Moritz Bunkus | for (keys %INC) {
|
||
next unless m#^bin/mozilla/#;
|
||||
next if /\bcommon.pl$/;
|
||||
next if /\binstallationcheck.pl$/;
|
||||
delete $INC{$_};
|
||||
}
|
||||
}
|
||||
| 2a19f220 | Moritz Bunkus | sub _interface_is_fcgi {
|
||
my $self = shift;
|
||||
return $self->{interface} =~ m/^(?:fastcgi|fcgid|fcgi)$/;
|
||||
}
|
||||
| 7a604472 | Moritz Bunkus | sub _route_request {
|
||
| 63b5c301 | Moritz Bunkus | my ($self, $script_name) = @_;
|
||
| 7a604472 | Moritz Bunkus | |||
| 63b5c301 | Moritz Bunkus | return $script_name =~ m/dispatcher\.pl$/ ? (type => 'old', $self->_route_dispatcher_request)
|
||
: $script_name =~ m/controller\.pl/ ? (type => 'controller', $self->_route_controller_request)
|
||||
| 8c6871be | Moritz Bunkus | : (type => 'old', controller => $script_name, action => $::form->{action});
|
||
| 7a604472 | Moritz Bunkus | }
|
||
sub _route_dispatcher_request {
|
||||
| 63b5c301 | Moritz Bunkus | my ($self) = @_;
|
||
| d8b7e4d0 | Moritz Bunkus | my $name_re = qr{[a-z]\w*};
|
||
| 7a604472 | Moritz Bunkus | my ($script_name, $action);
|
||
eval {
|
||||
| b023a2ad | Geoffrey Richardson | die "Unroutable request -- invalid module name.\n" if !$::form->{M} || ($::form->{M} !~ m/^${name_re}$/);
|
||
| 7a604472 | Moritz Bunkus | $script_name = $::form->{M} . '.pl';
|
||
if ($::form->{A}) {
|
||||
$action = $::form->{A};
|
||||
} else {
|
||||
| d8b7e4d0 | Moritz Bunkus | $action = first { m/^A_${name_re}$/ } keys %{ $::form };
|
||
| b023a2ad | Geoffrey Richardson | die "Unroutable request -- invalid action name.\n" if !$action;
|
||
| 7a604472 | Moritz Bunkus | |||
delete $::form->{$action};
|
||||
$action = substr $action, 2;
|
||||
}
|
||||
delete @{$::form}{qw(M A)};
|
||||
1;
|
||||
} or do {
|
||||
| 5494f687 | Sven Schöling | $::form->{label_error} = $::request->{cgi}->pre($EVAL_ERROR);
|
||
| 7a604472 | Moritz Bunkus | show_error('generic/error');
|
||
};
|
||||
| 8c6871be | Moritz Bunkus | return (controller => $script_name, action => $action);
|
||
| 7a604472 | Moritz Bunkus | }
|
||
| 41400107 | Moritz Bunkus | sub _route_controller_request {
|
||
| 63b5c301 | Moritz Bunkus | my ($self) = @_;
|
||
| 8c6871be | Moritz Bunkus | my ($controller, $action, $request_type);
|
||
| 41400107 | Moritz Bunkus | |||
eval {
|
||||
| 63b5c301 | Moritz Bunkus | # Redirect simple requests to controller.pl without any GET/POST
|
||
# param to the login page.
|
||||
| 2a496ad8 | Moritz Bunkus | $self->handle_login_error(error => 'action') if !$::form->{action};
|
||
| 63b5c301 | Moritz Bunkus | |||
# Show an error if the »action« parameter doesn't match the
|
||||
# pattern »Controller/action«.
|
||||
| b023a2ad | Geoffrey Richardson | $::form->{action} =~ m|^ ( [A-Z] [A-Za-z0-9_]* ) / ( [a-z] [a-z0-9_]* ) ( \. [a-zA-Z]+ )? $|x || die "Unroutable request -- invalid controller/action.\n";
|
||
| 41400107 | Moritz Bunkus | ($controller, $action) = ($1, $2);
|
||
delete $::form->{action};
|
||||
| 8c6871be | Moritz Bunkus | $request_type = $3 ? lc(substr($3, 1)) : 'html';
|
||
| 41400107 | Moritz Bunkus | 1;
|
||
} or do {
|
||||
| 5494f687 | Sven Schöling | $::form->{label_error} = $::request->{cgi}->pre($EVAL_ERROR);
|
||
| 41400107 | Moritz Bunkus | show_error('generic/error');
|
||
};
|
||||
| 8c6871be | Moritz Bunkus | return (controller => $controller, action => $action, request_type => $request_type);
|
||
| 41400107 | Moritz Bunkus | }
|
||
| 77ee93fc | Moritz Bunkus | sub _cache_file_modification_times {
|
||
my ($self) = @_;
|
||||
return unless $self->_interface_is_fcgi && $::lx_office_conf{debug}->{restart_fcgi_process_on_changes};
|
||||
require File::Find;
|
||||
require POSIX;
|
||||
my $wanted = sub {
|
||||
return unless $File::Find::name =~ m/\.(?:pm|f?pl|html|conf|conf\.default)$/;
|
||||
$fcgi_file_cache{ $File::Find::name } = (stat $File::Find::name)[9];
|
||||
};
|
||||
my $cwd = POSIX::getcwd();
|
||||
File::Find::find($wanted, map { "${cwd}/${_}" } qw(config bin SL templates/webpages));
|
||||
map { my $name = "${cwd}/${_}"; $fcgi_file_cache{$name} = (stat $name)[9] } qw(admin.pl dispatcher.fpl);
|
||||
}
|
||||
sub _watch_for_changed_files {
|
||||
my ($self) = @_;
|
||||
return unless $self->_interface_is_fcgi && $::lx_office_conf{debug}->{restart_fcgi_process_on_changes};
|
||||
my $ok = all { (stat($_))[9] == $fcgi_file_cache{$_} } keys %fcgi_file_cache;
|
||||
return if $ok;
|
||||
$::lxdebug->message(LXDebug::DEBUG1(), "Program modifications detected. Restarting.");
|
||||
| bcc99615 | Moritz Bunkus | $self->restart_after_request(1);
|
||
| 77ee93fc | Moritz Bunkus | }
|
||
| 7a0da5ac | Moritz Bunkus | sub get_standard_filehandles {
|
||
my $self = shift;
|
||||
return $self->{interface} =~ m/f(?:ast)cgi/i ? $self->{request}->GetHandles() : (\*STDIN, \*STDOUT, \*STDERR);
|
||||
}
|
||||
| f416a998 | Moritz Bunkus | sub _check_for_old_config_files {
|
||
my @old_files = grep { -f "config/${_}" } qw(authentication.pl console.conf lx-erp.conf lx-erp-local.conf);
|
||||
return unless @old_files;
|
||||
| 540c0b5e | Moritz Bunkus | $::form->{title} = $::locale->text('Old configuration files');
|
||
| f416a998 | Moritz Bunkus | $::form->header;
|
||
| 540c0b5e | Moritz Bunkus | print $::form->parse_html_template('login_screen/old_configuration_files', { FILES => \@old_files });
|
||
| f416a998 | Moritz Bunkus | |||
| 09479f02 | Moritz Bunkus | end_request();
|
||
| f416a998 | Moritz Bunkus | }
|
||
| 09479f02 | Moritz Bunkus | sub end_request {
|
||
| b2945bf6 | Sven Schöling | die SL::Dispatcher->END_OF_REQUEST;
|
||
}
|
||||
| 94899fc9 | Moritz Bunkus | 1;
|