Revision dc50b737
Von Sven Schöling vor mehr als 14 Jahren hinzugefügt
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
fcgi patch test
Conflicts: