SL/Dispatcher.pm

   1 package SL::Dispatcher;
   2
   3 use strict;
   4
   5 BEGIN {
   6   unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
   7   push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
   8   push    @INC, "SL";               # FCGI won't find modules that are not properly named. Help it by inclduging SL
   9 }
  10
  11 use CGI qw( -no_xhtml);
  12 use English qw(-no_match_vars);
  13 use SL::Auth;
  14 use SL::LXDebug;
  15 use SL::Locale;
  16 use SL::Common;
  17 use Form;
  18 use Moose;
  19 use Rose::DB;
  20 use Rose::DB::Object;
  21 use File::Basename;
  22
  23 # Trailing new line is added so that Perl will not add the line
  24 # number 'die' was called in.
  25 use constant END_OF_REQUEST => "END-OF-REQUEST\n";
  26
  27 sub pre_request_checks {
  28   show_error('login/auth_db_unreachable') unless $::auth->session_tables_present;
  29   $::auth->expire_sessions;
  30 }
  31
  32 sub show_error {
  33   $::lxdebug->enter_sub;
  34   my $template             = shift;
  35   my $error_type           = shift || '';
  36
  37   $::locale                = Locale->new($::language);
  38   $::form->{error}         = $::locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
  39   $::form->{error}         = $::locale->text('Incorrect password!.')                   if ($error_type eq 'password');
  40   $::myconfig{countrycode} = $::language;
  41   $::form->{stylesheet}    = 'css/lx-office-erp.css';
  42
  43   $::form->header;
  44   print $::form->parse_html_template($template);
  45   $::lxdebug->leave_sub;
  46
  47   ::end_of_request();
  48 }
  49
  50 sub pre_startup_setup {
  51   eval {
  52     package main;
  53     require "config/lx-erp.conf";
  54   };
  55   eval {
  56     package main;
  57     require "config/lx-erp-local.conf";
  58   } if -f "config/lx-erp-local.conf";
  59
  60   eval {
  61     package main;
  62     require "bin/mozilla/common.pl";
  63     require "bin/mozilla/installationcheck.pl";
  64   } or die $EVAL_ERROR;
  65
  66   # dummy globals
  67   {
  68     no warnings 'once';
  69     $::userspath  = "users";
  70     $::templates  = "templates";
  71     $::memberfile = "users/members";
  72     $::sendmail   = "| /usr/sbin/sendmail -t";
  73     $::lxdebug    = LXDebug->new;
  74     $::auth       = SL::Auth->new;
  75     %::myconfig   = ();
  76   }
  77 }
  78
  79 sub pre_startup_checks {
  80   ::verify_installation();
  81 }
  82
  83 sub pre_startup {
  84   pre_startup_setup();
  85   pre_startup_checks();
  86 }
  87
  88 sub require_main_code {
  89   my ($script, $suffix) = @_;
  90
  91   eval {
  92     package main;
  93     require "bin/mozilla/$script$suffix";
  94   } or die $EVAL_ERROR;
  95
  96   if (-f "bin/mozilla/custom_$script$suffix") {
  97     eval {
  98       package main;
  99       require "bin/mozilla/custom_$script$suffix";
 100     };
 101     $::form->error($EVAL_ERROR) if ($EVAL_ERROR);
 102   }
 103   if ($::form->{login} && -f "bin/mozilla/$::form->{login}_$::form->{script}") {
 104     eval {
 105       package main;
 106       require "bin/mozilla/$::form->{login}_$::form->{script}";
 107     };
 108     $::form->error($EVAL_ERROR) if ($EVAL_ERROR);
 109   }
 110 }
 111
 112 sub handle_request {
 113   $::lxdebug->enter_sub;
 114   $::lxdebug->begin_request;
 115
 116   my $interface = lc(shift || 'cgi');
 117   my $script_name;
 118
 119   if ($interface =~ m/^(?:fastcgi|fcgid|fcgi)$/) {
 120     $script_name = $ENV{SCRIPT_NAME};
 121     unrequire_bin_mozilla();
 122
 123   } else {
 124     $script_name = $0;
 125   }
 126
 127   my ($script, $path, $suffix) = fileparse($script_name, ".pl");
 128   require_main_code($script, $suffix);
 129
 130   $::cgi            = CGI->new('');
 131   $::locale         = Locale->new($::language);
 132   $::form           = Form->new;
 133   $::form->{script} = $script . $suffix;
 134
 135   pre_request_checks();
 136
 137   eval {
 138     if ($script eq 'login' or $script eq 'admin' or $script eq 'kopf') {
 139       $::form->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $::form->{version}";
 140       ::run($::auth->restore_session);
 141
 142     } elsif ($::form->{action}) {
 143       # copy from am.pl routines
 144       $::form->error($::locale->text('System currently down for maintenance!')) if -e "$main::userspath/nologin" && $script ne 'admin';
 145
 146       my $session_result = $::auth->restore_session;
 147
 148       show_error('login/password_error', 'session') if SL::Auth::SESSION_EXPIRED == $session_result;
 149       %::myconfig = $::auth->read_user($::form->{login});
 150
 151       show_error('login/password_error', 'password') unless $::myconfig{login};
 152
 153       $::locale = Locale->new($::myconfig{countrycode});
 154
 155       show_error('login/password_error', 'password') if SL::Auth::OK != $::auth->authenticate($::form->{login}, $::form->{password}, 0);
 156
 157       $::auth->set_session_value('login', $::form->{login}, 'password', $::form->{password});
 158       $::auth->create_or_refresh_session;
 159       delete $::form->{password};
 160
 161       map { $::form->{$_} = $::myconfig{$_} } qw(stylesheet charset)
 162         unless $::form->{action} eq 'save' && $::form->{type} eq 'preferences';
 163
 164       $::form->set_standard_title;
 165       ::call_sub('::' . $::locale->findsub($::form->{action}));
 166
 167     } else {
 168       $::form->error($::locale->text('action= not defined!'));
 169     }
 170
 171     1;
 172   } or do {
 173     if ($EVAL_ERROR ne END_OF_REQUEST) {
 174       $::form->{label_error} = $::cgi->pre($EVAL_ERROR);
 175       eval { show_error('generic/error') };
 176     }
 177   };
 178
 179   # cleanup
 180   $::locale   = undef;
 181   $::form     = undef;
 182   $::myconfig = ();
 183   Form::disconnect_standard_dbh();
 184
 185   $::lxdebug->end_request;
 186   $::lxdebug->leave_sub;
 187 }
 188
 189 sub unrequire_bin_mozilla {
 190   for (keys %INC) {
 191     next unless m#^bin/mozilla/#;
 192     next if /\bcommon.pl$/;
 193     next if /\binstallationcheck.pl$/;
 194     delete $INC{$_};
 195   }
 196 }
 197
 198 package main;
 199
 200 use strict;
 201
 202 sub end_of_request {
 203   die SL::Dispatcher->END_OF_REQUEST;
 204 }
 205
 206 1;