X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=bin%2Fmozilla%2Fadmin.pl;h=6d518fcbdef8f871a8388afa0c30b19dd7d46e46;hb=3bdd3642c42ea17756c46e8a5dabd1cf375c29a3;hp=ab34702a6310a335f7122edaa71f813aa35699c7;hpb=4be2d4d2743b062f2249c827121ae0fbeb4dc74f;p=kivitendo-erp.git diff --git a/bin/mozilla/admin.pl b/bin/mozilla/admin.pl index ab34702a6..6d518fcbd 100755 --- a/bin/mozilla/admin.pl +++ b/bin/mozilla/admin.pl @@ -33,16 +33,21 @@ #====================================================================== use DBI; -use CGI; +use Encode; use English qw(-no_match_vars); use Fcntl; use File::Copy; +use File::Find; +use File::Spec; +use Cwd; use IO::File; use POSIX qw(strftime); use Sys::Hostname; use SL::Auth; +use SL::Auth::PasswordPolicy; use SL::Form; +use SL::Iconv; use SL::Mailer; use SL::User; use SL::Common; @@ -52,9 +57,17 @@ use SL::DBUtils; require "bin/mozilla/common.pl"; require "bin/mozilla/admin_groups.pl"; +require "bin/mozilla/admin_printer.pl"; use strict; +# parserhappy(R): + +# $locale->text('periodic') +# $locale->text('income') +# $locale->text('perpetual') +# $locale->text('balance') + our $cgi; our $form; our $locale; @@ -64,29 +77,29 @@ sub run { $::lxdebug->enter_sub; my $session_result = shift; - $cgi = $::cgi; $form = $::form; $locale = $::locale; $auth = $::auth; - $::auth->set_session_value('rpw', $::form->{rpw}) if $session_result == SL::Auth->SESSION_OK; + $::auth->store_root_credentials_in_session($form->{rpw}) if $session_result == SL::Auth->SESSION_OK; $form->{stylesheet} = "lx-office-erp.css"; $form->{favicon} = "favicon.ico"; if ($form->{action}) { - if ($auth->authenticate_root($form->{rpw}, 0) != $auth->OK()) { + if ($auth->authenticate_root($form->{rpw}) != $auth->OK()) { $form->{error_message} = $locale->text('Incorrect Password!'); + $auth->delete_session_value('rpw'); adminlogin(); } else { - $auth->create_or_refresh_session() if ($auth->session_tables_present()); + if ($auth->session_tables_present()) { + $::auth->store_root_credentials_in_session($::form->{rpw}); + delete $::form->{rpw}; + _apply_dbupgrade_scripts(); + } + call_sub($locale->findsub($form->{action})); } - } elsif ($auth->authenticate_root($form->{rpw}, 0) == $auth->OK()) { - - $auth->create_or_refresh_session() if ($auth->session_tables_present()); - - login(); } else { # if there are no drivers bail out $form->error($locale->text('No Database Drivers available!')) @@ -141,10 +154,11 @@ sub check_auth_db_and_tables { ::end_of_request(); } - if (-f $main::memberfile) { + my $memberfile = $::lx_office_conf{paths}->{memberfile}; + if (-f $memberfile) { my $memberdir = ""; - if ($main::memberfile =~ m|^.*/|) { + if ($memberfile =~ m|^.*/|) { $memberdir = $&; } @@ -152,7 +166,7 @@ sub check_auth_db_and_tables { $form->{title} = $locale->text('User data migration'); $form->header(); - print $form->parse_html_template('admin/user_migration', { 'memberfile' => $main::memberfile, + print $form->parse_html_template('admin/user_migration', { 'memberfile' => $memberfile, 'backupdir' => $backupdir }); ::end_of_request(); @@ -176,7 +190,8 @@ sub create_auth_tables { $main::auth->set_session_value('rpw', $form->{rpw}); $main::auth->create_or_refresh_session(); - if (!-f $main::memberfile) { + my $memberfile = $::lx_office_conf{paths}->{memberfile}; + if (!-f $memberfile) { # New installation -- create a standard group with full access my %members; my $group = { @@ -189,6 +204,7 @@ sub create_auth_tables { $main::auth->save_group($group); } + _apply_dbupgrade_scripts(); login(); } @@ -200,7 +216,8 @@ sub migrate_users { my $memberdir = ""; - if ($main::memberfile =~ m|^.*/|) { + my $memberfile = $::lx_office_conf{paths}->{memberfile}; + if ($memberfile =~ m|^.*/|) { $memberdir = $&; } @@ -210,9 +227,9 @@ sub migrate_users { $form->error(sprintf($locale->text('The directory "%s" could not be created:\n%s'), $backupdir, $!)); } - copy $main::memberfile, "users/member-file-migration/members"; + copy $memberfile, "users/member-file-migration/members"; - my $in = IO::File->new($main::memberfile, "r"); + my $in = IO::File->new($memberfile, "r"); $form->error($locale->text('Could not open the old memberfile.')) if (!$in); @@ -263,7 +280,7 @@ sub migrate_users { } } - unlink $main::memberfile; + unlink $memberfile; my @member_list = sort { lc $a->{login} cmp lc $b->{login} } values %members; @@ -335,10 +352,13 @@ sub list_users { delete $members{"root login"}; - map { $_->{templates} =~ s|.*/||; } values %members; + for (values %members) { + $_->{templates} =~ s|.*/||; + $_->{login_url} = $::locale->is_utf8 ? Encode::encode('utf-8-strict', $_->{login}) : $_->{login_url}; + } $form->{title} = "Lx-Office ERP " . $locale->text('Administration'); - $form->{LOCKED} = -e "$main::userspath/nologin"; + $form->{LOCKED} = -e _nologin_file_name(); $form->{MEMBERS} = [ @members{sort { lc $a cmp lc $b } keys %members} ]; $form->header(); @@ -351,15 +371,21 @@ sub add_user { $form->{title} = "Lx-Office ERP " . $locale->text('Administration') . " / " . $locale->text('Add User'); +# Note: Menu Style 'v3' is not compatible to all browsers! +# "menustyle" => "old" sets the HTML Menu to default. my $myconfig = { "vclimit" => 200, "countrycode" => "de", "numberformat" => "1.000,00", "dateformat" => "dd.mm.yy", "stylesheet" => "lx-office-erp.css", - "menustyle" => "v3", + "menustyle" => "old", + dbport => $::auth->{DB_config}->{port} || 5432, + dbuser => $::auth->{DB_config}->{user} || 'lxoffice', + dbhost => $::auth->{DB_config}->{host} || 'localhost', }; + edit_user_form($myconfig); } @@ -402,34 +428,32 @@ sub edit_user_form { } # is there a templates basedir - if (!-d "$main::templates") { - $form->error(sprintf($locale->text("The directory %s does not exist."), $main::templates)); + if (!-d $::lx_office_conf{paths}->{templates}) { + $form->error(sprintf($locale->text("The directory %s does not exist."), $::lx_office_conf{paths}->{templates})); } - opendir TEMPLATEDIR, "$main::templates/." or $form->error("$main::templates : $ERRNO"); + opendir TEMPLATEDIR, $::lx_office_conf{paths}->{templates} or $form->error($::lx_office_conf{paths}->{templates} . " : $ERRNO"); my @all = readdir(TEMPLATEDIR); - my @alldir = sort grep { -d "$main::templates/$_" && !/^\.\.?$/ } @all; - my @allhtml = sort grep { -f "$main::templates/$_" && /\.html$/ } @all; + my @alldir = sort grep { -d ($::lx_office_conf{paths}->{templates} . "/$_") && !/^\.\.?$/ } @all; closedir TEMPLATEDIR; @alldir = grep !/\.(html|tex|sty|odt|xml|txb)$/, @alldir; - @alldir = grep !/^(webpages|\.svn)$/, @alldir; - - @allhtml = reverse grep !/Default/, @allhtml; - push @allhtml, 'Default'; - @allhtml = reverse @allhtml; + @alldir = grep !/^(webpages|print|\.svn)$/, @alldir; $form->{ALL_TEMPLATES} = [ map { { "name", => $_, "selected" => $_ eq $myconfig->{templates} } } @alldir ]; - my $lastitem = $allhtml[0]; - $lastitem =~ s/-.*//g; - $form->{ALL_MASTER_TEMPLATES} = [ { "name" => $lastitem, "selected" => $lastitem eq "German" } ]; - foreach my $item (@allhtml) { - $item =~ s/-.*//g; - next if ($item eq $lastitem); + # mastertemplates + opendir TEMPLATEDIR, "$::lx_office_conf{paths}->{templates}/print" or $form->error("$::lx_office_conf{paths}->{templates}/print" . " : $ERRNO"); + my @allmaster = readdir(TEMPLATEDIR); + closedir TEMPLATEDIR; + + @allmaster = sort grep { -d ("$::lx_office_conf{paths}->{templates}/print" . "/$_") && !/^\.\.?$/ } @allmaster; + @allmaster = reverse grep !/Default/, @allmaster; + push @allmaster, 'Default'; + @allmaster = reverse @allmaster; + foreach my $item (@allmaster) { push @{ $form->{ALL_MASTER_TEMPLATES} }, { "name" => $item, "selected" => $item eq "German" }; - $lastitem = $item; } # css dir has styles that are not intended as general layouts. @@ -488,13 +512,13 @@ sub save_user { } # is there a basedir - if (!-d "$main::templates") { - $form->error(sprintf($locale->text("The directory %s does not exist."), $main::templates)); + if (!-d $::lx_office_conf{paths}->{templates}) { + $form->error(sprintf($locale->text("The directory %s does not exist."), $::lx_office_conf{paths}->{templates})); } # add base directory to $form->{templates} $form->{templates} =~ s|.*/||; - $form->{templates} = "$main::templates/$form->{templates}"; + $form->{templates} = $::lx_office_conf{paths}->{templates} . "/$form->{templates}"; my $myconfig = new User($form->{login}); @@ -512,14 +536,8 @@ sub save_user { $myconfig->save_member(); - if ($main::auth->can_change_password() - && defined $form->{new_password} - && ($form->{new_password} ne '********')) { - $main::auth->change_password($form->{login}, $form->{new_password}); - } - $form->{templates} =~ s|.*/||; - $form->{templates} = "$main::templates/$form->{templates}"; + $form->{templates} = $::lx_office_conf{paths}->{templates} . "/$form->{templates}"; $form->{mastertemplates} =~ s|.*/||; # create user template directory and copy master files @@ -531,25 +549,40 @@ sub save_user { umask(007); # copy templates to the directory - opendir TEMPLATEDIR, "$main::templates/." or $form->error("$main::templates : $ERRNO"); - my @templates = grep /$form->{mastertemplates}.*?\.(html|tex|sty|odt|xml|txb)$/, - readdir TEMPLATEDIR; - closedir TEMPLATEDIR; - - foreach my $file (@templates) { - open(TEMP, "$main::templates/$file") - or $form->error("$main::templates/$file : $ERRNO"); - - $file =~ s/\Q$form->{mastertemplates}\E-//; - open(NEW, ">$form->{templates}/$file") - or $form->error("$form->{templates}/$file : $ERRNO"); - - while (my $line = ) { - print NEW $line; - } - close(TEMP); - close(NEW); + + my $oldcurrdir = getcwd(); + if (!chdir("$::lx_office_conf{paths}->{templates}/print/$form->{mastertemplates}")) { + $form->error("$ERRNO: chdir $::lx_office_conf{paths}->{templates}/print/$form->{mastertemplates}"); } + + my $newdir = File::Spec->catdir($oldcurrdir, $form->{templates}); + + find( + sub + { + next if ($_ eq "."); + + if (-d $_) { + if (!mkdir (File::Spec->catdir($newdir, $File::Find::name))) { + chdir($oldcurrdir); + $form->error("$ERRNO: mkdir $File::Find::name"); + } + } elsif (-l $_) { + if (!symlink (readlink($_), + File::Spec->catfile($newdir, $File::Find::name))) { + chdir($oldcurrdir); + $form->error("$ERRNO: symlink $File::Find::name"); + } + } elsif (-f $_) { + if (!copy($_, File::Spec->catfile($newdir, $File::Find::name))) { + chdir($oldcurrdir); + $form->error("$ERRNO: cp $File::Find::name"); + } + } + }, "./"); + + chdir($oldcurrdir); + } else { $form->error("$ERRNO: $form->{templates}"); } @@ -570,8 +603,20 @@ sub save_user { } } - $form->redirect($locale->text('User saved!')); + if ($main::auth->can_change_password() + && defined $form->{new_password} + && ($form->{new_password} ne '********')) { + my $verifier = SL::Auth::PasswordPolicy->new; + my $result = $verifier->verify($form->{new_password}, 1); + + if ($result != SL::Auth::PasswordPolicy->OK()) { + $form->error($::locale->text('The settings were saved, but the password was not changed.') . ' ' . join(' ', $verifier->errors($result))); + } + $main::auth->change_password($form->{login}, $form->{new_password}); + } + + $form->redirect($locale->text('User saved!')); } sub save_user_as_new { @@ -645,10 +690,10 @@ sub dbselect_source { my $form = $main::form; my $locale = $main::locale; - $form->{dbport} = '5432'; - $form->{dbuser} = 'postgres'; + $form->{dbport} = $::auth->{DB_config}->{port} || 5432; + $form->{dbuser} = $::auth->{DB_config}->{user} || 'lxoffice'; $form->{dbdefault} = 'template1'; - $form->{dbhost} = 'localhost'; + $form->{dbhost} = $::auth->{DB_config}->{host} || 'localhost'; $form->{title} = "Lx-Office ERP / " . $locale->text('Database Administration'); @@ -716,9 +761,8 @@ sub dbupdate { foreach my $i (@update_rows) { restore_form($saved_form); - map { $form->{$_} = $form->{"${_}_${i}"} } qw(dbname dbdriver dbhost dbport dbuser dbpasswd); - - my $controls = parse_dbupdate_controls($form, $form->{dbdriver}); + %::myconfig = (); + map { $form->{$_} = $::myconfig{$_} = $form->{"${_}_${i}"} } qw(dbname dbdriver dbhost dbport dbuser dbpasswd); print $form->parse_html_template("admin/dbupgrade_header"); @@ -726,7 +770,7 @@ sub dbupdate { $form->{$form->{dbname}} = 1; User->dbupdate($form); - User->dbupdate2($form, $controls); + User->dbupdate2($form, SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls); print $form->parse_html_template("admin/dbupgrade_footer"); } @@ -751,12 +795,30 @@ sub create_dataset { } closedir SQLDIR; - my $default_charset = $main::dbcharset; + $form->{ACCOUNTING_METHODS} = []; + foreach my $item ( qw(accrual cash) ) { + push @{ $form->{ACCOUNTING_METHODS} }, { "name" => $item, + "selected" => $item eq "cash" }; + }; + + $form->{INVENTORY_SYSTEMS} = []; + foreach my $item ( qw(perpetual periodic) ) { + push @{ $form->{INVENTORY_SYSTEMS} }, { "name" => $item, + "selected" => $item eq "periodic" }; + }; + + $form->{PROFIT_DETERMINATIONS} = []; + foreach my $item ( qw(balance income) ) { + push @{ $form->{PROFIT_DETERMINATIONS} }, { "name" => $item, + "selected" => $item eq "income" }; + }; + + my $default_charset = $::lx_office_conf{system}->{dbcharset}; $default_charset ||= Common::DEFAULT_CHARSET; my $cluster_encoding = User->dbclusterencoding($form); if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i)) { - if ($main::dbcharset !~ m/^UTF-?8$/i) { + if ($::lx_office_conf{system}->{dbcharset} !~ m/^UTF-?8$/i) { $form->show_generic_error($locale->text('The selected PostgreSQL installation uses UTF-8 as its encoding. ' . 'Therefore you have to configure Lx-Office to use UTF-8 as well.'), 'back_button' => 1); @@ -829,8 +891,8 @@ sub backup_dataset { $form->{title} = "Lx-Office ERP " . $locale->text('Database Administration') . " / " . $locale->text('Backup Dataset'); - if ("$main::pg_dump_exe" eq "DISABLED") { - $form->error($locale->text('Database backups and restorations are disabled in lx-erp.conf.')); + if ($::lx_office_conf{applications}->{pg_dump} eq "DISABLED") { + $form->error($locale->text('Database backups and restorations are disabled in the configuration.')); } my @dbsources = sort User->dbsources($form); @@ -851,10 +913,10 @@ sub backup_dataset_start { $form->{title} = "Lx-Office ERP " . $locale->text('Database Administration') . " / " . $locale->text('Backup Dataset'); - $main::pg_dump_exe ||= "pg_dump"; + my $pg_dump_exe = $::lx_office_conf{applications}->{pg_dump} || "pg_dump"; - if ("$main::pg_dump_exe" eq "DISABLED") { - $form->error($locale->text('Database backups and restorations are disabled in lx-erp.conf.')); + if ("$pg_dump_exe" eq "DISABLED") { + $form->error($locale->text('Database backups and restorations are disabled in the configuration.')); } $form->isblank("dbname", $locale->text('The dataset name is missing.')); @@ -879,7 +941,7 @@ sub backup_dataset_start { push @args, ("-p", $form->{dbport}) if ($form->{dbport}); push @args, $form->{dbname}; - my $cmd = "$main::pg_dump_exe " . join(" ", map { s/\\/\\\\/g; s/\"/\\\"/g; $_ } @args); + my $cmd = "$pg_dump_exe " . join(" ", map { s/\\/\\\\/g; s/\"/\\\"/g; $_ } @args); my $name = "dataset_backup_$form->{dbname}_" . strftime("%Y%m%d", localtime()) . ".tar"; if ($form->{destination} ne "email") { @@ -918,7 +980,7 @@ sub backup_dataset_start { map { $mail->{$_} = $form->{$_} } qw(from to cc subject message); - $mail->{charset} = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET; + $mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; $mail->{attachments} = [ { "filename" => $tmp, "name" => $name } ]; $mail->send(); @@ -938,11 +1000,11 @@ sub restore_dataset { $form->{title} = "Lx-Office ERP " . $locale->text('Database Administration') . " / " . $locale->text('Restore Dataset'); - if ("$main::pg_restore_exe" eq "DISABLED") { - $form->error($locale->text('Database backups and restorations are disabled in lx-erp.conf.')); + if ($::lx_office_conf{applications}->{pg_restore} eq "DISABLED") { + $form->error($locale->text('Database backups and restorations are disabled in the configuration.')); } - my $default_charset = $main::dbcharset; + my $default_charset = $::lx_office_conf{system}->{dbcharset}; $default_charset ||= Common::DEFAULT_CHARSET; $form->{DBENCODINGS} = []; @@ -963,10 +1025,10 @@ sub restore_dataset_start { $form->{title} = "Lx-Office ERP " . $locale->text('Database Administration') . " / " . $locale->text('Restore Dataset'); - $main::pg_restore_exe ||= "pg_restore"; + my $pg_restore_exe = $::lx_office_conf{applications}->{pg_restore} || "pg_restore"; - if ("$main::pg_restore_exe" eq "DISABLED") { - $form->error($locale->text('Database backups and restorations are disabled in lx-erp.conf.')); + if ("$pg_restore_exe" eq "DISABLED") { + $form->error($locale->text('Database backups and restorations are disabled in the configuration.')); } $form->isblank("new_dbname", $locale->text('The dataset name is missing.')); @@ -1052,7 +1114,7 @@ sub restore_dataset_start { push @args, ("-p", $form->{dbport}) if ($form->{dbport}); push @args, $tmp; - my $cmd = "$main::pg_restore_exe " . join(" ", map { s/\\/\\\\/g; s/\"/\\\"/g; $_ } @args); + my $cmd = "$pg_restore_exe " . join(" ", map { s/\\/\\\\/g; s/\"/\\\"/g; $_ } @args); my $in = IO::File->new("$cmd 2>&1 |"); @@ -1084,7 +1146,7 @@ sub unlock_system { my $form = $main::form; my $locale = $main::locale; - unlink "$main::userspath/nologin"; + unlink _nologin_file_name();; $form->{callback} = "admin.pl?action=list_users"; @@ -1096,7 +1158,7 @@ sub lock_system { my $form = $main::form; my $locale = $main::locale; - open(FH, ">$main::userspath/nologin") + open(FH, ">", _nologin_file_name()) or $form->error($locale->text('Cannot create Lock!')); close(FH); @@ -1163,4 +1225,12 @@ sub dispatcher { $form->error($locale->text('No action defined.')); } +sub _apply_dbupgrade_scripts { + ::end_of_request() if SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(1); +} + +sub _nologin_file_name { + return $::lx_office_conf{paths}->{userspath} . '/nologin'; +} + 1;