Merge branch 'master' of lx-office.linet-services.de:lx-office-erp

[mfinanz.git] / SL / Dispatcher.pm

diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm
index 2c0539bb899e2015287cccba63692de1f3063ea4..47c2e2a35cb41d3f56edf222019303445441f236 100644 (file)
--- a/SL/Dispatcher.pm
+++ b/SL/Dispatcher.pm
@@ -5,16 +5,21 @@ use strict;
 BEGIN {
   unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
   push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
 BEGIN {
   unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
   push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.

-  push    @INC, "SL";               # FCGI won't find modules that are not properly named. Help it by inclduging SL

 }
 
 use CGI qw( -no_xhtml);
 }
 
 use CGI qw( -no_xhtml);

+use Config::Std;
+use DateTime;
+use Encode;

 use English qw(-no_match_vars);
 use SL::Auth;
 use SL::LXDebug;
 use English qw(-no_match_vars);
 use SL::Auth;
 use SL::LXDebug;

+use SL::LxOfficeConf;

 use SL::Locale;
 use SL::Common;
 use SL::Locale;
 use SL::Common;

-use Form;
+use SL::Form;
+use SL::Helper::DateTime;
+use SL::Template::Plugin::HTMLFixes;

 use List::Util qw(first);
 use File::Basename;
 
 use List::Util qw(first);
 use File::Basename;
 


@@ -22,7 +27,23 @@ use File::Basename;
 # number 'die' was called in.
 use constant END_OF_REQUEST => "END-OF-REQUEST\n";
 
 # number 'die' was called in.
 use constant END_OF_REQUEST => "END-OF-REQUEST\n";
 

