X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FUser.pm;h=ea189637753cbd8fd45c10d4e4ec738023d5cf52;hb=8c7e44938a661e035f62840e1e177353240ace5d;hp=93c88834e0f6e97bb200126c4e96dfe5504b3fba;hpb=a200453a04fc89fdf02dbe39e1d951cb1b55191c;p=kivitendo-erp.git diff --git a/SL/User.pm b/SL/User.pm index 93c88834e..ea1896377 100644 --- a/SL/User.pm +++ b/SL/User.pm @@ -37,57 +37,34 @@ package User; use IO::File; use Fcntl qw(:seek); +use SL::Auth; use SL::DBUpgrade2; use SL::DBUtils; use SL::Iconv; +use SL::Inifile; sub new { $main::lxdebug->enter_sub(); - my ($type, $memfile, $login) = @_; + my ($type, $login) = @_; + my $self = {}; if ($login ne "") { - &error("", "$memfile locked!") if (-f "${memfile}.LCK"); - - open(MEMBER, "$memfile") or &error("", "$memfile : $!"); - - while () { - if (/^\[$login\]/) { - while () { - last if /^\[/; - next if /^(#|\s)/; - - # remove comments - s/\s#.*//g; - - # remove any trailing whitespace - s/^\s*(.*?)\s*$/$1/; - - ($key, $value) = split(/=/, $_, 2); - - if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) { - $value = "lx-office-erp.css"; - } - - $self->{$key} = $value; - } - - $self->{login} = $login; - - last; - } - } - close MEMBER; + my %user_data = $main::auth->read_user($login); + map { $self->{$_} = $user_data{$_} } keys %user_data; } $main::lxdebug->leave_sub(); + bless $self, $type; } sub country_codes { $main::lxdebug->enter_sub(); + local *DIR; + my %cc = (); my @language = (); @@ -114,31 +91,14 @@ sub country_codes { sub login { $main::lxdebug->enter_sub(); - my ($self, $form, $userspath) = @_; + my ($self, $form) = @_; + + local *FH; my $rc = -3; if ($self->{login}) { - - if ($self->{password}) { - if ($form->{hashed_password}) { - $form->{password} = $form->{hashed_password}; - } else { - $form->{password} = crypt($form->{password}, - substr($self->{login}, 0, 2)); - } - if ($self->{password} ne $form->{password}) { - $main::lxdebug->leave_sub(); - return -1; - } - } - - unless (-e "$userspath/$self->{login}.conf") { - $self->create_config("$userspath/$self->{login}.conf"); - } - - do "$userspath/$self->{login}.conf"; - $myconfig{dbpasswd} = unpack('u', $myconfig{dbpasswd}); + my %myconfig = $main::auth->read_user($self->{login}); # check if database is down my $dbh = @@ -154,17 +114,7 @@ sub login { my ($dbversion) = $sth->fetchrow_array; $sth->finish; - # add login to employee table if it does not exist - # no error check for employee table, ignore if it does not exist - $query = qq|SELECT id FROM employee WHERE login = ?|; - my ($login) = selectrow_query($form, $dbh, $query, $self->{login}); - - if (!$login) { - $query = qq|INSERT INTO employee (login, name, workphone, role)| . - qq|VALUES (?, ?, ?, ?)|; - my @values = ($self->{login}, $myconfig{name}, $myconfig{tel}, "user"); - do_query($form, $dbh, $query, @values); - } + $self->create_employee_entry($form, $dbh, \%myconfig); $self->create_schema_info_table($form, $dbh); @@ -176,7 +126,7 @@ sub login { parse_dbupdate_controls($form, $myconfig{"dbdriver"}); map({ $form->{$_} = $myconfig{$_} } - qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect)); + qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect dateformat)); if (update_available($myconfig{"dbdriver"}, $dbversion) || update2_available($form, $controls)) { @@ -184,18 +134,18 @@ sub login { $form->{"stylesheet"} = "lx-office-erp.css"; $form->{"title"} = $main::locale->text("Dataset upgrade"); $form->header(); - print($form->parse_html_template("dbupgrade/header")); + print $form->parse_html_template("dbupgrade/header"); $form->{dbupdate} = "db$myconfig{dbname}"; $form->{ $form->{dbupdate} } = 1; if ($form->{"show_dbupdate_warning"}) { - print($form->parse_html_template("dbupgrade/warning")); + print $form->parse_html_template("dbupgrade/warning"); exit(0); } # update the tables - open(FH, ">$userspath/nologin") or die("$!"); + open(FH, ">$main::userspath/nologin") or die("$!"); # required for Oracle $form->{dbdefault} = $sid; @@ -207,16 +157,18 @@ sub login { $self->dbupdate($form); $self->dbupdate2($form, $controls); + close(FH); + # remove lock file - unlink("$userspath/nologin"); + unlink("$main::userspath/nologin"); my $menufile = $self->{"menustyle"} eq "v3" ? "menuv3.pl" : $self->{"menustyle"} eq "neu" ? "menunew.pl" : + $self->{"menustyle"} eq "xml" ? "menuXML.pl" : "menu.pl"; - print($form->parse_html_template("dbupgrade/footer", - { "menufile" => $menufile })); + print $form->parse_html_template("dbupgrade/footer", { "menufile" => $menufile }); $rc = -2; @@ -481,9 +433,9 @@ sub process_perl_script { } if (!defined($result)) { - print($form->parse_html_template("dbupgrade/error", - { "file" => $filename, - "error" => $@ })); + print $form->parse_html_template("dbupgrade/error", + { "file" => $filename, + "error" => $@ }); exit(0); } elsif (1 != $result) { unlink("users/nologin") if (2 == $result); @@ -614,39 +566,21 @@ sub dbdelete { sub dbsources_unused { $main::lxdebug->enter_sub(); - my ($self, $form, $memfile) = @_; - - my @dbexcl = (); - my @dbsources = (); - - $form->error('File locked!') if (-f "${memfile}.LCK"); - - # open members file - open(FH, "$memfile") or $form->error("$memfile : $!"); - - while () { - if (/^dbname=/) { - my ($null, $item) = split(/=/); - push @dbexcl, $item; - } - } - - close FH; + my ($self, $form) = @_; $form->{only_acc_db} = 1; - my @db = &dbsources("", $form); - push @dbexcl, $form->{dbdefault}; + my %members = $main::auth->read_all_users(); + my %dbexcl = map { $_ => 1 } grep { $_ } map { $_->{dbname} } values %members; - foreach $item (@db) { - unless (grep /$item$/, @dbexcl) { - push @dbsources, $item; - } - } + $dbexcl{$form->{dbdefault}} = 1; + $dbexcl{$main::auth->{DB_config}->{db}} = 1; + + my @dbunused = grep { !$dbexcl{$_} } dbsources("", $form); $main::lxdebug->leave_sub(); - return @dbsources; + return @dbunused; } sub dbneedsupdate { @@ -654,84 +588,43 @@ sub dbneedsupdate { my ($self, $form) = @_; - my %dbsources = (); - my $query; - - $form->{sid} = $form->{dbdefault}; - &dbconnect_vars($form, $form->{dbdefault}); + my %members = $main::auth->read_all_users(); + my $controls = parse_dbupdate_controls($form, $form->{dbdriver}); - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + my ($query, $sth, %dbs_needing_updates); - if ($form->{dbdriver} eq 'Pg') { + foreach my $login (grep /[a-z]/, keys %members) { + my $member = $members{$login}; - $query = - qq|SELECT d.datname FROM pg_database d, pg_user u | . - qq|WHERE d.datdba = u.usesysid AND u.usename = ?|; - my $sth = prepare_execute_query($form, $dbh, $query, $form->{dbuser}); + map { $form->{$_} = $member->{$_} } qw(dbname dbuser dbpasswd dbhost dbport); + dbconnect_vars($form, $form->{dbname}); - while (my ($db) = $sth->fetchrow_array) { + my $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}); - next if ($db =~ /^template/); + next unless $dbh; - &dbconnect_vars($form, $db); + my $version; - my $dbh2 = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; - - $query = - qq|SELECT tablename FROM pg_tables | . - qq|WHERE tablename = 'defaults'|; - my $sth2 = prepare_execute_query($form, $dbh, $query); - - if ($sth2->fetchrow_array) { - $query = qq|SELECT version FROM defaults|; - my ($version) = selectrow_query($form, $dbh2, $query); - $dbsources{$db} = $version; - } - $sth2->finish; - $dbh2->disconnect; + $query = qq|SELECT version FROM defaults|; + $sth = prepare_query($form, $dbh, $query); + if ($sth->execute()) { + ($version) = $sth->fetchrow_array(); } - $sth->finish; - } - - if ($form->{dbdriver} eq 'Oracle') { - $query = - qq|SELECT owner FROM dba_objects |. - qq|WHERE object_name = 'DEFAULTS' AND object_type = 'TABLE'|; - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my ($db) = $sth->fetchrow_array) { - - $form->{dbuser} = $db; - &dbconnect_vars($form, $db); - - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + $sth->finish(); + $dbh->disconnect(); - $query = qq|SELECT version FROM defaults|; - my $sth = $dbh->prepare($query); - $sth->execute; + next unless $version; - if (my ($version) = $sth->fetchrow_array) { - $dbsources{$db} = $version; - } - $sth->finish; - $dbh->disconnect; + if (update_available($form->{dbdriver}, $version) || update2_available($form, $controls)) { + my $dbinfo = {}; + map { $dbinfo->{$_} = $member->{$_} } grep /^db/, keys %{ $member }; + $dbs_needing_updates{$member->{dbhost} . "::" . $member->{dbname}} = $dbinfo; } - $sth->finish; } - $dbh->disconnect; - $main::lxdebug->leave_sub(); - return %dbsources; + return values %dbs_needing_updates; } sub calc_version { @@ -779,12 +672,11 @@ sub cmp_script_version { sub update_available { my ($dbdriver, $cur_version) = @_; - opendir(SQLDIR, "sql/${dbdriver}-upgrade") - or &error("", "sql/${dbdriver}-upgrade: $!"); - my @upgradescripts = - grep(/$form->{dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, - readdir(SQLDIR)); - closedir(SQLDIR); + local *SQLDIR; + + opendir SQLDIR, "sql/${dbdriver}-upgrade" || error("", "sql/${dbdriver}-upgrade: $!"); + my @upgradescripts = grep /${dbdriver}-upgrade-\Q$cur_version\E.*\.(sql|pl)$/, readdir SQLDIR; + closedir SQLDIR; return ($#upgradescripts > -1); } @@ -814,6 +706,8 @@ sub dbupdate { my ($self, $form) = @_; + local *SQLDIR; + $form->{sid} = $form->{dbdefault}; my @upgradescripts = (); @@ -847,6 +741,8 @@ sub dbupdate { DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + $dbh->do($form->{dboptions}) if ($form->{dboptions}); + # check version $query = qq|SELECT version FROM defaults|; my ($version) = selectrow_query($form, $dbh, $query); @@ -857,7 +753,7 @@ sub dbupdate { foreach my $upgradescript (@upgradescripts) { my $a = $upgradescript; - $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g; + $a =~ s/^\Q$form->{dbdriver}\E-upgrade-|\.(sql|pl)$//g; my $file_type = $1; my ($mindb, $maxdb) = split /-/, $a; @@ -922,8 +818,12 @@ sub dbupdate2 { DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) or $form->dberror; + $dbh->do($form->{dboptions}) if ($form->{dboptions}); + map({ $_->{"applied"} = 0; } @upgradescripts); + $self->create_schema_info_table($form, $dbh); + $query = qq|SELECT tag FROM schema_info|; $sth = $dbh->prepare($query); $sth->execute() || $form->dberror($query); @@ -952,8 +852,7 @@ sub dbupdate2 { # apply upgrade $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}"); - print($form->parse_html_template("dbupgrade/upgrade_message2", - $control)); + print $form->parse_html_template("dbupgrade/upgrade_message2", $control); if ($file_type eq "sql") { $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . @@ -991,9 +890,10 @@ sub update2_available { $query = qq|SELECT tag FROM schema_info|; $sth = $dbh->prepare($query); - $sth->execute() || $form->dberror($query); - while (($tag) = $sth->fetchrow_array()) { - $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag})); + if ($sth->execute()) { + while (($tag) = $sth->fetchrow_array()) { + $controls->{$tag}->{"applied"} = 1 if (defined($controls->{$tag})); + } } $sth->finish(); $dbh->disconnect(); @@ -1005,114 +905,44 @@ sub update2_available { return 0; } -sub create_config { +sub save_member { $main::lxdebug->enter_sub(); - my ($self, $filename) = @_; - - @config = &config_vars; + my ($self) = @_; - open(CONF, ">$filename") or $self->error("$filename : $!"); + # format dbconnect and dboptions string + dbconnect_vars($self, $self->{dbname}); - # create the config file - print CONF qq|# configuration file for $self->{login} + map { $self->{$_} =~ s/\r//g; } qw(address signature); -\%myconfig = ( -|; + $main::auth->save_user($self->{login}, map { $_, $self->{$_} } config_vars()); - foreach $key (sort @config) { - $self->{$key} =~ s/\'/\\\'/g; - print CONF qq| $key => '$self->{$key}',\n|; + my $dbh = DBI->connect($self->{dbconnect}, $self->{dbuser}, $self->{dbpasswd}); + if ($dbh) { + $self->create_employee_entry($form, $dbh, $self); + $dbh->disconnect(); } - print CONF qq|);\n\n|; - - close CONF; - $main::lxdebug->leave_sub(); } -sub save_member { +sub create_employee_entry { $main::lxdebug->enter_sub(); - my ($self, $memberfile, $userspath) = @_; - - my $newmember = 1; - - # format dbconnect and dboptions string - &dbconnect_vars($self, $self->{dbname}); - - $self->error('File locked!') if (-f "${memberfile}.LCK"); - open(FH, ">${memberfile}.LCK") or $self->error("${memberfile}.LCK : $!"); - close(FH); - - open(CONF, "+<$memberfile") or $self->error("$memberfile : $!"); - - @config = ; - - seek(CONF, 0, 0); - truncate(CONF, 0); - - while ($line = shift @config) { - if ($line =~ /^\[$self->{login}\]/) { - $newmember = 0; - last; - } - print CONF $line; - } - - # remove everything up to next login or EOF - while ($line = shift @config) { - last if ($line =~ /^\[/); - } - - # this one is either the next login or EOF - print CONF $line; - - while ($line = shift @config) { - print CONF $line; - } + my $self = shift; + my $form = shift; + my $dbh = shift; + my $myconfig = shift; - print CONF qq|[$self->{login}]\n|; + # add login to employee table if it does not exist + # no error check for employee table, ignore if it does not exist + my ($login) = selectrow_query($form, $dbh, qq|SELECT id FROM employee WHERE login = ?|, $self->{login}); - if ((($self->{dbpasswd} ne $self->{old_dbpasswd}) || $newmember) - && $self->{root}) { - $self->{dbpasswd} = pack 'u', $self->{dbpasswd}; - chop $self->{dbpasswd}; - } - if (defined($self->{new_password})) { - if ($self->{new_password} ne $self->{old_password}) { - $self->{password} = crypt $self->{new_password}, - substr($self->{login}, 0, 2) - if $self->{new_password}; - } - } else { - if ($self->{password} ne $self->{old_password}) { - $self->{password} = crypt $self->{password}, substr($self->{login}, 0, 2) - if $self->{password}; - } + if (!$login) { + $query = qq|INSERT INTO employee (login, name, workphone, role) VALUES (?, ?, ?, ?)|; + do_query($form, $dbh, $query, ($self->{login}, $myconfig->{name}, $myconfig->{tel}, "user")); } - if ($self->{'root login'}) { - @config = ("password"); - } else { - @config = &config_vars; - } - - # replace \r\n with \n - map { $self->{$_} =~ s/\r\n/\\n/g } qw(address signature); - foreach $key (sort @config) { - print CONF qq|$key=$self->{$key}\n|; - } - - print CONF "\n"; - close CONF; - unlink "${memberfile}.LCK"; - - # create conf file - $self->create_config("$userspath/$self->{login}.conf") - unless $self->{'root login'}; - $main::lxdebug->leave_sub(); } @@ -1125,7 +955,7 @@ sub config_vars { printer role sid signature stylesheet tel templates vclimit angebote bestellungen rechnungen anfragen lieferantenbestellungen einkaufsrechnungen taxnumber co_ustid duns menustyle template_format default_media - default_printer_id copies show_form_details); + default_printer_id copies show_form_details favorites); $main::lxdebug->leave_sub(); @@ -1137,6 +967,8 @@ sub error { my ($self, $msg) = @_; + $main::lxdebug->show_backtrace(); + if ($ENV{HTTP_USER_AGENT}) { print qq|Content-Type: text/html