Initial commit
This commit is contained in:
commit
f4bfb0e367
71 changed files with 10399 additions and 0 deletions
357
Dam/Application.pm
Normal file
357
Dam/Application.pm
Normal file
|
@ -0,0 +1,357 @@
|
|||
=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:
|
||||
info($run_mode);
|
||||
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
|
Reference in a new issue