356 lines
9.3 KiB
Perl
356 lines
9.3 KiB
Perl
=head1 NAME
|
|
|
|
Dam::Application
|
|
|
|
=head1 DECRIPTION
|
|
|
|
Initialization of the default global variables and definition of the entry point
|
|
for the predefined and customized run modes created using the Dam framework.
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
package Dam::Application;
|
|
|
|
use base 'CGI::Application';
|
|
|
|
use CGI qw(-utf8);
|
|
use Authen::Simple::ActiveDirectory;
|
|
use Crypt::Tea_JS;
|
|
use String::Random qw(random_string);
|
|
use Date::Calc qw(Today_and_Now);
|
|
|
|
use Dam::Util;
|
|
use Dam::Debug;
|
|
use Dam::Database;
|
|
use Dam::DamLogic qw(
|
|
is_report is_download Show__error_403 Show__about Show
|
|
Session__new Session__flush Session__close
|
|
User__is_logged_in User__access
|
|
cgiapp_param cgiapp_cookie cgiapp_header_add cgiapp_header_props
|
|
_t package_config tmpl_core
|
|
);
|
|
use Dam::Var;
|
|
|
|
my %CURRENT_PACKAGE = ();
|
|
|
|
|
|
|
|
sub pre__session_user_params {
|
|
my ($CGIAPP, $uid) = @_;
|
|
return ();
|
|
}
|
|
|
|
|
|
|
|
sub pre__load_stylesheets {
|
|
}
|
|
|
|
|
|
|
|
sub pre__load_javascripts {
|
|
}
|
|
|
|
|
|
|
|
sub setup {
|
|
my $CGIAPP = shift;
|
|
|
|
RESERVED(CGIAPP => $CGIAPP);
|
|
|
|
# Connect to database:
|
|
RESERVED(DBH => database_connect(
|
|
DB_DSN => CONFIG('DB_DSN'),
|
|
DB_USER => CONFIG('DB_USER'),
|
|
DB_PASSWORD => CONFIG('DB_PASSWORD')
|
|
));
|
|
|
|
my @run_modes = (
|
|
'APP_login',
|
|
'APP_confirm',
|
|
'RUN_home',
|
|
'RUN_report',
|
|
'RUN_error403',
|
|
'RUN_close'
|
|
);
|
|
|
|
if (User__is_logged_in()) {
|
|
my %ROUTES = %{CONFIG('REF_ROUTES')};
|
|
my @user_access = User__access();
|
|
foreach my $menu (sort keys(%ROUTES)) {
|
|
__setup_run_modes(\@run_modes, \%{$ROUTES{$menu}{OPTIONS}}, \@user_access);
|
|
}
|
|
}
|
|
$CGIAPP->run_modes(\@run_modes);
|
|
$CGIAPP->start_mode('RUN_home');
|
|
|
|
# The template directory is initialized:
|
|
$CGIAPP->tmpl_path(CONFIG('DIR_TEMPLATES'));
|
|
|
|
# Enable file uploads:
|
|
$CGIAPP::DISABLE_UPLOADS = 0;
|
|
$CGIAPP::POST_SIZE = CONFIG('UPLOAD_MAX_FILESIZE');
|
|
}
|
|
|
|
|
|
|
|
sub teardown {
|
|
# Discconnect from database:
|
|
database_disconnect();
|
|
}
|
|
|
|
|
|
|
|
sub cgiapp_prerun {
|
|
my ($CGIAPP, $run_mode) = @_;
|
|
|
|
my $binmode = 1;
|
|
cgiapp_header_props(
|
|
-charset => 'UTF-8'
|
|
);
|
|
if (!is_eq(substr($run_mode, 0, 4), 'APP_')) {
|
|
if (User__is_logged_in()) {
|
|
if (!is_eq(substr($run_mode, 0, 4), 'RUN_')) {
|
|
# 1. Get the user access permissions:
|
|
my @user_access = User__access();
|
|
|
|
# 2. Debugging mode is disabled if user is not a developer:
|
|
CONFIG('DEBUG_MODE' => 0) if !in_array(0, \@user_access);
|
|
|
|
# 3. Load report:
|
|
my %ROUTES = %{CONFIG('REF_ROUTES')};
|
|
foreach my $menu (sort (%ROUTES)) {
|
|
%CURRENT_PACKAGE = __search_run_mode($run_mode, \%{$ROUTES{$menu}{OPTIONS}});
|
|
if (%CURRENT_PACKAGE) {
|
|
$CURRENT_PACKAGE{ID} = $ROUTES{$menu}{ID};
|
|
RESERVED('REF_CURRENT_PACKAGE' => \%CURRENT_PACKAGE);
|
|
last;
|
|
}
|
|
}
|
|
|
|
# 4. Check if user has access permission to the current report:
|
|
if (!defined($CURRENT_PACKAGE{ACCESS}) || match_arrays(\@user_access, $CURRENT_PACKAGE{ACCESS})) {
|
|
# 5. Check if it's a download:
|
|
if (is_download()) {
|
|
my ($download_mode, $filename_extension) = split(',', cgiapp_param('dm'));
|
|
my $package = $run_mode;
|
|
my @packages = split('::', $run_mode);
|
|
if (scalar(@packages) > 1) {
|
|
$package = pop(@packages);
|
|
$package = pop(@packages) if is_eq($package, $CURRENT_PACKAGE{RUN});
|
|
}
|
|
my $filename = strval($package, '_', $download_mode, '-', sprintf("%04d%02d%02d_%02d%02d%02d", Today_and_Now()), '.', $filename_extension);
|
|
cgiapp_header_props(
|
|
-type => 'application/x-download',
|
|
-Content_Disposition => strval('attachment; filename="', $filename, '"')
|
|
);
|
|
$binmode = 0;
|
|
}
|
|
elsif (!is_report()) {
|
|
$CGIAPP->prerun_mode('RUN_report');
|
|
}
|
|
}
|
|
else {
|
|
$CGIAPP->prerun_mode('RUN_error403');
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$CGIAPP->prerun_mode('APP_login');
|
|
}
|
|
}
|
|
binmode STDOUT, ":utf8" if $binmode;
|
|
}
|
|
|
|
|
|
|
|
sub cgiapp_postrun {
|
|
DROP_TEMP_TABLES(); # Drop temporal database tables
|
|
Session__flush(); # Synchronize the session with the database
|
|
}
|
|
|
|
|
|
|
|
sub APP_login {
|
|
return __login();
|
|
}
|
|
|
|
|
|
|
|
sub APP_confirm {
|
|
my $user = lc cgiapp_param('user');
|
|
my $pass = decrypt(cgiapp_param('pass'), cgiapp_param('key'));
|
|
|
|
# Check if the user exists (according to input parameters):
|
|
my $user_db = QUERY(SELECT(
|
|
FIELDS => 'user_uid, user_password, user_firstname, user_name, user_access, user_active',
|
|
FROM => 'users',
|
|
WHERE => COMPARE_STR('BINARY user_login', '=', $user)
|
|
));
|
|
|
|
# User not registered. Request the login again:
|
|
return __login($user, 1) if $user_db->rows == 0;
|
|
|
|
my @user_data = $user_db->fetchrow_array();
|
|
|
|
# Non-active user. Show warning message:
|
|
return __login($user, 2, _t('User not active!'), _t('Consult with your systems manager to activate your user')) if $user_data[5] eq 0;
|
|
|
|
# Check if user is in the Active Directory:
|
|
my $ad = Authen::Simple::ActiveDirectory->new(host => CONFIG('LDAP_DOMAIN'), principal => CONFIG('LDAP_DOMAIN'), timeout => 20);
|
|
if (!$ad->authenticate($user, $pass)) {
|
|
# Unidentified user. Or is it a local user:
|
|
my $passcrypt = __crypt_password($pass);
|
|
# Unidentified user. Request the login again:
|
|
return __login($user, 3) if !defined($user_data[1]) || $user_data[1] ne $passcrypt;
|
|
}
|
|
|
|
# Validated user. Login with user settings:
|
|
Session__new($user_data[0], $user_data[2], $user_data[3], $user_data[4], RESERVED('CGIAPP')->pre__session_user_params($user_data[0]));
|
|
|
|
# Show home page:
|
|
return RUN_home();
|
|
}
|
|
|
|
|
|
|
|
sub RUN_home {
|
|
return Show__about();
|
|
}
|
|
|
|
|
|
|
|
sub RUN_report {
|
|
return Show();
|
|
}
|
|
|
|
|
|
|
|
sub RUN_error403 {
|
|
return Show__error_403();
|
|
}
|
|
|
|
|
|
|
|
sub RUN_close {
|
|
Session__close(); # Delete the user session
|
|
return __login(); # Return to the login form
|
|
}
|
|
|
|
|
|
# PRIVATE FUNCTIONS:
|
|
|
|
|
|
sub __setup_run_modes {
|
|
my ($run_modes_ref, $options_ref, $user_access_ref) = @_;
|
|
|
|
my $superuser = in_array(0, $user_access_ref);
|
|
foreach my $option (sort keys(%$options_ref)) {
|
|
next if !is_eq(ref($$options_ref{$option}), 'HASH') && is_eq($$options_ref{$option}, _DIVIDER_);
|
|
if (defined($$options_ref{$option}{OPTIONS})) {
|
|
__setup_run_modes($run_modes_ref, \%{$$options_ref{$option}{OPTIONS}}, $user_access_ref);
|
|
}
|
|
else {
|
|
next if is_empty($$options_ref{$option}{PACKAGE}) && is_empty($$options_ref{$option}{RUN});
|
|
next if defined($$options_ref{$option}{ENABLED}) && $$options_ref{$option}{ENABLED} == 0;
|
|
next unless $superuser || (defined($$options_ref{$option}{ACCESS}) && match_arrays($user_access_ref, $$options_ref{$option}{ACCESS}));
|
|
|
|
my $run_mode = strval_trio($$options_ref{$option}{PACKAGE}, '::', defined($$options_ref{$option}{RUN}) ? $$options_ref{$option}{RUN} : 'Run');
|
|
fatal('Duplicated "', $run_mode, '" run mode.') if in_array($run_mode, $run_modes_ref);
|
|
push(@$run_modes_ref, $run_mode);
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
|
|
sub __search_run_mode {
|
|
my ($run_mode, $options_ref) = @_;
|
|
|
|
foreach my $option (sort keys(%$options_ref)) {
|
|
next if !is_eq(ref($$options_ref{$option}), 'HASH') && is_eq($$options_ref{$option}, _DIVIDER_);
|
|
if (defined($$options_ref{$option}{OPTIONS})) {
|
|
my %search_option = __search_run_mode($run_mode, \%{$$options_ref{$option}{OPTIONS}});
|
|
return %search_option if %search_option;
|
|
}
|
|
else {
|
|
next if is_empty($$options_ref{$option}{PACKAGE}) && is_empty($$options_ref{$option}{RUN});
|
|
next if !is_eq($run_mode, strval_trio($$options_ref{$option}{PACKAGE}, '::', defined($$options_ref{$option}{RUN}) ? $$options_ref{$option}{RUN} : 'Run'));
|
|
return package_config(\%{$$options_ref{$option}});
|
|
}
|
|
}
|
|
return ();
|
|
}
|
|
|
|
|
|
|
|
sub __login {
|
|
my ($login, $error, $error_title, $error_message) = @_;
|
|
|
|
cgiapp_header_add(-cookie => cgiapp_cookie(CGISESSID => ''));
|
|
|
|
my $tmpl_login = tmpl_core('Login',
|
|
APP_NAME => CONFIG('APP_NAME'),
|
|
KEY => random_string('ssssssssssssssssssssssssssssss'),
|
|
LOGIN => $login,
|
|
CRYPT_TEA => tea_in_javascript(),
|
|
|
|
T_USERNAME => _t('Username'),
|
|
T_PASSWORD => _t('Password'),
|
|
T_LOGIN => _t('Login')
|
|
);
|
|
|
|
if (defined($error)) {
|
|
$tmpl_login->param(
|
|
ERROR => $error,
|
|
ERROR_TITLE => defined($error_title) ? $error_title : _t('Access error!'),
|
|
ERROR_MESSAGE => defined($error_message) ? $error_message : _t('Verify username and retype password')
|
|
);
|
|
}
|
|
|
|
return Show(DISPLAY => 'PAGE', TITLE => 'Login', TEMPLATE => $tmpl_login);
|
|
}
|
|
|
|
|
|
|
|
sub __crypt_password {
|
|
my $password = shift;
|
|
return length($password) ? crypt($password, substr(crypt($password, 'CRTSGR'), -2, 2)) : '';
|
|
}
|
|
|
|
|
|
|
|
1;
|
|
|
|
=head1 AUTHOR
|
|
|
|
Manuel Cillero C<< <manuel@cillero.es> >>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
The MIT License (MIT)
|
|
|
|
Copyright (c) 2004-2020 Manuel Cillero. All rights reserved.
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy
|
|
of this software and associated documentation files (the "Software"), to deal
|
|
in the Software without restriction, including without limitation the rights
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
|
copies of the Software, and to permit persons to whom the Software is
|
|
furnished to do so, subject to the following conditions:
|
|
|
|
The above copyright notice and this permission notice shall be included in all
|
|
copies or substantial portions of the Software.
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
|
SOFTWARE.
|
|
|
|
=cut
|