+sub new {
+  my ($class, $interface) = @_;
+
+  my $self           = bless {}, $class;
+  $self->{interface} = lc($interface || 'cgi');
+
+  return $self;
+}
+
+sub interface_type {
+  my ($self) = @_;
+  return $self->{interface} eq 'cgi' ? 'CGI' : 'FastCGI';
+}
+

 sub pre_request_checks {
 sub pre_request_checks {

+  _check_for_old_config_files();
+

   if (!$::auth->session_tables_present) {
     if ($::form->{script} eq 'admin.pl') {
       ::run();
   if (!$::auth->session_tables_present) {
     if ($::form->{script} eq 'admin.pl') {
       ::run();


@@ -31,7 +52,6 @@ sub pre_request_checks {
       show_error('login/auth_db_unreachable');
     }
   }
       show_error('login/auth_db_unreachable');
     }
   }

-  $::auth->expire_sessions;

 }
 
 sub show_error {
 }
 
 sub show_error {


@@ -39,10 +59,10 @@ sub show_error {
   my $template             = shift;
   my $error_type           = shift || '';
 
   my $template             = shift;
   my $error_type           = shift || '';
 

-  $::locale                = Locale->new($::language);
+  $::locale                = Locale->new($::lx_office_conf{system}->{language});

   $::form->{error}         = $::locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
   $::form->{error}         = $::locale->text('Incorrect password!.')                   if ($error_type eq 'password');
   $::form->{error}         = $::locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
   $::form->{error}         = $::locale->text('Incorrect password!.')                   if ($error_type eq 'password');

-  $::myconfig{countrycode} = $::language;
+  $::myconfig{countrycode} = $::lx_office_conf{system}->{language};

   $::form->{stylesheet}    = 'css/lx-office-erp.css';
 
   $::form->header;
   $::form->{stylesheet}    = 'css/lx-office-erp.css';
 
   $::form->header;


@@ -53,14 +73,8 @@ sub show_error {
 }
 
 sub pre_startup_setup {
 }
 
 sub pre_startup_setup {

-  eval {
-    package main;
-    require "config/lx-erp.conf";
-  };
-  eval {
-    package main;
-    require "config/lx-erp-local.conf";
-  } if -f "config/lx-erp-local.conf";
+  SL::LxOfficeConf->read;
+  _init_environment();

 
   eval {
     package main;
 
   eval {
     package main;


@@ -71,11 +85,6 @@ sub pre_startup_setup {
   # canonial globals. if it's not here, chances are it will get refactored someday.
   {
     no warnings 'once';
   # canonial globals. if it's not here, chances are it will get refactored someday.
   {
     no warnings 'once';

-    $::userspath   = "users";
-    $::templates   = "templates";
-    $::memberfile  = "users/members";
-    $::menufile    = "menu.ini";
-    $::sendmail    = "| /usr/sbin/sendmail -t";

     $::lxdebug     = LXDebug->new;
     $::auth        = SL::Auth->new;
     $::form        = undef;
     $::lxdebug     = LXDebug->new;
     $::auth        = SL::Auth->new;
     $::form        = undef;


@@ -123,46 +132,67 @@ sub require_main_code {
   $::lxdebug->leave_sub;
 }
 
   $::lxdebug->leave_sub;
 }
 

+sub _require_controller {
+  my $controller =  shift;
+  $controller    =~ s|[^A-Za-z0-9_]||g;
+
+  eval {
+    package main;
+    require "SL/Controller/${controller}.pm";
+  } or die $EVAL_ERROR;
+}
+
+sub _run_controller {
+  "SL::Controller::$_[0]"->new->_run_action($_[1]);
+}
+

 sub handle_request {
 sub handle_request {

+  my $self         = shift;
+  $self->{request} = shift;
+

   $::lxdebug->enter_sub;
   $::lxdebug->begin_request;
 
   $::lxdebug->enter_sub;
   $::lxdebug->begin_request;
 

-  my $interface = lc(shift || 'cgi');
-  my ($script_name, $action);
+  my ($script, $path, $suffix, $script_name, $action, $routing_type);

 
 

-  if ($interface =~ m/^(?:fastcgi|fcgid|fcgi)$/) {
-    $script_name = $ENV{SCRIPT_NAME};
-    unrequire_bin_mozilla();
+  $script_name = $ENV{SCRIPT_NAME};

 
 

-  } else {
-    $script_name = $0;
-  }
+  $self->unrequire_bin_mozilla;

 
   $::cgi         = CGI->new('');
 
   $::cgi         = CGI->new('');

-  $::locale      = Locale->new($::language);
+  $::locale      = Locale->new($::lx_office_conf{system}->{language});

   $::form        = Form->new;
   %::called_subs = ();
 
   $::form        = Form->new;
   %::called_subs = ();
 

-  eval { ($script_name, $action) = _route_request($script_name); 1; } or return;
+  eval { ($routing_type, $script_name, $action) = _route_request($script_name); 1; } or return;
+
+  if ($routing_type eq 'old') {
+    $::form->{action}  =  lc $::form->{action};
+    $::form->{action}  =~ s/( |-|,|\#)/_/g;

 
 

-  my ($script, $path, $suffix) = fileparse($script_name, ".pl");
-  require_main_code($script, $suffix);
+   ($script, $path, $suffix) = fileparse($script_name, ".pl");
+    require_main_code($script, $suffix);

 
 

-  $::form->{script} = $script . $suffix;
+    $::form->{script} = $script . $suffix;
+
+  } else {
+    _require_controller($script_name);
+    $::form->{script} = "controller.pl";
+  }

 
   pre_request_checks();
 
   eval {
 
   pre_request_checks();
 
   eval {

-    $::form->error($::locale->text('System currently down for maintenance!')) if -e "$::userspath/nologin" && $script ne 'admin';
+    my $session_result = $::auth->restore_session;
+    $::auth->create_or_refresh_session;

 
 

-    if ($script eq 'login' or $script eq 'admin' or $script eq 'kopf') {
-      $::form->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $::form->{version}";
-      ::run($::auth->restore_session);
+    $::form->error($::locale->text('System currently down for maintenance!')) if -e ($::lx_office_conf{paths}->{userspath} . "/nologin") && $script ne 'admin';

 
 

-    } elsif ($action) {
-      # copy from am.pl routines
-      my $session_result = $::auth->restore_session;
+    if ($script eq 'login' or $script eq 'admin') {
+      $::form->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $::form->{version}";
+      ::run($session_result);

 
 

+    } else {

       show_error('login/password_error', 'session') if SL::Auth::SESSION_EXPIRED == $session_result;
       %::myconfig = $::auth->read_user($::form->{login});
 
       show_error('login/password_error', 'session') if SL::Auth::SESSION_EXPIRED == $session_result;
       %::myconfig = $::auth->read_user($::form->{login});
 


@@ -170,20 +200,26 @@ sub handle_request {
 
       $::locale = Locale->new($::myconfig{countrycode});
 
 
       $::locale = Locale->new($::myconfig{countrycode});
 

-      show_error('login/password_error', 'password') if SL::Auth::OK != $::auth->authenticate($::form->{login}, $::form->{password}, 0);
+      show_error('login/password_error', 'password') if SL::Auth::OK != $::auth->authenticate($::form->{login}, $::form->{password});

 
       $::auth->set_session_value('login', $::form->{login}, 'password', $::form->{password});
       $::auth->create_or_refresh_session;
 
       $::auth->set_session_value('login', $::form->{login}, 'password', $::form->{password});
       $::auth->create_or_refresh_session;

+      $::auth->delete_session_value('FLASH');

       delete $::form->{password};
 
       delete $::form->{password};
 

-      map { $::form->{$_} = $::myconfig{$_} } qw(stylesheet charset)
-        unless $action eq 'save' && $::form->{type} eq 'preferences';
-
-      $::form->set_standard_title;
-      ::call_sub('::' . $::locale->findsub($action));
-
-    } else {
-      $::form->error($::locale->text('action= not defined!'));
+      if ($action) {
+        map { $::form->{$_} = $::myconfig{$_} } qw(stylesheet charset)
+          unless $action eq 'save' && $::form->{type} eq 'preferences';
+
+        $::form->set_standard_title;
+        if ($routing_type eq 'old') {
+          ::call_sub('::' . $::locale->findsub($action));
+        } else {
+          _run_controller($script_name, $action);
+        }
+      } else {
+        $::form->error($::locale->text('action= not defined!'));
+      }

     }
 
     1;
     }
 
     1;


@@ -198,13 +234,19 @@ sub handle_request {
   $::locale   = undef;
   $::form     = undef;
   $::myconfig = ();
   $::locale   = undef;
   $::form     = undef;
   $::myconfig = ();

-  Form::disconnect_standard_dbh();
+  Form::disconnect_standard_dbh;
+  $::auth->expire_session_keys->save_session;
+  $::auth->expire_sessions;
+  $::auth->reset;

 
   $::lxdebug->end_request;
   $::lxdebug->leave_sub;
 }
 
 sub unrequire_bin_mozilla {
 
   $::lxdebug->end_request;
   $::lxdebug->leave_sub;
 }
 
 sub unrequire_bin_mozilla {

+  my $self = shift;
+  return unless $self->_interface_is_fcgi;
+

   for (keys %INC) {
     next unless m#^bin/mozilla/#;
     next if /\bcommon.pl$/;
   for (keys %INC) {
     next unless m#^bin/mozilla/#;
     next if /\bcommon.pl$/;


@@ -213,10 +255,17 @@ sub unrequire_bin_mozilla {
   }
 }
 
   }
 }
 

+sub _interface_is_fcgi {
+  my $self = shift;
+  return $self->{interface} =~ m/^(?:fastcgi|fcgid|fcgi)$/;
+}
+

 sub _route_request {
   my $script_name = shift;
 
 sub _route_request {
   my $script_name = shift;
 

-  return $script_name =~ m/dispatcher\.pl$/ ? _route_dispatcher_request() : ($script_name, $::form->{action});
+  return $script_name =~ m/dispatcher\.pl$/ ? ('old',        _route_dispatcher_request())
+       : $script_name =~ m/controller\.pl/  ? ('controller', _route_controller_request())
+       :                                      ('old',        $script_name, $::form->{action});

 }
 
 sub _route_dispatcher_request {
 }
 
 sub _route_dispatcher_request {


@@ -249,6 +298,62 @@ sub _route_dispatcher_request {
   return ($script_name, $action);
 }
 
   return ($script_name, $action);
 }
 

+sub _route_controller_request {
+  my ($controller, $action);
+
+  eval {
+    $::form->{action}      =~ m|^ ( [A-Z] [A-Za-z0-9_]* ) / ( [a-z] [a-z0-9_]* ) $|x || die "Unroutable request -- inavlid controller/action.\n";
+    ($controller, $action) =  ($1, $2);
+    delete $::form->{action};
+
+    1;
+  } or do {
+    $::form->{label_error} = $::cgi->pre($EVAL_ERROR);
+    show_error('generic/error');
+  };
+
+  return ($controller, $action);
+}
+
+sub get_standard_filehandles {
+  my $self = shift;
+
+  return $self->{interface} =~ m/f(?:ast)cgi/i ? $self->{request}->GetHandles() : (\*STDIN, \*STDOUT, \*STDERR);
+}
+
+sub _init_environment {
+  my %key_map = ( lib  => { name => 'PERL5LIB', append_path => 1 },
+                  path => { name => 'PATH',     append_path => 1 },
+                );
+  my $cfg     = $::lx_office_conf{environment} || {};
+
+  while (my ($key, $value) = each %{ $cfg }) {
+    next unless $value;
+
+    my $info = $key_map{$key} || {};
+    $key     = $info->{name}  || $key;
+
+    if ($info->{append_path}) {
+      $value = ':' . $value unless $value =~ m/^:/ || !$ENV{$key};
+      $value = $ENV{$key} . $value;
+    }
+
+    $ENV{$key} = $value;
+  }
+}
+
+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;
+
+  $::form->{title}      = $::locale->text('Old configuration files');
+  $::form->{stylesheet} = 'lx-office-erp.css';
+  $::form->header;
+  print $::form->parse_html_template('login/old_configuration_files', { FILES => \@old_files });
+
+  ::end_of_request();
+}
+

 package main;
 
 use strict;
 package main;
 
 use strict;