This repository has been archived on 2025-06-22. You can view files and clone it, but you cannot make any changes to it's state, such as pushing and creating new issues, pull requests or comments.
perl-dam/Dam/Application.pm

366 lines
9.6 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 = undef;
if (!is_empty(CONFIG('AD_DOMAIN'))) {
if (!is_empty(CONFIG('AD_SERVER'))) {
$ad = Authen::Simple::ActiveDirectory->new(host => CONFIG('AD_SERVER'), principal => CONFIG('AD_DOMAIN'), timeout => 5);
$ad = undef if !$ad->authenticate($user, $pass);
}
if (!defined($ad)) {
$ad = Authen::Simple::ActiveDirectory->new(host => CONFIG('AD_DOMAIN'), principal => CONFIG('AD_DOMAIN'), timeout => 10);
$ad = undef if !$ad->authenticate($user, $pass);
}
}
# Check if user is local:
if (!defined($ad)) {
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