Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision dc50b737

Von Sven Schöling vor etwa 14 Jahren hinzugefügt

  • ID dc50b737f80c8bd09ac2fbbfa2cc06a04e9d8753
  • Vorgänger eb69ed59
  • Nachfolger e9238b7d

fcgi patch test

Conflicts:

am.pl
bin/mozilla/oe.pl

Unterschiede anzeigen:

SL/Form.pm
743 743
  return $cgi->redirect($new_uri);
744 744
}
745 745

  
746
sub set_standard_title {
747
  $::lxdebug->enter_sub;
748
  my $self = shift;
749

  
750
  $self->{titlebar}  = "Lx-Office " . $::locale->text('Version') . " $self->{version}";
751
  $self->{titlebar} .= "- $::myconfig{name}"   if $::myconfig{name};
752
  $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
753

  
754
  $::lxdebug->leave_sub;
755
}
756

  
746 757
sub _prepare_html_template {
747 758
  $main::lxdebug->enter_sub();
748 759

  
......
961 972

  
962 973
  my ($self, $msg) = @_;
963 974

  
964
  if ($self->{callback}) {
965

  
966
    my ($script, $argv) = split(/\?/, $self->{callback}, 2);
967
    $script =~ s|.*/||;
968
    $script =~ s|[^a-zA-Z0-9_\.]||g;
969
    exec("perl", "$script", $argv);
970

  
971
  } else {
975
  if (!$self->{callback}) {
972 976

  
973 977
    $self->info($msg);
974 978
    exit;
975 979
  }
976 980

  
981
#  my ($script, $argv) = split(/\?/, $self->{callback}, 2);
982
#  $script =~ s|.*/||;
983
#  $script =~ s|[^a-zA-Z0-9_\.]||g;
984
#  exec("perl", "$script", $argv);
985

  
986
  print $::form->redirect_header($self->{callback});
987

  
977 988
  $main::lxdebug->leave_sub();
978 989
}
979 990

  
admin.pl
1
login.pl
admin.pl
1
#!/usr/bin/perl
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 FCGI;
12
use CGI qw( -no_xhtml);
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
my ($script, $path, $suffix) = fileparse($0, ".pl");
24
my $request                  = FCGI::Request();
25

  
26
eval { require "config/lx-erp.conf"; };
27
eval { require "config/lx-erp-local.conf"; } if -f "config/lx-erp-local.conf";
28
require "bin/mozilla/common.pl";
29
require "bin/mozilla/installationcheck.pl";
30
require_main_code($script, $suffix);
31

  
32
# dummy globals
33
{
34
  no warnings 'once';
35
  $::userspath  = "users";
36
  $::templates  = "templates";
37
  $::memberfile = "users/members";
38
  $::sendmail   = "| /usr/sbin/sendmail -t";
39
  $::lxdebug    = LXDebug->new;
40
  $::auth       = SL::Auth->new;
41
  %::myconfig   = ();
42
}
43

  
44
_pre_startup_checks();
45

  
46
if ($request->IsFastCGI) {
47
  handle_request() while $request->Accept() >= 0;
48
} else {
49
  handle_request();
50
}
51

  
52
# end
53

  
54
sub handle_request {
55
  $::lxdebug->enter_sub;
56
  $::lxdebug->begin_request;
57
  $::cgi            = CGI->new('');
58
  $::locale         = Locale->new($::language, $script);
59
  $::form           = Form->new;
60
  $::form->{script} = $script . $suffix;
61

  
62
  _pre_request_checks();
63

  
64
  eval {
65
    if ($script eq 'login' or $script eq 'admin' or $script eq 'kopf') {
66
      $::form->{titlebar} = "Lx-Office " . $::locale->text('Version') . " $::form->{version}";
67
      run($::auth->restore_session);
68
    } elsif ($::form->{action}) {
69
      # copy from am.pl routines
70
      $::form->error($::locale->text('System currently down for maintenance!')) if -e "$main::userspath/nologin" && $script ne 'admin';
71

  
72
      my $session_result = $::auth->restore_session;
73

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

  
77
      _show_error('login/password_error', 'password') unless $::myconfig{login};
78

  
79
      $::locale = Locale->new($::myconfig{countrycode}, $script);
80

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

  
83
      $::auth->set_session_value('login', $::form->{login}, 'password', $::form->{password});
84
      $::auth->create_or_refresh_session;
85
      delete $::form->{password};
86

  
87
      map { $::form->{$_} = $::myconfig{$_} } qw(stylesheet charset)
88
        unless $::form->{action} eq 'save' && $::form->{type} eq 'preferences';
89

  
90
      $::form->set_standard_title;
91
      call_sub($::locale->findsub($::form->{action}));
92
    } else {
93
      $::form->error($::locale->text('action= not defined!'));
94
    }
95
  };
96

  
97
  # cleanup
98
  $::locale   = undef;
99
  $::form     = undef;
100
  $::myconfig = ();
101

  
102
  $::lxdebug->end_request;
103
  $::lxdebug->leave_sub;
104
}
105

  
106
sub _pre_request_checks {
107
  _show_error('login/auth_db_unreachable') unless $::auth->session_tables_present;
108
  $::auth->expire_sessions;
109
}
110

  
111
sub _show_error {
112
  $::lxdebug->enter_sub;
113
  my $template           = shift;
114
  my $error_type         = shift;
115
  my $locale             = Locale->new($::language, 'all');
116
  $::form->{error}       = $::locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
117
  $::form->{error}       = $::locale->text('Incorrect password!.')                   if ($error_type eq 'password');
118
  $::myconfig{countrycode} = $::language;
119
  $::form->{stylesheet}    = 'css/lx-office-erp.css';
120

  
121
  $::form->header;
122
  print $::form->parse_html_template($template);
123
  $::lxdebug->leave_sub;
124

  
125
  exit;
126
}
127

  
128
sub _pre_startup_checks {
129
  verify_installation();
130
}
131

  
132
sub require_main_code {
133
  my ($script, $suffix) = @_;
134

  
135
  require "bin/mozilla/$script$suffix";
136

  
137
  if (-f "bin/mozilla/custom_$script$suffix") {
138
    eval { require "bin/mozilla/custom_$script$suffix"; };
139
    $::form->error($@) if ($@);
140
  }
141
  if ($::form->{login} && -f "bin/mozilla/$::form->{login}_$::form->{script}") {
142
    eval { require "bin/mozilla/$::form->{login}_$::form->{script}"; };
143
    $::form->error($@) if ($@);
144
  }
145
}
146

  
147
1;
am.pl
1
#!/usr/bin/perl
2
#
3
######################################################################
4
# SQL-Ledger Accounting
5
# Copyright (C) 2001
6
#
7
#  Author: Dieter Simader
8
#   Email: dsimader@sql-ledger.org
9
#     Web: http://www.sql-ledger.org
10
#
11
#  Contributors:
12
#
13
# This program is free software; you can redistribute it and/or modify
14
# it under the terms of the GNU General Public License as published by
15
# the Free Software Foundation; either version 2 of the License, or
16
# (at your option) any later version.
17
#
18
# This program is distributed in the hope that it will be useful,
19
# but WITHOUT ANY WARRANTY; without even the implied warranty of
20
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21
# GNU General Public License for more details.
22
# You should have received a copy of the GNU General Public License
23
# along with this program; if not, write to the Free Software
24
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25
#######################################################################
26
#
27
# this script is the frontend called from bin/$terminal/$script
28
# all the accounting modules are linked to this script which in
29
# turn execute the same script in bin/$terminal/
30
#
31
#######################################################################
32

  
33
use strict;
34

  
35
BEGIN {
36
  unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
37
  push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
38
}
39

  
40
# setup defaults, DO NOT CHANGE
41
$main::userspath  = "users";
42
$main::templates  = "templates";
43
$main::memberfile = "users/members";
44
$main::sendmail   = "| /usr/sbin/sendmail -t";
45
########## end ###########################################
46

  
47
$| = 1;
48

  
49
use SL::LXDebug;
50
$main::lxdebug = LXDebug->new();
51

  
52
use CGI qw( -no_xhtml);
53
use SL::Auth;
54
use SL::Form;
55
use SL::Locale;
56

  
57
eval { require "config/lx-erp.conf"; };
58
eval { require "config/lx-erp-local.conf"; } if -f "config/lx-erp-local.conf";
59

  
60
our $cgi  = new CGI('');
61
our $form = new Form;
62

  
63
our $auth = SL::Auth->new();
64
if (!$auth->session_tables_present()) {
65
  _show_error('login/auth_db_unreachable');
66
}
67
$auth->expire_sessions();
68
my $session_result = $auth->restore_session();
69

  
70
require "bin/mozilla/common.pl";
71

  
72
if (defined($main::latex) && !defined($main::latex_templates)) {
73
  $main::latex_templates = $main::latex;
74
  undef($main::latex);
75
}
76

  
77
# this prevents most of the tabindexes being created by CGI.
78
# note: most. popup menus and selecttables will still have tabindexes
79
# use common.pl's NTI function to get rid of those
80
local $CGI::TABINDEX = 0;
81

  
82
# name of this script
83
$0 =~ tr/\\/\//;
84
my $pos = rindex $0, '/';
85
my $script = substr($0, $pos + 1);
86

  
87
# we use $script for the language module
88
$form->{script} = $script;
89

  
90
# strip .pl for translation files
91
$script =~ s/\.pl//;
92

  
93
# pull in DBI
94
use DBI;
95

  
96
# locale messages
97
$main::locale = new Locale($main::language, "$script");
98
my $locale = $main::locale;
99

  
100
# did sysadmin lock us out
101
if (-e "$main::userspath/nologin") {
102
  $form->error($locale->text('System currently down for maintenance!'));
103
}
104

  
105
if (SL::Auth::SESSION_EXPIRED == $session_result) {
106
  _show_error('login/password_error', 'session');
107
}
108

  
109
$form->{login} =~ s|.*/||;
110

  
111
%main::myconfig = $auth->read_user($form->{login});
112
my %myconfig = %main::myconfig;
113

  
114
if (!$myconfig{login}) {
115
  _show_error('login/password_error', 'password');
116
}
117

  
118
# locale messages
119
$locale = new Locale "$myconfig{countrycode}", "$script";
120

  
121
if (SL::Auth::OK != $auth->authenticate($form->{login}, $form->{password}, 0)) {
122
  _show_error('login/password_error', 'password');
123
}
124

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

  
128
delete $form->{password};
129

  
130
map { $form->{$_} = $myconfig{$_} } qw(stylesheet charset)
131
  unless (($form->{action} eq 'save') && ($form->{type} eq 'preferences'));
132

  
133
# pull in the main code
134
require "bin/mozilla/$form->{script}";
135

  
136
# customized scripts
137
if (-f "bin/mozilla/custom_$form->{script}") {
138
  eval { require "bin/mozilla/custom_$form->{script}"; };
139
  $form->error($@) if ($@);
140
}
141

  
142
# customized scripts for login
143
if (-f "bin/mozilla/$form->{login}_$form->{script}") {
144
  eval { require "bin/mozilla/$form->{login}_$form->{script}"; };
145
  $form->error($@) if ($@);
146
}
147

  
148
if ($form->{action}) {
149

  
150
  # window title bar, user info
151
  $form->{titlebar} =
152
      "Lx-Office "
153
    . $locale->text('Version')
154
    . " $form->{version} - $myconfig{name} - $myconfig{dbname}";
155

  
156
  call_sub($locale->findsub($form->{action}));
157
} else {
158
  $form->error($locale->text('action= not defined!'));
159
}
160

  
161
sub _show_error {
162
  my $template           = shift;
163
  my $error_type         = shift;
164
  my $locale                = Locale->new($main::language, 'all');
165
  $form->{error}         = $locale->text('The session is invalid or has expired.') if ($error_type eq 'session');
166
  $form->{error}         = $locale->text('Incorrect password!.')                   if ($error_type eq 'password');
167
  $myconfig{countrycode} = $main::language;
168
  $form->{stylesheet}    = 'css/lx-office-erp.css';
169

  
170
  $form->header();
171
  print $form->parse_html_template($template);
172
  exit;
173
}
174

  
175
# end
176

  
am.pl
1
admin.pl
bin/mozilla/admin.pl
57 57

  
58 58
use strict;
59 59

  
60
our $cgi    = new CGI('');
61
our $form   = new Form;
62
our $locale = new Locale $main::language, "admin";
63
our $auth = SL::Auth->new();
64

  
65
if ($auth->session_tables_present()) {
66
  $auth->expire_sessions();
67
  $auth->restore_session();
68
  $auth->set_session_value('rpw', $form->{rpw});
69
}
70

  
71
# customization
72
if (-f "bin/mozilla/custom_$form->{script}") {
73
  eval { require "bin/mozilla/custom_$form->{script}"; };
74
  $form->error($@) if ($@);
75
}
60
our $cgi;
61
our $form;
62
our $locale;
63
our $auth;
76 64

  
77
$form->{stylesheet} = "lx-office-erp.css";
78
$form->{favicon}    = "favicon.ico";
65
sub run {
66
  $::lxdebug->enter_sub;
67
  my $session_result = shift;
79 68

  
80
if ($form->{action}) {
81
  if ($auth->authenticate_root($form->{rpw}, 0) != $auth->OK()) {
82
    $form->{error_message} = $locale->text('Incorrect Password!');
83
    adminlogin();
84
    exit;
85
  }
69
  $cgi    = $::cgi;
70
  $form   = $::form;
71
  $locale = $::locale;
72
  $auth   = $::auth;
86 73

  
87
  $auth->create_or_refresh_session() if ($auth->session_tables_present());
74
  $::auth->set_session_value('rpw', $::form->{rpw}) if $session_result == SL::Auth->SESSION_OK;
88 75

  
89
  call_sub($locale->findsub($form->{action}));
90

  
91
} elsif ($auth->authenticate_root($form->{rpw}, 0) == $auth->OK()) {
92

  
93
  $auth->create_or_refresh_session() if ($auth->session_tables_present());
76
  $form->{stylesheet} = "lx-office-erp.css";
77
  $form->{favicon}    = "favicon.ico";
94 78

  
95
  login();
79
  if ($form->{action}) {
80
    if ($auth->authenticate_root($form->{rpw}, 0) != $auth->OK()) {
81
      $form->{error_message} = $locale->text('Incorrect Password!');
82
      adminlogin();
83
    } else {
84
      $auth->create_or_refresh_session() if ($auth->session_tables_present());
85
      call_sub($locale->findsub($form->{action}));
86
    }
87
  } elsif ($auth->authenticate_root($form->{rpw}, 0) == $auth->OK()) {
96 88

  
97
} else {
98
  # if there are no drivers bail out
99
  $form->error($locale->text('No Database Drivers available!'))
100
    unless (User->dbdrivers);
89
    $auth->create_or_refresh_session() if ($auth->session_tables_present());
101 90

  
102
  adminlogin();
91
    login();
92
  } else {
93
    # if there are no drivers bail out
94
    $form->error($locale->text('No Database Drivers available!'))
95
      unless (User->dbdrivers);
103 96

  
97
    adminlogin();
98
  }
99
  $::lxdebug->leave_sub;
104 100
}
105 101

  
106
1;
107

  
108
# end
109

  
110 102
sub adminlogin {
111 103
  my $form     = $main::form;
112 104
  my $locale   = $main::locale;
bin/mozilla/kopf.pl
1 1
#!/usr/bin/perl
2 2
#
3 3

  
4
$| = 1;
4
#$| = 1;
5 5

  
6
use CGI::Carp qw(fatalsToBrowser);
6
#use CGI::Carp qw(fatalsToBrowser);
7 7

  
8 8
use strict;
9 9

  
10
sub run {
11
  my $session_result = shift;
12

  
10 13
my $form     = $main::form;
11 14
my $locale   = $main::locale;
12 15

  
......
123 126
</html>
124 127
|;
125 128

  
129
}
130

  
131
1;
132

  
126 133
#
bin/mozilla/login.pl
37 37

  
38 38
use strict;
39 39

  
40
# This is required because the am.pl in the root directory
41
# is not scanned by locales.pl:
42
# $form->parse_html_template('login/password_error')
40
our $cgi;
41
our $form;
42
our $locale;
43
our $auth;
43 44

  
44
our $form = new Form;
45
sub run {
46
  $::lxdebug->enter_sub;
47
  my $session_result = shift;
45 48

  
46
if (! -f 'config/authentication.pl') {
47
  show_error('login/authentication_pl_missing');
48
}
49

  
50
our $locale = new Locale $main::language, "login";
51

  
52
our $auth = SL::Auth->new();
53
if (!$auth->session_tables_present()) {
54
  show_error('login/auth_db_unreachable');
55
}
56
$auth->expire_sessions();
57
my $session_result = $main::auth->restore_session();
58

  
59
# customization
60
if (-f "bin/mozilla/custom_$form->{script}") {
61
  eval { require "bin/mozilla/custom_$form->{script}"; };
62
  $form->error($@) if ($@);
63
}
64

  
65
# per login customization
66
if (-f "bin/mozilla/$form->{login}_$form->{script}") {
67
  eval { require "bin/mozilla/$form->{login}_$form->{script}"; };
68
  $form->error($@) if ($@);
69
}
70

  
71
# window title bar, user info
72
$form->{titlebar} = "Lx-Office " . $locale->text('Version') . " $form->{version}";
73

  
74
if (SL::Auth::SESSION_EXPIRED == $session_result) {
75
  $form->{error_message} = $locale->text('The session is invalid or has expired.');
76
  login_screen();
77
  exit;
78
}
79

  
80
my $action = $form->{action};
49
  $cgi    = $::cgi;
50
  $form   = $::form;
51
  $locale = $::locale;
52
  $auth   = $::auth;
81 53

  
82
if (!$action && $auth->{SESSION}->{login}) {
83
  $action = 'login';
84
}
85

  
86
if ($action) {
87
  our %myconfig = $auth->read_user($form->{login}) if ($form->{login});
54
  $form->{stylesheet} = "lx-office-erp.css";
55
  $form->{favicon}    = "favicon.ico";
88 56

  
89
  if (!$myconfig{login} || (SL::Auth::OK != $auth->authenticate($form->{login}, $form->{password}, 0))) {
90
    $form->{error_message} = $locale->text('Incorrect Password!');
57
  if (SL::Auth::SESSION_EXPIRED == $session_result) {
58
    $form->{error_message} = $locale->text('The session is invalid or has expired.');
91 59
    login_screen();
92 60
    exit;
93 61
  }
62
  my $action = $form->{action};
63
  if (!$action && $auth->{SESSION}->{login}) {
64
    $action = 'login';
65
  }
66
  if ($action) {
67
    our %myconfig = $auth->read_user($form->{login}) if ($form->{login});
68

  
69
    if (!$myconfig{login} || (SL::Auth::OK != $auth->authenticate($form->{login}, $form->{password}, 0))) {
70
      $form->{error_message} = $locale->text('Incorrect Password!');
71
      login_screen();
72
    } else {
73
      $auth->set_session_value('login', $form->{login}, 'password', $form->{password});
74
      $auth->create_or_refresh_session();
75

  
76
      $form->{titlebar} .= " - $myconfig{name} - $myconfig{dbname}";
77
      call_sub($locale->findsub($action));
78
    }
79
  } else {
80
    login_screen();
81
  }
94 82

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

  
98
  $form->{titlebar} .= " - $myconfig{name} - $myconfig{dbname}";
99
  call_sub($locale->findsub($action));
100

  
101
} else {
102
  login_screen();
83
  $::lxdebug->leave_sub;
103 84
}
104 85

  
105
1;
106

  
107 86
sub login_screen {
108 87
  $main::lxdebug->enter_sub();
109 88
  my ($msg) = @_;
......
147 126
  my $menu_script = $style_to_script_map{$user->{menustyle}} || '';
148 127

  
149 128
  # made it this far, execute the menu
150
  $form->{callback} = build_std_url("script=menu${menu_script}.pl", 'action=display', "callback=" . $form->escape($form->{callback}));
129
  # standard redirect does not seem to work for this invocation, (infinite loops?)
130
  # do a manual invocation instead
131
#  $form->{callback} = build_std_url("script=menu${menu_script}.pl", 'action=display', "callback=" . $form->escape($form->{callback}));
151 132

  
152 133
  $main::auth->set_cookie_environment_variable();
153 134

  
154
  $form->redirect();
135
  $::form->{script}   = "menu${menu_script}.pl";
136
  $::form->{action}   = 'display';
137
  $::form->{callback} = $::form->escape($::form->{callback});
138

  
139
  require "bin/mozilla/$::form->{script}";
140
  display();
141

  
142
#  $form->redirect();
155 143

  
156 144
  $main::lxdebug->leave_sub();
157 145
}
......
203 191
  exit;
204 192
}
205 193

  
194
1;
195

  
196
__END__
bin/mozilla/oe.pl
51 51
use strict;
52 52

  
53 53
my $print_post;
54
my %TMPL_VAR;
54
our %TMPL_VAR;
55 55

  
56 56
1;
57 57

  
......
302 302
  check_oe_access();
303 303

  
304 304
  # Container for template variables. Unfortunately this has to be
305
  # visible in form_footer too, so my at package level and not here.
305
  # visible in form_footer too, so package local level and not my here.
306 306
  %TMPL_VAR = ();
307 307

  
308 308
  $form->{defaultcurrency} = $form->get_default_currency(\%myconfig);
config/lx-erp.conf
106 106
#
107 107
# Beipiel:
108 108
#   $LXDebug::global_level = LXDebug::TRACE | LXDebug::QUERY;
109
$LXDebug::global_level = LXDebug::NONE;
109
$LXDebug::global_level = LXDebug->NONE;
110 110

  
111 111
# ?berwachung der Inhalte von $form aktiviert oder nicht? Wenn ja,
112 112
# dann k?nnen einzelne Variablen mit
kopf.pl
1
#!/usr/bin/perl
2
#
3

  
4
use strict;
5

  
6
BEGIN {
7
  unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
8
  push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
9
}
10

  
11
use SL::LXDebug;
12
our $lxdebug = LXDebug->new();
13

  
14
use SL::Auth;
15
use SL::Form;
16
use SL::Locale;
17

  
18
eval { require "config/lx-erp.conf"; };
19
eval { require "config/lx-erp-local.conf"; } if (-f "config/lx-erp-local.conf");
20

  
21
our $form = new Form;
22

  
23
our $auth     = SL::Auth->new();
24
if (!$auth->session_tables_present()) {
25
  _show_error('login/auth_db_unreachable');
26
}
27
$auth->expire_sessions();
28
$auth->restore_session();
29

  
30
our %myconfig = $auth->read_user($form->{login});
31

  
32
our $locale = new Locale "$myconfig{countrycode}", "kopf";
33

  
34
delete $form->{password};
35

  
36
eval { require "bin/mozilla/kopf.pl"; };
kopf.pl
1
admin.pl
locale/de/admin
268 268
  'restore_dataset'             => 'restore_dataset',
269 269
  'restore_dataset_start'       => 'restore_dataset_start',
270 270
  'retrieve_partunits'          => 'retrieve_partunits',
271
  'run'                         => 'run',
271 272
  'sales_invoice'               => 'sales_invoice',
272 273
  'save'                        => 'save',
273 274
  'save_group'                  => 'save_group',
login.pl
1
#!/usr/bin/perl
2
#
3
######################################################################
4
# SQL-Ledger Accounting
5
# Copyright (C) 2001
6
#
7
#  Author: Dieter Simader
8
#   Email: dsimader@sql-ledger.org
9
#     Web: http://www.sql-ledger.org
10
#
11
#  Contributors:
12
#
13
# This program is free software; you can redistribute it and/or modify
14
# it under the terms of the GNU General Public License as published by
15
# the Free Software Foundation; either version 2 of the License, or
16
# (at your option) any later version.
17
#
18
# This program is distributed in the hope that it will be useful,
19
# but WITHOUT ANY WARRANTY; without even the implied warranty of
20
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
21
# GNU General Public License for more details.
22
# You should have received a copy of the GNU General Public License
23
# along with this program; if not, write to the Free Software
24
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25
#######################################################################
26
#
27
# this script sets up the terminal and runs the scripts
28
# in bin/$terminal directory
29
# admin.pl is linked to this script
30
#
31
#######################################################################
32

  
33
use strict;
34

  
35
BEGIN {
36
  unshift @INC, "modules/override"; # Use our own versions of various modules (e.g. YAML).
37
  push    @INC, "modules/fallback"; # Only use our own versions of modules if there's no system version.
38
}
39

  
40
# setup defaults, DO NOT CHANGE
41
$main::userspath  = "users";
42
$main::templates  = "templates";
43
$main::memberfile = "users/members";
44
$main::sendmail   = "| /usr/sbin/sendmail -t";
45
########## end ###########################################
46

  
47
$| = 1;
48

  
49
use SL::LXDebug;
50
$main::lxdebug = LXDebug->new();
51

  
52
eval { require "config/lx-erp.conf"; };
53
eval { require "config/lx-erp-local.conf"; } if -f "config/lx-erp-local.conf";
54

  
55
if ($ENV{CONTENT_LENGTH}) {
56
  read(STDIN, $_, $ENV{CONTENT_LENGTH});
57
}
58

  
59
if ($ENV{QUERY_STRING}) {
60
  $_ = $ENV{QUERY_STRING};
61
}
62

  
63
if ($ARGV[0]) {
64
  $_ = $ARGV[0];
65
}
66

  
67
my %form = split /[&=]/;
68

  
69
# fix for apache 2.0 bug
70
map { $form{$_} =~ s/\\$// } keys %form;
71

  
72
# name of this script
73
$0 =~ tr/\\/\//;
74
my $pos = rindex $0, '/';
75
my $script = substr($0, $pos + 1);
76

  
77
$form{login} =~ s|.*/||;
78

  
79
if (-e "$main::userspath/nologin" && $script ne 'admin.pl') {
80
  print "content-type: text/plain
81

  
82
Login disabled!\n";
83

  
84
  exit;
85
}
86

  
87
require "bin/mozilla/installationcheck.pl";
88
verify_installation();
89

  
90
$ARGV[0] = "$_&script=$script";
91
require "bin/mozilla/$script";
92

  
93
# end of main
94

  
login.pl
1
admin.pl

Auch abrufbar als: Unified diff