1 #=====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #=====================================================================
8 # SQL-Ledger Accounting
11 # Author: Dieter Simader
12 # Email: dsimader@sql-ledger.org
13 # Web: http://www.sql-ledger.org
16 # This program is free software; you can redistribute it and/or modify
17 # it under the terms of the GNU General Public License as published by
18 # the Free Software Foundation; either version 2 of the License, or
19 # (at your option) any later version.
21 # This program is distributed in the hope that it will be useful,
22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 # GNU General Public License for more details.
25 # You should have received a copy of the GNU General Public License
26 # along with this program; if not, write to the Free Software
27 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
28 #======================================================================
31 # add/edit/delete users
33 #======================================================================
37 use English qw(-no_match_vars);
45 use POSIX qw(strftime);
49 use SL::Auth::PasswordPolicy;
60 require "bin/mozilla/common.pl";
61 require "bin/mozilla/admin_groups.pl";
62 require "bin/mozilla/admin_printer.pl";
68 # $locale->text('periodic')
69 # $locale->text('income')
70 # $locale->text('perpetual')
71 # $locale->text('balance')
78 my @valid_dateformats = qw(mm/dd/yy dd/mm/yy dd.mm.yy yyyy-mm-dd);
79 my @valid_numberformats = ('1,000.00', '1000.00', '1.000,00', '1000,00');
80 my @all_stylesheets = qw(lx-office-erp.css Mobile.css kivitendo.css);
81 my @all_menustyles = (
82 { id => 'old', title => $::locale->text('Old (on the side)') },
83 { id => 'v3', title => $::locale->text('Top (CSS)') },
84 { id => 'neu', title => $::locale->text('Top (Javascript)') },
88 $::lxdebug->enter_sub;
89 my $session_result = shift;
95 $::request->{layout} = SL::Layout::Dispatcher->new(style => 'admin');
96 $::request->{layout}->use_stylesheet("lx-office-erp.css");
97 $form->{favicon} = "favicon.ico";
99 if ($form->{action}) {
100 if ($auth->authenticate_root($form->{'{AUTH}admin_password'}) != $auth->OK()) {
101 $auth->punish_wrong_login;
102 $form->{error} = $locale->text('Incorrect Password!');
103 $auth->delete_session_value('admin_password');
106 if ($auth->session_tables_present()) {
107 delete $::form->{'{AUTH}admin_password'};
108 _apply_dbupgrade_scripts();
111 call_sub($locale->findsub($form->{action}));
114 # if there are no drivers bail out
115 $form->error($locale->text('No Database Drivers available!'))
116 unless (User->dbdrivers);
120 $::lxdebug->leave_sub;
124 my $form = $main::form;
125 my $locale = $main::locale;
127 $form->{title} = qq|kivitendo $form->{version} | . $locale->text('Administration');
130 print $form->parse_html_template('admin/adminlogin');
134 check_auth_db_and_tables();
139 $main::auth->destroy_session();
143 sub check_auth_db_and_tables {
144 my $form = $main::form;
145 my $locale = $main::locale;
149 map { $params{"db_${_}"} = $main::auth->{DB_config}->{$_} } keys %{ $auth->{DB_config} };
151 $params{admin_password} = $::lx_office_conf{authentication}->{admin_password};
153 if (!$main::auth->check_database()) {
154 $form->{title} = $locale->text('Authentification database creation');
156 print $form->parse_html_template('admin/check_auth_database', \%params);
161 if (!$main::auth->check_tables()) {
162 $form->{title} = $locale->text('Authentification tables creation');
164 print $form->parse_html_template('admin/check_auth_tables', \%params);
171 my $form = $main::form;
173 $main::auth->create_database('superuser' => $form->{db_superuser},
174 'superuser_password' => $form->{db_superuser_password},
175 'template' => $form->{db_template});
179 sub create_auth_tables {
180 my $form = $main::form;
181 my $locale = $main::locale;
183 $main::auth->create_tables();
184 $main::auth->set_session_value('admin_password', $form->{'{AUTH}admin_password'});
185 $main::auth->create_or_refresh_session();
187 my $memberfile = $::lx_office_conf{paths}->{memberfile};
188 if (!-f $memberfile) {
189 # New installation -- create a standard group with full access
192 'name' => $locale->text('Full Access'),
193 'description' => $locale->text('Full access to all functions'),
194 'rights' => { map { $_ => 1 } SL::Auth::all_rights() },
195 'members' => [ map { $_->{id} } values %members ],
198 $main::auth->save_group($group);
201 _apply_dbupgrade_scripts();
206 my $form = $main::form;
207 my $locale = $main::locale;
209 my %members = $main::auth->read_all_users();
211 delete $members{"root login"};
213 for (values %members) {
214 $_->{templates} =~ s|.*/||;
215 $_->{login_url} = $::locale->is_utf8 ? Encode::encode('utf-8-strict', $_->{login}) : $_->{login_url};
218 $form->{title} = "kivitendo " . $locale->text('Administration');
219 $form->{LOCKED} = -e _nologin_file_name();
220 $form->{MEMBERS} = [ @members{sort { lc $a cmp lc $b } keys %members} ];
223 print $form->parse_html_template("admin/list_users");
227 $::form->{title} = "kivitendo " . $::locale->text('Administration') . " / " . $::locale->text('Add User');
229 # User does not have a well behaved new constructor, so we'll just have to build one ourself
232 "countrycode" => "de",
233 "numberformat" => "1.000,00",
234 "dateformat" => "dd.mm.yy",
235 "stylesheet" => "kivitendo.css",
236 "menustyle" => "neu",
237 dbport => $::auth->{DB_config}->{port} || 5432,
238 dbuser => $::auth->{DB_config}->{user} || 'lxoffice',
239 dbhost => $::auth->{DB_config}->{host} || 'localhost',
242 edit_user_form($user);
246 $::form->{title} = "kivitendo " . $::locale->text('Administration') . " / " . $::locale->text('Edit User');
250 my $user = User->new(id => $::form->{user}{id});
252 # strip basedir from templates directory
253 $user->{templates} =~ s|.*/||;
255 edit_user_form($user);
261 my %cc = $user->country_codes;
262 my @all_countrycodes = map { id => $_, title => $cc{$_} }, sort { $cc{$a} cmp $cc{$b} } keys %cc;
263 my ($all_dir, $all_master) = _search_templates();
266 if ($::form->{edit}) {
267 my $user_id = $::auth->get_user_id($user->{login});
268 my $all_groups = $::auth->read_groups();
270 for my $group (values %{ $all_groups }) {
271 push @{ $groups }, $group if (grep { $user_id == $_ } @{ $group->{members} });
274 $groups = [ sort { lc $a->{name} cmp lc $b->{name} } @{ $groups } ];
278 print $::form->parse_html_template("admin/edit_user", {
280 CAN_CHANGE_PASSWORD => $::auth->can_change_password,
282 all_stylesheets => \@all_stylesheets,
283 all_numberformats => \@valid_numberformats,
284 all_dateformats => \@valid_dateformats,
285 all_countrycodes => \@all_countrycodes,
286 all_menustyles => \@all_menustyles,
287 all_templates => $all_dir,
288 all_master_templates => $all_master,
293 my $form = $main::form;
294 my $locale = $main::locale;
296 my $user = $form->{user};
298 $user->{dbdriver} = 'Pg';
300 if (!$::form->{edit}) {
301 # no spaces allowed in login name
302 $user->{login} =~ s/\s//g;
303 $::form->show_generic_error($::locale->text('Login name missing!')) unless $user->{login};
305 # check for duplicates
306 my %members = $::auth->read_all_users;
307 if ($members{$user->{login}}) {
308 $::form->show_generic_error($locale->text('Another user with the login #1 does already exist.', $user->{login}), 'back_button' => 1);
312 # no spaces allowed in directories
313 ($::form->{newtemplates}) = split / /, $::form->{newtemplates};
314 $user->{templates} = $::form->{newtemplates} || $::form->{usetemplates} || $user->{login};
317 if (!-d $::lx_office_conf{paths}->{templates}) {
318 $::form->error(sprintf($::locale->text("The directory %s does not exist."), $::lx_office_conf{paths}->{templates}));
321 # add base directory to $form->{templates}
322 $user->{templates} =~ s|.*/||;
323 $user->{templates} = $::lx_office_conf{paths}->{templates} . "/$user->{templates}";
325 my $myconfig = new User(id => $user->{id});
327 $::form->show_generic_error($::locale->text('Dataset missing!')) unless $user->{dbname};
328 $::form->show_generic_error($::locale->text('Database User missing!')) unless $user->{dbuser};
330 foreach my $item (keys %{$user}) {
331 $myconfig->{$item} = $user->{$item};
334 $myconfig->save_member;
336 $user->{templates} =~ s|.*/||;
337 $user->{templates} = $::lx_office_conf{paths}->{templates} . "/$user->{templates}";
338 $::form->{mastertemplates} =~ s|.*/||;
340 # create user template directory and copy master files
341 if (!-d "$user->{templates}") {
344 if (mkdir "$user->{templates}", oct("771")) {
348 # copy templates to the directory
350 my $oldcurrdir = getcwd();
351 if (!chdir("$::lx_office_conf{paths}->{templates}/print/$::form->{mastertemplates}")) {
352 $form->error("$ERRNO: chdir $::lx_office_conf{paths}->{templates}/print/$::form->{mastertemplates}");
355 my $newdir = File::Spec->catdir($oldcurrdir, $user->{templates});
363 if (!mkdir (File::Spec->catdir($newdir, $File::Find::name))) {
365 $form->error("$ERRNO: mkdir $File::Find::name");
368 if (!symlink (readlink($_),
369 File::Spec->catfile($newdir, $File::Find::name))) {
371 $form->error("$ERRNO: symlink $File::Find::name");
374 if (!copy($_, File::Spec->catfile($newdir, $File::Find::name))) {
376 $form->error("$ERRNO: cp $File::Find::name");
384 $form->error("$ERRNO: $user->{templates}");
388 # Add new user to his groups.
389 if (ref $form->{new_user_group_ids} eq 'ARRAY') {
390 my $all_groups = $main::auth->read_groups();
391 my %user = $main::auth->read_user(login => $myconfig->{login});
393 foreach my $group_id (@{ $form->{new_user_group_ids} }) {
394 my $group = $all_groups->{$group_id};
398 push @{ $group->{members} }, $user{id};
399 $main::auth->save_group($group);
403 if ($main::auth->can_change_password()
404 && defined $::form->{new_password}
405 && ($::form->{new_password} ne '********')) {
406 my $verifier = SL::Auth::PasswordPolicy->new;
407 my $result = $verifier->verify($::form->{new_password}, 1);
409 if ($result != SL::Auth::PasswordPolicy->OK()) {
410 $form->error($::locale->text('The settings were saved, but the password was not changed.') . ' ' . join(' ', $verifier->errors($result)));
413 $main::auth->change_password($myconfig->{login}, $::form->{new_password});
416 $::form->redirect($::locale->text('User saved!'));
419 sub save_user_as_new {
420 my $form = $main::form;
422 $form->{user}{login} = $::form->{new_user_login};
423 delete $form->{user}{id};
424 delete @{$form}{qw(id edit new_user_login)};
430 my $form = $main::form;
431 my $locale = $main::locale;
433 my $user = $::form->{user} || {};
435 $::form->show_generic_error($::locale->text('Missing user id!')) unless $user->{id};
437 my $loaded_user = User->new(id => $user->{id});
439 my %members = $main::auth->read_all_users();
440 my $templates = $members{$loaded_user->{login}}->{templates};
442 $main::auth->delete_user($loaded_user->{login});
445 my $templates_in_use = 0;
447 foreach my $login (keys %members) {
448 next if $loaded_user->{login} eq $login;
449 next if $members{$login}->{templates} ne $templates;
450 $templates_in_use = 1;
454 if (!$templates_in_use && -d $templates) {
455 unlink <$templates/*>;
460 $form->redirect($locale->text('User deleted!'));
468 return ($login) ? $login : undef;
474 my ($null, $value) = split(/=/, $line, 2);
477 $value =~ s/\s#.*//g;
479 # remove any trailing whitespace
480 $value =~ s/^\s*(.*?)\s*$/$1/;
485 sub pg_database_administration {
486 my $form = $main::form;
488 $form->{dbdriver} = 'Pg';
493 sub dbselect_source {
494 my $form = $main::form;
495 my $locale = $main::locale;
497 $form->{dbport} = $::auth->{DB_config}->{port} || 5432;
498 $form->{dbuser} = $::auth->{DB_config}->{user} || 'lxoffice';
499 $form->{dbdefault} = 'template1';
500 $form->{dbhost} = $::auth->{DB_config}->{host} || 'localhost';
502 $form->{title} = "kivitendo / " . $locale->text('Database Administration');
504 # Intentionnaly disabled unless fixed to work with the authentication DB.
505 $form->{ALLOW_DBBACKUP} = 0; # "$pg_dump_exe" ne "DISABLED";
508 print $form->parse_html_template("admin/dbadmin");
511 sub test_db_connection {
512 my $form = $main::form;
513 my $locale = $main::locale;
515 $form->{dbdriver} = 'Pg';
516 User::dbconnect_vars($form, $form->{dbname});
518 my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd});
520 $form->{connection_ok} = $dbh ? 1 : 0;
521 $form->{errstr} = $DBI::errstr;
523 $dbh->disconnect() if ($dbh);
525 $form->{title} = $locale->text('Database Connection Test');
527 print $form->parse_html_template("admin/test_db_connection");
531 call_sub($main::form->{"nextsub"});
535 my $form = $main::form;
536 my $locale = $main::locale;
538 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Update Dataset');
540 my @need_updates = User->dbneedsupdate($form);
541 $form->{NEED_UPDATES} = \@need_updates;
542 $form->{ALL_UPDATED} = !scalar @need_updates;
545 print $form->parse_html_template("admin/update_dataset");
549 my $form = $main::form;
550 my $locale = $main::locale;
552 $::request->{layout}->use_stylesheet("lx-office-erp.css");
553 $form->{title} = $locale->text("Dataset upgrade");
556 my $rowcount = $form->{rowcount} * 1;
557 my @update_rows = grep { $form->{"update_$_"} } (1 .. $rowcount);
558 $form->{NOTHING_TO_DO} = !scalar @update_rows;
559 my $saved_form = save_form();
563 print $form->parse_html_template("admin/dbupgrade_all_header");
565 foreach my $i (@update_rows) {
566 restore_form($saved_form);
569 map { $form->{$_} = $::myconfig{$_} = $form->{"${_}_${i}"} } qw(dbname dbdriver dbhost dbport dbuser dbpasswd);
571 print $form->parse_html_template("admin/dbupgrade_header");
573 $form->{dbupdate} = $form->{dbname};
574 $form->{$form->{dbname}} = 1;
576 User->dbupdate($form);
577 User->dbupdate2($form, SL::DBUpgrade2->new(form => $form, dbdriver => $form->{dbdriver})->parse_dbupdate_controls);
579 print $form->parse_html_template("admin/dbupgrade_footer");
582 print $form->parse_html_template("admin/dbupgrade_all_done");
586 my $form = $main::form;
587 my $locale = $main::locale;
589 $form->{dbsources} = join " ", map { "[${_}]" } sort User->dbsources($form);
591 $form->{CHARTS} = [];
593 tie my %dir_h, 'IO::Dir', 'sql/';
594 foreach my $item (map { s/-chart\.sql$//; $_ } sort grep { /-chart\.sql\z/ && !/Default-chart.sql\z/ } keys %dir_h) {
595 push @{ $form->{CHARTS} }, { name => $item,
596 selected => $item eq "Germany-DATEV-SKR03EU" };
599 $form->{ACCOUNTING_METHODS} = [ map { { name => $_, selected => $_ eq 'cash' } } qw(accrual cash) ];
600 $form->{INVENTORY_SYSTEMS} = [ map { { name => $_, selected => $_ eq 'periodic' } } qw(perpetual periodic) ];
601 $form->{PROFIT_DETERMINATIONS} = [ map { { name => $_, selected => $_ eq 'income' } } qw(balance income) ];
603 my $default_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
605 my $cluster_encoding = User->dbclusterencoding($form);
606 if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i)) {
607 if ($::lx_office_conf{system}->{dbcharset} !~ m/^UTF-?8$/i) {
608 $form->show_generic_error($locale->text('The selected PostgreSQL installation uses UTF-8 as its encoding. ' .
609 'Therefore you have to configure kivitendo to use UTF-8 as well.'),
613 $form->{FORCE_DBENCODING} = 'UNICODE';
616 $form->{DBENCODINGS} = [ map { { %{$_}, selected => $_->{charset} eq $default_charset } } @Common::db_encodings ];
619 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Create Dataset');
622 print $form->parse_html_template("admin/create_dataset");
626 my $form = $main::form;
627 my $locale = $main::locale;
629 $form->isblank("db", $locale->text('Dataset missing!'));
630 $form->isblank("defaultcurrency", $locale->text('Default currency missing!'));
632 User->dbcreate(\%$form);
634 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Create Dataset');
637 print $form->parse_html_template("admin/dbcreate");
641 my $form = $main::form;
642 my $locale = $main::locale;
644 my @dbsources = User->dbsources_unused($form);
645 $form->error($locale->text('Nothing to delete!')) unless @dbsources;
647 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Delete Dataset');
648 $form->{DBSOURCES} = [ map { { "name", $_ } } sort @dbsources ];
651 print $form->parse_html_template("admin/delete_dataset");
655 my $form = $main::form;
656 my $locale = $main::locale;
659 $form->error($locale->text('No Dataset selected!'));
662 User->dbdelete(\%$form);
664 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Delete Dataset');
666 print $form->parse_html_template("admin/dbdelete");
670 my $form = $main::form;
671 my $locale = $main::locale;
673 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Backup Dataset');
675 if ($::lx_office_conf{applications}->{pg_dump} eq "DISABLED") {
676 $form->error($locale->text('Database backups and restorations are disabled in the configuration.'));
679 my @dbsources = sort User->dbsources($form);
680 $form->{DATABASES} = [ map { { "dbname" => $_ } } @dbsources ];
681 $form->{NO_DATABASES} = !scalar @dbsources;
683 my $username = getpwuid $UID || "unknown-user";
684 my $hostname = hostname() || "unknown-host";
685 $form->{from} = "kivitendo Admin <${username}\@${hostname}>";
688 print $form->parse_html_template("admin/backup_dataset");
691 sub backup_dataset_start {
692 my $form = $main::form;
693 my $locale = $main::locale;
695 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Backup Dataset');
697 my $pg_dump_exe = $::lx_office_conf{applications}->{pg_dump} || "pg_dump";
699 if ("$pg_dump_exe" eq "DISABLED") {
700 $form->error($locale->text('Database backups and restorations are disabled in the configuration.'));
703 $form->isblank("dbname", $locale->text('The dataset name is missing.'));
704 $form->isblank("to", $locale->text('The email address is missing.')) if $form->{destination} eq "email";
706 my $tmpdir = "/tmp/lx_office_backup_" . Common->unique_id();
707 mkdir $tmpdir, 0700 || $form->error($locale->text('A temporary directory could not be created:') . " $ERRNO");
709 my $pgpass = IO::File->new("${tmpdir}/.pgpass", O_WRONLY | O_CREAT, 0600);
713 $form->error($locale->text('A temporary file could not be created:') . " $ERRNO");
716 print $pgpass "$form->{dbhost}:$form->{dbport}:$form->{dbname}:$form->{dbuser}:$form->{dbpasswd}\n";
719 $ENV{HOME} = $tmpdir;
721 my @args = ("-Ft", "-c", "-o", "-h", $form->{dbhost}, "-U", $form->{dbuser});
722 push @args, ("-p", $form->{dbport}) if ($form->{dbport});
723 push @args, $form->{dbname};
725 my $cmd = "$pg_dump_exe " . join(" ", map { s/\\/\\\\/g; s/\"/\\\"/g; $_ } @args);
726 my $name = "dataset_backup_$form->{dbname}_" . strftime("%Y%m%d", localtime()) . ".tar";
728 if ($form->{destination} ne "email") {
729 my $in = IO::File->new("$cmd |");
732 unlink "${tmpdir}/.pgpass";
735 $form->error($locale->text('The pg_dump process could not be started.'));
738 print "content-type: application/x-tar\n";
739 print "content-disposition: attachment; filename=\"${name}\"\n\n";
741 while (my $line = <$in>) {
747 unlink "${tmpdir}/.pgpass";
751 my $tmp = $tmpdir . "/dump_" . Common::unique_id();
753 if (system("$cmd > $tmp") != 0) {
754 unlink "${tmpdir}/.pgpass", $tmp;
757 $form->error($locale->text('The pg_dump process could not be started.'));
760 my $mail = new Mailer;
762 map { $mail->{$_} = $form->{$_} } qw(from to cc subject message);
764 $mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
765 $mail->{attachments} = [ { "filename" => $tmp, "name" => $name } ];
768 unlink "${tmpdir}/.pgpass", $tmp;
771 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Backup Dataset');
774 print $form->parse_html_template("admin/backup_dataset_email_done");
778 sub restore_dataset {
779 my $form = $main::form;
780 my $locale = $main::locale;
782 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Restore Dataset');
784 if ($::lx_office_conf{applications}->{pg_restore} eq "DISABLED") {
785 $form->error($locale->text('Database backups and restorations are disabled in the configuration.'));
788 my $default_charset = $::lx_office_conf{system}->{dbcharset};
789 $default_charset ||= Common::DEFAULT_CHARSET;
791 $form->{DBENCODINGS} = [];
793 foreach my $encoding (@Common::db_encodings) {
794 push @{ $form->{DBENCODINGS} }, { "dbencoding" => $encoding->{dbencoding},
795 "label" => $encoding->{label},
796 "selected" => $encoding->{charset} eq $default_charset };
800 print $form->parse_html_template("admin/restore_dataset");
803 sub restore_dataset_start {
804 my $form = $main::form;
805 my $locale = $main::locale;
807 $form->{title} = "kivitendo " . $locale->text('Database Administration') . " / " . $locale->text('Restore Dataset');
809 my $pg_restore_exe = $::lx_office_conf{applications}->{pg_restore} || "pg_restore";
811 if ("$pg_restore_exe" eq "DISABLED") {
812 $form->error($locale->text('Database backups and restorations are disabled in the configuration.'));
815 $form->isblank("new_dbname", $locale->text('The dataset name is missing.'));
816 $form->isblank("content", $locale->text('No backup file has been uploaded.'));
818 # Create temporary directories. Write the backup file contents to a temporary
819 # file. Create a .pgpass file with the username and password for the pg_restore
822 my $tmpdir = "/tmp/lx_office_backup_" . Common->unique_id();
823 mkdir $tmpdir, 0700 || $form->error($locale->text('A temporary directory could not be created:') . " $ERRNO");
825 my $pgpass = IO::File->new("${tmpdir}/.pgpass", O_WRONLY | O_CREAT, 0600);
829 $form->error($locale->text('A temporary file could not be created:') . " $ERRNO");
832 print $pgpass "$form->{dbhost}:$form->{dbport}:$form->{new_dbname}:$form->{dbuser}:$form->{dbpasswd}\n";
835 $ENV{HOME} = $tmpdir;
837 my $tmp = $tmpdir . "/dump_" . Common::unique_id();
840 if (substr($form->{content}, 0, 2) eq "\037\213") {
841 $tmpfile = IO::File->new("| gzip -d > $tmp");
845 $tmpfile = IO::File->new($tmp, O_WRONLY | O_CREAT | O_BINARY, 0600);
849 unlink "${tmpdir}/.pgpass";
852 $form->error($locale->text('A temporary file could not be created:') . " $ERRNO");
855 print $tmpfile $form->{content};
858 delete $form->{content};
860 # Try to connect to the database. Find out if a database with the same name exists.
861 # If yes, then drop the existing database. Create a new one with the name and encoding
864 User::dbconnect_vars($form, "template1");
866 my %myconfig = map { $_ => $form->{$_} } grep /^db/, keys %{ $form };
867 my $dbh = $form->dbconnect(\%myconfig) || $form->dberror();
871 $form->{new_dbname} =~ s|[^a-zA-Z0-9_\-]||g;
873 $query = qq|SELECT COUNT(*) FROM pg_database WHERE datname = ?|;
874 my ($count) = selectrow_query($form, $dbh, $query, $form->{new_dbname});
876 do_query($form, $dbh, qq|DROP DATABASE $form->{new_dbname}|);
880 foreach my $item (@Common::db_encodings) {
881 if ($item->{dbencoding} eq $form->{dbencoding}) {
886 $form->{dbencoding} = "LATIN9" unless $form->{dbencoding};
888 do_query($form, $dbh, qq|CREATE DATABASE $form->{new_dbname} ENCODING ? TEMPLATE template0|, $form->{dbencoding});
892 # Spawn pg_restore on the temporary file.
894 my @args = ("-h", $form->{dbhost}, "-U", $form->{dbuser}, "-d", $form->{new_dbname});
895 push @args, ("-p", $form->{dbport}) if ($form->{dbport});
898 my $cmd = "$pg_restore_exe " . join(" ", map { s/\\/\\\\/g; s/\"/\\\"/g; $_ } @args);
900 my $in = IO::File->new("$cmd 2>&1 |");
903 unlink "${tmpdir}/.pgpass", $tmp;
906 $form->error($locale->text('The pg_restore process could not be started.'));
909 $English::AUTOFLUSH = 1;
912 print $form->parse_html_template("admin/restore_dataset_start_header");
914 while (my $line = <$in>) {
919 $form->{retval} = $CHILD_ERROR >> 8;
920 print $form->parse_html_template("admin/restore_dataset_start_footer");
922 unlink "${tmpdir}/.pgpass", $tmp;
927 my $form = $main::form;
928 my $locale = $main::locale;
930 unlink _nologin_file_name();;
932 $form->{callback} = "admin.pl?action=list_users";
934 $form->redirect($locale->text('Lockfile removed!'));
939 my $form = $main::form;
940 my $locale = $main::locale;
942 open(FH, ">", _nologin_file_name())
943 or $form->error($locale->text('Cannot create Lock!'));
946 $form->{callback} = "admin.pl?action=list_users";
948 $form->redirect($locale->text('Lockfile created!'));
953 call_sub($main::form->{yes_nextsub});
957 call_sub($main::form->{no_nextsub});
961 call_sub($main::form->{add_nextsub});
965 my $form = $main::form;
967 $form->{edit_nextsub} ||= 'edit_user';
969 call_sub($form->{edit_nextsub});
973 my $form = $main::form;
975 $form->{delete_nextsub} ||= 'delete_user';
977 call_sub($form->{delete_nextsub});
981 my $form = $main::form;
983 $form->{save_nextsub} ||= 'save_user';
985 call_sub($form->{save_nextsub});
989 call_sub($main::form->{back_nextsub});
993 my $form = $main::form;
994 my $locale = $main::locale;
996 foreach my $action (qw(create_standard_group dont_create_standard_group
997 save_user delete_user save_user_as_new)) {
998 if ($form->{"action_${action}"}) {
1004 call_sub($form->{default_action}) if ($form->{default_action});
1006 $form->error($locale->text('No action defined.'));
1009 sub _apply_dbupgrade_scripts {
1010 ::end_of_request() if SL::DBUpgrade2->new(form => $::form, dbdriver => 'Pg', auth => 1)->apply_admin_dbupgrade_scripts(1);
1013 sub _nologin_file_name {
1014 return $::lx_office_conf{paths}->{userspath} . '/nologin';
1017 sub _search_templates {
1018 my %templates = SL::Template->available_templates;
1020 return ($templates{print_templates}, $templates{master_templates});