X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FUser.pm;h=68fd2c520ed8971dd88e437d47670e89d22683b1;hb=711e6c99a7057aa79b306e9cbd789d88d4b022a2;hp=c99201244d27da3ecee42fe8ec005edc39c07800;hpb=1efda31930b32c5822bb91dcbdff572814d57357;p=kivitendo-erp.git diff --git a/SL/User.pm b/SL/User.pm index c99201244..68fd2c520 100644 --- a/SL/User.pm +++ b/SL/User.pm @@ -25,7 +25,8 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +# MA 02110-1335, USA. #===================================================================== # # user related functions @@ -34,67 +35,63 @@ package User; -use SL::DBUpgrade2; - -sub new { - $main::lxdebug->enter_sub(); - - my ($type, $memfile, $login) = @_; - my $self = {}; +use IO::File; +use List::MoreUtils qw(any); - 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; +use SL::DB; +#use SL::Auth; +use SL::DB::AuthClient; +use SL::DB::Employee; +use SL::DBConnect; +use SL::DBUpgrade2; +use SL::DBUtils; +use SL::Iconv; +use SL::Inifile; +use SL::System::InstallationLock; +use SL::DefaultManager; - # remove any trailing whitespace - s/^\s*(.*?)\s*$/$1/; +use strict; - ($key, $value) = split(/=/, $_, 2); +use constant LOGIN_OK => 0; +use constant LOGIN_BASIC_TABLES_MISSING => -1; +use constant LOGIN_DBUPDATE_AVAILABLE => -2; +use constant LOGIN_AUTH_DBUPDATE_AVAILABLE => -3; +use constant LOGIN_GENERAL_ERROR => -4; - if (($key eq "stylesheet") && ($value eq "sql-ledger.css")) { - $value = "lx-office-erp.css"; - } +sub new { + $main::lxdebug->enter_sub(); - $self->{$key} = $value; - } + my ($type, %params) = @_; - $self->{login} = $login; + my $self = {}; - last; - } - } - close MEMBER; + if ($params{id} || $params{login}) { + my %user_data = $main::auth->read_user(%params); + 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 = (); # scan the locale directory and read in the LANGUAGE files - opendir DIR, "locale"; + opendir(DIR, "locale"); - my @dir = grep !/(^\.\.?$|\..*)/, readdir DIR; + my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR)); foreach my $dir (@dir) { - next unless open(FH, "locale/$dir/LANGUAGE"); - @language = ; - close FH; + next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE"); + @language = <$fh>; + close $fh; $cc{$dir} = "@language"; } @@ -106,179 +103,150 @@ sub country_codes { return %cc; } -sub login { - $main::lxdebug->enter_sub(); +sub _handle_superuser_privileges { + my ($self, $form) = @_; + + if ($form->{database_superuser_username}) { + $::auth->set_session_value("database_superuser_username" => $form->{database_superuser_username}, "database_superuser_password" => $form->{database_superuser_password}); + } - my ($self, $form, $userspath) = @_; + my %dbconnect_form = %{ $form }; + my ($su_user, $su_password) = map { $::auth->get_session_value("database_superuser_$_") } qw(username password); - my $rc = -3; + if ($su_user) { + $dbconnect_form{dbuser} = $su_user; + $dbconnect_form{dbpasswd} = $su_password; + } - if ($self->{login}) { + dbconnect_vars(\%dbconnect_form, $form->{dbname}); - 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; - } - } + my %result = ( + username => $dbconnect_form{dbuser}, + password => $dbconnect_form{dbpasswd}, + ); - unless (-e "$userspath/$self->{login}.conf") { - $self->create_config("$userspath/$self->{login}.conf"); - } + $::auth->set_session_value("database_superuser_username" => $dbconnect_form{dbuser}, "database_superuser_password" => $dbconnect_form{dbpasswd}); - do "$userspath/$self->{login}.conf"; - $myconfig{dbpasswd} = unpack 'u', $myconfig{dbpasswd}; - - # check if database is down - my $dbh = - DBI->connect($myconfig{dbconnect}, $myconfig{dbuser}, - $myconfig{dbpasswd}) - or $self->error(DBI::errstr); - - # we got a connection, check the version - my $query = qq|SELECT version FROM defaults|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - 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 e.id FROM employee e WHERE e.login = '$self->{login}'|; - $sth = $dbh->prepare($query); - $sth->execute; - - my ($login) = $sth->fetchrow_array; - $sth->finish; - - if (!$login) { - $query = qq|INSERT INTO employee (login, name, workphone, role) - VALUES ('$self->{login}', '$myconfig{name}', - '$myconfig{tel}', 'user')|; - $dbh->do($query); - } + my $dbh = SL::DBConnect->connect($dbconnect_form{dbconnect}, $dbconnect_form{dbuser}, $dbconnect_form{dbpasswd}, SL::DBConnect->get_options); + return (%result, error => $::locale->text('The credentials (username & password) for connecting database are wrong.')) if !$dbh; - $self->create_schema_info_table($form, $dbh); + my $is_superuser = SL::DBUtils::role_is_superuser($dbh, $dbconnect_form{dbuser}); - $dbh->disconnect; + $dbh->disconnect; - $rc = 0; + return (%result, have_privileges => 1) if $is_superuser; + return (%result) if !$su_user; # no error message if credentials weren't set by the user + return (%result, error => $::locale->text('The database user \'#1\' does not have superuser privileges.', $dbconnect_form{dbuser})); +} - my $controls = - parse_dbupdate_controls($form, $myconfig{"dbdriver"}); +sub login { + my ($self, $form) = @_; - map({ $form->{$_} = $myconfig{$_} } - qw(dbname dbhost dbport dbdriver dbuser dbpasswd dbconnect)); + return LOGIN_GENERAL_ERROR() if !$self->{login} || !$::auth->client; - if (update_available($myconfig{"dbdriver"}, $dbversion) || - update2_available($form, $controls)) { + my %myconfig = $main::auth->read_user(login => $self->{login}); - $form->{"stylesheet"} = "lx-office-erp.css"; - $form->{"title"} = $main::locale->text("Dataset upgrade"); - $form->header(); - print($form->parse_html_template("dbupgrade/header")); + # Auth DB upgrades available? + my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, auth => 1)->parse_dbupdate_controls; + return LOGIN_AUTH_DBUPDATE_AVAILABLE() if $dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect); - $form->{dbupdate} = "db$myconfig{dbname}"; - $form->{ $form->{dbupdate} } = 1; + # check if database is down + my $dbh = SL::DB->client->dbh; - if ($form->{"show_dbupdate_warning"}) { - print($form->parse_html_template("dbupgrade/warning")); - exit(0); - } + # we got a connection, check the version + my ($dbversion) = $dbh->selectrow_array(qq|SELECT version FROM defaults|); + if (!$dbversion) { + $dbh->disconnect; + return LOGIN_BASIC_TABLES_MISSING(); + } - # update the tables - open(FH, ">$userspath/nologin") or die("$!"); + $self->create_schema_info_table($form, $dbh); - # required for Oracle - $form->{dbdefault} = $sid; + my $dbupdater = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls; + my @unapplied_scripts = $dbupdater->unapplied_upgrade_scripts($dbh); +# $dbh->disconnect; - # ignore HUP, QUIT in case the webserver times out - $SIG{HUP} = 'IGNORE'; - $SIG{QUIT} = 'IGNORE'; + if (!@unapplied_scripts) { + SL::DB::Manager::Employee->update_entries_for_authorized_users; + return LOGIN_OK(); + } - $self->dbupdate($form); - $self->dbupdate2($form, $controls); + # Store the fact that we're applying database upgrades at the + # moment. That way functions called from the layout modules that may + # require updated tables can chose only to use basic features. + $::request->applying_database_upgrades(1); - # remove lock file - unlink("$userspath/nologin"); + $form->{$_} = $::auth->client->{$_} for qw(dbname dbhost dbport dbuser dbpasswd); + $form->{$_} = $myconfig{$_} for qw(datestyle); - my $menufile = - $self->{"menustyle"} eq "v3" ? "menuv3.pl" : - $self->{"menustyle"} eq "neu" ? "menunew.pl" : - "menu.pl"; + $form->{"title"} = $main::locale->text("Dataset upgrade"); + $form->header(no_layout => $form->{no_layout}); + print $form->parse_html_template("dbupgrade/header"); - print($form->parse_html_template("dbupgrade/footer", - { "menufile" => $menufile })); + $form->{dbupdate} = "db" . $::auth->client->{dbname}; - $rc = -2; + my $show_update_warning = $form->{"show_dbupdate_warning"}; + my %superuser = (need_privileges => (any { $_->{superuser_privileges} } @unapplied_scripts)); - } + if ($superuser{need_privileges}) { + %superuser = ( + %superuser, + $self->_handle_superuser_privileges($form), + ); + $show_update_warning = 1 if !$superuser{have_privileges}; } - $main::lxdebug->leave_sub(); + if ($show_update_warning) { + print $form->parse_html_template("dbupgrade/warning", { + unapplied_scripts => \@unapplied_scripts, + superuser => \%superuser, + }); + $::dispatcher->end_request; + } - return $rc; -} + # update the tables + SL::System::InstallationLock->lock; -sub dbconnect_vars { - $main::lxdebug->enter_sub(); + # ignore HUP, QUIT in case the webserver times out + $SIG{HUP} = 'IGNORE'; + $SIG{QUIT} = 'IGNORE'; - my ($form, $db) = @_; + $self->dbupdate2(form => $form, updater => $dbupdater, database => $::auth->client->{dbname}); - my %dboptions = ( - 'Pg' => { 'yy-mm-dd' => 'set DateStyle to \'ISO\'', - 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'', - 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'', - 'mm-dd-yy' => 'set DateStyle to \'POSTGRES, US\'', - 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'', - 'dd-mm-yy' => 'set DateStyle to \'POSTGRES, EUROPEAN\'', - 'dd.mm.yy' => 'set DateStyle to \'GERMAN\'' - }, - 'Oracle' => { - 'yy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YY-MM-DD\'', - 'yyyy-mm-dd' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'YYYY-MM-DD\'', - 'mm/dd/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM/DD/YY\'', - 'mm-dd-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'MM-DD-YY\'', - 'dd/mm/yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD/MM/YY\'', - 'dd-mm-yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD-MM-YY\'', - 'dd.mm.yy' => 'ALTER SESSION SET NLS_DATE_FORMAT = \'DD.MM.YY\'', - }); - - $form->{dboptions} = $dboptions{ $form->{dbdriver} }{ $form->{dateformat} }; - - if ($form->{dbdriver} eq 'Pg') { - $form->{dbconnect} = "dbi:Pg:dbname=$db"; - } + # If $self->dbupdate2 returns than this means all upgrade scripts + # have been applied successfully, none required user + # interaction. Otherwise the deeper layers would have called + # $::dispatcher->end_request already, and return would not have returned to + # us. Therefore we can now use RDBO instances because their supposed + # table structures do match the actual structures. So let's ensure + # that the "employee" table contains the appropriate entries for all + # users authorized for the current client. + SL::DB::Manager::Employee->update_entries_for_authorized_users; - if ($form->{dbdriver} eq 'Oracle') { - $form->{dbconnect} = "dbi:Oracle:sid=$form->{sid}"; - } + SL::System::InstallationLock->unlock; - if ($form->{dbhost}) { - $form->{dbconnect} .= ";host=$form->{dbhost}"; - } - if ($form->{dbport}) { - $form->{dbconnect} .= ";port=$form->{dbport}"; - } + print $form->parse_html_template("dbupgrade/footer"); - $main::lxdebug->leave_sub(); + return LOGIN_DBUPDATE_AVAILABLE(); } -sub dbdrivers { +sub dbconnect_vars { $main::lxdebug->enter_sub(); - my @drivers = DBI->available_drivers(); + my ($form, $db) = @_; - $main::lxdebug->leave_sub(); + my %dboptions = ( + 'yy-mm-dd' => 'set DateStyle to \'ISO\'', + 'yyyy-mm-dd' => 'set DateStyle to \'ISO\'', + 'mm/dd/yy' => 'set DateStyle to \'SQL, US\'', + 'dd/mm/yy' => 'set DateStyle to \'SQL, EUROPEAN\'', + 'dd.mm.yy' => 'set DateStyle to \'GERMAN\'' + ); - return (grep { /(Pg|Oracle)/ } @drivers); + $form->{dboptions} = $dboptions{ $form->{dateformat} }; + $form->{dbconnect} = "dbi:Pg:dbname=${db};host=" . ($form->{dbhost} || 'localhost') . ";port=" . ($form->{dbport} || 5432); + + $main::lxdebug->leave_sub(); } sub dbsources { @@ -290,62 +258,42 @@ sub dbsources { my ($sth, $query); $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault}; - $form->{sid} = $form->{dbdefault}; &dbconnect_vars($form, $form->{dbdefault}); - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror; - if ($form->{dbdriver} eq 'Pg') { - - $query = qq|SELECT datname FROM pg_database WHERE NOT ((datname = 'template0') OR (datname = 'template1'))|; - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $query = + qq|SELECT datname FROM pg_database | . + qq|WHERE NOT datname IN ('template0', 'template1')|; + $sth = $dbh->prepare($query); + $sth->execute() || $form->dberror($query); - while (my ($db) = $sth->fetchrow_array) { + while (my ($db) = $sth->fetchrow_array) { - if ($form->{only_acc_db}) { + if ($form->{only_acc_db}) { - next if ($db =~ /^template/); + next if ($db =~ /^template/); - &dbconnect_vars($form, $db); - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + &dbconnect_vars($form, $db); + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) + or $form->dberror; - $query = qq|SELECT p.tablename FROM pg_tables p - WHERE p.tablename = 'defaults' - AND p.tableowner = '$form->{dbuser}'|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); + $query = + qq|SELECT tablename FROM pg_tables | . + qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|; + my $sth = $dbh->prepare($query); + $sth->execute($form->{dbuser}) || + $form->dberror($query . " ($form->{dbuser})"); - if ($sth->fetchrow_array) { - push @dbsources, $db; - } - $sth->finish; - $dbh->disconnect; - next; + if ($sth->fetchrow_array) { + push(@dbsources, $db); } - push @dbsources, $db; - } - } - - if ($form->{dbdriver} eq 'Oracle') { - if ($form->{only_acc_db}) { - $query = qq|SELECT o.owner FROM dba_objects o - WHERE o.object_name = 'DEFAULTS' - AND o.object_type = 'TABLE'|; - } else { - $query = qq|SELECT username FROM dba_users|; - } - - $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my ($db) = $sth->fetchrow_array) { - push @dbsources, $db; + $sth->finish; + $dbh->disconnect; + next; } + push(@dbsources, $db); } $sth->finish; @@ -361,199 +309,87 @@ sub dbcreate { my ($self, $form) = @_; - $form->{sid} = $form->{dbdefault}; &dbconnect_vars($form, $form->{dbdefault}); my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror; + $form->{db} =~ s/\"//g; - my %dbcreate = ( - 'Pg' => qq|CREATE DATABASE "$form->{db}"|, - 'Oracle' => - qq|CREATE USER "$form->{db}" DEFAULT TABLESPACE USERS TEMPORARY TABLESPACE TEMP IDENTIFIED BY "$form->{db}"| - ); - - my %dboptions = ( - 'Pg' => [], - ); + my @dboptions; - push(@{$dboptions{"Pg"}}, "ENCODING = " . $dbh->quote($form->{"encoding"})) - if ($form->{"encoding"}); + push @dboptions, "ENCODING = " . $dbh->quote($form->{"encoding"}) if $form->{"encoding"}; if ($form->{"dbdefault"}) { my $dbdefault = $form->{"dbdefault"}; $dbdefault =~ s/[^a-zA-Z0-9_\-]//g; - push(@{$dboptions{"Pg"}}, "TEMPLATE = $dbdefault"); + push @dboptions, "TEMPLATE = $dbdefault"; } - my $query = qq|$dbcreate{$form->{dbdriver}}|; - $query .= " WITH " . join(" ", @{$dboptions{"Pg"}}) if (@{$dboptions{"Pg"}}); + my $query = qq|CREATE DATABASE "$form->{db}"|; + $query .= " WITH " . join(" ", @dboptions) if @dboptions; - $dbh->do($query) || $form->dberror($query); + # Ignore errors if the database exists. + $dbh->do($query); - if ($form->{dbdriver} eq 'Oracle') { - $query = qq|GRANT CONNECT,RESOURCE TO "$form->{db}"|; - $dbh->do($query) || $form->dberror($query); - } $dbh->disconnect; - # setup variables for the new database - if ($form->{dbdriver} eq 'Oracle') { - $form->{dbuser} = $form->{db}; - $form->{dbpasswd} = $form->{db}; - } - &dbconnect_vars($form, $form->{db}); - $dbh = DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + # make a shim myconfig so that rose db connections work + $::myconfig{$_} = $form->{$_} for qw(dbhost dbport dbuser dbpasswd); + $::myconfig{dbname} = $form->{db}; + + $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror; + my $dbupdater = SL::DBUpgrade2->new(form => $form, return_on_error => 1, silent => 1)->parse_dbupdate_controls; # create the tables - my $filename = qq|sql/lx-office.sql|; - $self->process_query($form, $dbh, $filename); - - # load gifi - ($filename) = split /_/, $form->{chart}; - $filename =~ s/_//; - $self->process_query($form, $dbh, "sql/${filename}-gifi.sql"); + $dbupdater->process_query($dbh, "sql/lx-office.sql"); + $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql"); - # load chart of accounts - $filename = qq|sql/$form->{chart}-chart.sql|; - $self->process_query($form, $dbh, $filename); - - $query = "UPDATE defaults SET coa = " . $dbh->quote($form->{"chart"}); - $dbh->do($query) || $form->dberror($query); + $query = qq|UPDATE defaults SET coa = ?|; + do_query($form, $dbh, $query, map { $form->{$_} } qw(chart)); $dbh->disconnect; - $main::lxdebug->leave_sub(); -} - -# Process a Perl script which updates the database. -# If the script returns 1 then the update was successful. -# Return code "2" means "needs more interaction; remove -# users/nologin and exit". -# All other return codes are fatal errors. -sub process_perl_script { - $main::lxdebug->enter_sub(); - - my ($self, $form, $dbh, $filename, $version_or_control) = @_; - - open(FH, "$filename") or $form->error("$filename : $!\n"); - my $contents = join("", ); - close(FH); - - $dbh->begin_work(); - - my %dbup_myconfig = (); - map({ $dbup_myconfig{$_} = $form->{$_}; } - qw(dbname dbuser dbpasswd dbhost dbport dbconnect)); - - my $nls_file = $filename; - $nls_file =~ s|.*/||; - $nls_file =~ s|.pl$||; - my $dbup_locale = Locale->new($main::language, $nls_file); - - my $result = eval($contents); - - if (1 != $result) { - $dbh->rollback(); - $dbh->disconnect(); - } - - if (!defined($result)) { - print($form->parse_html_template("dbupgrade/error", - { "file" => $filename, - "error" => $@ })); - exit(0); - } elsif (1 != $result) { - unlink("users/nologin") if (2 == $result); - exit(0); - } - - if (ref($version_or_control) eq "HASH") { - $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" . - $dbh->quote($version_or_control->{"tag"}) . ", " . - $dbh->quote($form->{"login"}) . ")"); - } elsif ($version_or_control) { - $dbh->do("UPDATE defaults SET version = " . - $dbh->quote($version_or_control)); - } - $dbh->commit(); - - $main::lxdebug->leave_sub(); -} - -sub process_query { - $main::lxdebug->enter_sub(); - - my ($self, $form, $dbh, $filename, $version_or_control) = @_; - - # return unless (-f $filename); - - open(FH, "$filename") or $form->error("$filename : $!\n"); - my $query = ""; - my $sth; - my @quote_chars; - - $dbh->begin_work(); - - while () { - - # Remove DOS and Unix style line endings. - chomp; + # update new database + $self->dbupdate2(form => $form, updater => $dbupdater, database => $form->{db}, silent => 1); - # remove comments - s/--.*$//; - - for (my $i = 0; $i < length($_); $i++) { - my $char = substr($_, $i, 1); - - # Are we inside a string? - if (@quote_chars) { - if ($char eq $quote_chars[-1]) { - pop(@quote_chars); - } - $query .= $char; - - } else { - if (($char eq "'") || ($char eq "\"")) { - push(@quote_chars, $char); - - } elsif ($char eq ";") { - - # Query is complete. Send it. - - $sth = $dbh->prepare($query); - if (!$sth->execute()) { - my $errstr = $dbh->errstr; - $sth->finish(); - $dbh->rollback(); - $form->dberror("The database update/creation did not succeed. The file ${filename} containing the following query failed:
${query}
" . - "The error message was: ${errstr}
" . - "All changes in that file have been reverted."); - } - $sth->finish(); - - $char = ""; - $query = ""; - } - - $query .= $char; - } - } - } + $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) + or $form->dberror; - if (ref($version_or_control) eq "HASH") { - $dbh->do("INSERT INTO schema_info (tag, login) VALUES (" . - $dbh->quote($version_or_control->{"tag"}) . ", " . - $dbh->quote($form->{"login"}) . ")"); - } elsif ($version_or_control) { - $dbh->do("UPDATE defaults SET version = " . - $dbh->quote($version_or_control)); - } - $dbh->commit(); + $query = "SELECT * FROM currencies WHERE name = ?"; + my $curr = selectfirst_hashref_query($form, $dbh, $query, $form->{defaultcurrency}); + if (!$curr->{id}) { + do_query($form, $dbh, "INSERT INTO currencies (name) VALUES (?)", $form->{defaultcurrency}); + $curr = selectfirst_hashref_query($form, $dbh, $query, $form->{defaultcurrency}); + } + + $query = qq|UPDATE defaults SET + accounting_method = ?, + profit_determination = ?, + inventory_system = ?, + precision = ?, + currency_id = ?, + feature_balance = ?, + feature_datev = ?, + feature_erfolgsrechnung = ?, + feature_eurechnung = ?, + feature_ustva = ? + |; + do_query($form, $dbh, $query, + $form->{accounting_method}, + $form->{profit_determination}, + $form->{inventory_system}, + $form->parse_amount(\%::myconfig, $form->{precision_as_number}), + $curr->{id}, + $form->{feature_balance}, + $form->{feature_datev}, + $form->{feature_erfolgsrechnung}, + $form->{feature_eurechnung}, + $form->{feature_ustva} + ); - close FH; + $dbh->disconnect; $main::lxdebug->leave_sub(); } @@ -562,153 +398,19 @@ sub dbdelete { $main::lxdebug->enter_sub(); my ($self, $form) = @_; + $form->{db} =~ s/\"//g; - my %dbdelete = ('Pg' => qq|DROP DATABASE "$form->{db}"|, - 'Oracle' => qq|DROP USER $form->{db} CASCADE|); - - $form->{sid} = $form->{dbdefault}; &dbconnect_vars($form, $form->{dbdefault}); - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror; - my $query = qq|$dbdelete{$form->{dbdriver}}|; - $dbh->do($query) || $form->dberror($query); + my $query = qq|DROP DATABASE "$form->{db}"|; + do_query($form, $dbh, $query); $dbh->disconnect; $main::lxdebug->leave_sub(); } -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; - - $form->{only_acc_db} = 1; - my @db = &dbsources("", $form); - - push @dbexcl, $form->{dbdefault}; - - foreach $item (@db) { - unless (grep /$item$/, @dbexcl) { - push @dbsources, $item; - } - } - - $main::lxdebug->leave_sub(); - - return @dbsources; -} - -sub dbneedsupdate { - $main::lxdebug->enter_sub(); - - my ($self, $form) = @_; - - my %dbsources = (); - my $query; - - $form->{sid} = $form->{dbdefault}; - &dbconnect_vars($form, $form->{dbdefault}); - - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; - - if ($form->{dbdriver} eq 'Pg') { - - $query = qq|SELECT d.datname FROM pg_database d, pg_user u - WHERE d.datdba = u.usesysid - AND u.usename = '$form->{dbuser}'|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - while (my ($db) = $sth->fetchrow_array) { - - next if ($db =~ /^template/); - - &dbconnect_vars($form, $db); - - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; - - $query = qq|SELECT t.tablename FROM pg_tables t - WHERE t.tablename = 'defaults'|; - my $sth = $dbh->prepare($query); - $sth->execute || $form->dberror($query); - - if ($sth->fetchrow_array) { - $query = qq|SELECT version FROM defaults|; - my $sth = $dbh->prepare($query); - $sth->execute; - - if (my ($version) = $sth->fetchrow_array) { - $dbsources{$db} = $version; - } - $sth->finish; - } - $sth->finish; - $dbh->disconnect; - } - $sth->finish; - } - - if ($form->{dbdriver} eq 'Oracle') { - $query = qq|SELECT o.owner FROM dba_objects o - WHERE o.object_name = 'DEFAULTS' - AND o.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; - - $query = qq|SELECT version FROM defaults|; - my $sth = $dbh->prepare($query); - $sth->execute; - - if (my ($version) = $sth->fetchrow_array) { - $dbsources{$db} = $version; - } - $sth->finish; - $dbh->disconnect; - } - $sth->finish; - } - - $dbh->disconnect; - - $main::lxdebug->leave_sub(); - - return %dbsources; -} - -## LINET sub calc_version { $main::lxdebug->enter_sub(2); @@ -731,14 +433,14 @@ sub calc_version { sub cmp_script_version { my ($a_from, $a_to, $b_from, $b_to); my ($i, $res_a, $res_b); - my ($my_a, $my_b) = ($a, $b); + my ($my_a, $my_b) = do { no warnings 'once'; ($a, $b) }; $my_a =~ s/.*-upgrade-//; $my_a =~ s/.sql$//; $my_b =~ s/.*-upgrade-//; $my_b =~ s/.sql$//; - ($my_a_from, $my_a_to) = split(/-/, $my_a); - ($my_b_from, $my_b_to) = split(/-/, $my_b); + my ($my_a_from, $my_a_to) = split(/-/, $my_a); + my ($my_b_from, $my_b_to) = split(/-/, $my_b); $res_a = calc_version($my_a_from); $res_b = calc_version($my_b_from); @@ -750,18 +452,6 @@ sub cmp_script_version { return $res_a <=> $res_b; } -## /LINET - -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; - - return ($#upgradescripts > -1); -} sub create_schema_info_table { $main::lxdebug->enter_sub(); @@ -770,361 +460,91 @@ sub create_schema_info_table { my $query = "SELECT tag FROM schema_info LIMIT 1"; if (!$dbh->do($query)) { + $dbh->rollback(); $query = - "CREATE TABLE schema_info (" . - " tag text, " . - " login text, " . - " itime timestamp DEFAULT now(), " . - " PRIMARY KEY (tag))"; + qq|CREATE TABLE schema_info (| . + qq| tag text, | . + qq| login text, | . + qq| itime timestamp DEFAULT now(), | . + qq| PRIMARY KEY (tag))|; $dbh->do($query) || $form->dberror($query); } $main::lxdebug->leave_sub(); } -sub dbupdate { - $main::lxdebug->enter_sub(); - - my ($self, $form) = @_; - - $form->{sid} = $form->{dbdefault}; - - my @upgradescripts = (); - my $query; - my $rc = -2; - - if ($form->{dbupdate}) { - - # read update scripts into memory - opendir SQLDIR, "sql/" . $form->{dbdriver} . "-upgrade" or &error("", "sql/" . $form->{dbdriver} . "-upgrade : $!"); - ## LINET - @upgradescripts = - sort(cmp_script_version - grep(/$form->{dbdriver}-upgrade-.*?\.(sql|pl)$/, readdir(SQLDIR))); - ## /LINET - closedir SQLDIR; - } - - foreach my $db (split / /, $form->{dbupdate}) { - - next unless $form->{$db}; - - # strip db from dataset - $db =~ s/^db//; - &dbconnect_vars($form, $db); - - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; - - # check version - $query = qq|SELECT version FROM defaults|; - my $sth = $dbh->prepare($query); - - # no error check, let it fall through - $sth->execute; - - my $version = $sth->fetchrow_array; - $sth->finish; - - next unless $version; - - ## LINET - $version = calc_version($version); - ## /LINET - - foreach my $upgradescript (@upgradescripts) { - my $a = $upgradescript; - $a =~ s/^$form->{dbdriver}-upgrade-|\.(sql|pl)$//g; - my $file_type = $1; - - my ($mindb, $maxdb) = split /-/, $a; - my $str_maxdb = $maxdb; - ## LINET - $mindb = calc_version($mindb); - $maxdb = calc_version($maxdb); - ## /LINET - - next if ($version >= $maxdb); - - # if there is no upgrade script exit - last if ($version < $mindb); - - # apply upgrade - $main::lxdebug->message(DEBUG2, "Applying Update $upgradescript"); - if ($file_type eq "sql") { - $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb); - } else { - $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb); - } - - $version = $maxdb; - - } - - $rc = 0; - $dbh->disconnect; - - } - - $main::lxdebug->leave_sub(); - - return $rc; -} - sub dbupdate2 { - $main::lxdebug->enter_sub(); - - my ($self, $form, $controls) = @_; + my ($self, %params) = @_; - $form->{sid} = $form->{dbdefault}; + my $form = $params{form}; + my $dbupdater = $params{updater}; + my $db = $params{database}; + my $silent = $params{silent}; - my @upgradescripts = (); - my ($query, $sth, $tag); - my $rc = -2; + map { $_->{description} = SL::Iconv::convert($_->{charset}, 'UTF-8', $_->{description}) } values %{ $dbupdater->{all_controls} }; - @upgradescripts = sort_dbupdate_controls($controls); + &dbconnect_vars($form, $db); - foreach my $db (split / /, $form->{dbupdate}) { + my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror; - next unless $form->{$db}; + $dbh->do($form->{dboptions}) if ($form->{dboptions}); - # strip db from dataset - $db =~ s/^db//; - &dbconnect_vars($form, $db); + $self->create_schema_info_table($form, $dbh); - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) - or $form->dberror; + my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh); + my $need_superuser = (any { $_->{superuser_privileges} } @upgradescripts); + my $superuser_dbh; - map({ $_->{"applied"} = 0; } @upgradescripts); - - $query = "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})); - } - $sth->finish(); + if ($need_superuser) { + my %dbconnect_form = ( + %{ $form }, + dbuser => $::auth->get_session_value("database_superuser_username"), + dbpasswd => $::auth->get_session_value("database_superuser_password"), + ); - my $all_applied = 1; - foreach (@upgradescripts) { - if (!$_->{"applied"}) { - $all_applied = 0; - last; - } + if ($dbconnect_form{dbuser} ne $form->{dbuser}) { + dbconnect_vars(\%dbconnect_form, $db); + $superuser_dbh = SL::DBConnect->connect($dbconnect_form{dbconnect}, $dbconnect_form{dbuser}, $dbconnect_form{dbpasswd}, SL::DBConnect->get_options) or $form->dberror; } - - next if ($all_applied); - - foreach my $control (@upgradescripts) { - next if ($control->{"applied"}); - - $control->{"file"} =~ /\.(sql|pl)$/; - my $file_type = $1; - - # apply upgrade - $main::lxdebug->message(DEBUG2, "Applying Update $control->{file}"); - print($form->parse_html_template("dbupgrade/upgrade_message2", - $control)); - - if ($file_type eq "sql") { - $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . - "-upgrade2/$control->{file}", $control); - } else { - $self->process_perl_script($form, $dbh, "sql/" . $form->{"dbdriver"} . - "-upgrade2/$control->{file}", $control); - } - } - - $rc = 0; - $dbh->disconnect; - - } - - $main::lxdebug->leave_sub(); - - return $rc; -} - -sub update2_available { - $main::lxdebug->enter_sub(); - - my ($form, $controls) = @_; - - map({ $_->{"applied"} = 0; } values(%{$controls})); - - dbconnect_vars($form, $form->{"dbname"}); - - my $dbh = - DBI->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}) || - $form->dberror; - - my ($query, $tag, $sth); - - $query = "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})); } - $sth->finish(); - $dbh->disconnect(); - - map({ $main::lxdebug->leave_sub() and return 1 if (!$_->{"applied"}) } - values(%{$controls})); - - $main::lxdebug->leave_sub(); - return 0; -} -sub create_config { - $main::lxdebug->enter_sub(); + $::lxdebug->log_time("DB upgrades commencing"); - my ($self, $filename) = @_; + foreach my $control (@upgradescripts) { + # Apply upgrade. Control will only return to us if the upgrade has + # been applied correctly and if the update has not requested user + # interaction. + my $script_dbh = $control->{superuser_privileges} ? ($superuser_dbh // $dbh) : $dbh; - @config = &config_vars; + $::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}" . ($control->{superuser_privileges} ? " with superuser privileges" : "")); + print $form->parse_html_template("dbupgrade/upgrade_message2", $control) unless $silent; - open(CONF, ">$filename") or $self->error("$filename : $!"); - - # create the config file - print CONF qq|# configuration file for $self->{login} - -\%myconfig = ( -|; - - foreach $key (sort @config) { - $self->{$key} =~ s/\'/\\\'/g; - print CONF qq| $key => '$self->{$key}',\n|; + $dbupdater->process_file($script_dbh, "sql/Pg-upgrade2/$control->{file}", $control); } - print CONF qq|);\n\n|; - - close CONF; - - $main::lxdebug->leave_sub(); -} - -sub save_member { - $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 = ; + $::lxdebug->log_time("DB upgrades finished"); - 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; - } - - print CONF qq|[$self->{login}]\n|; - - 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 ($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(); + $dbh->disconnect; + $superuser_dbh->disconnect if $superuser_dbh; } -sub config_vars { - $main::lxdebug->enter_sub(); - - my @conf = qw(acs address admin businessnumber charset company countrycode - currency dateformat dbconnect dbdriver dbhost dbport dboptions - dbname dbuser dbpasswd email fax name numberformat password - 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); - - $main::lxdebug->leave_sub(); - - return @conf; +sub data { + +{ %{ $_[0] } } } -sub error { - $main::lxdebug->enter_sub(); - - my ($self, $msg) = @_; - - if ($ENV{HTTP_USER_AGENT}) { - print qq|Content-Type: text/html - - - - - -

Error!

-

$msg|; - - } - - die "Error: $msg\n"; - - $main::lxdebug->leave_sub(); +sub get_default_myconfig { + my ($self_or_class, %user_config) = @_; + my $defaults = SL::DefaultManager->new($::lx_office_conf{system}->{default_manager}); + + return ( + countrycode => $defaults->language('de'), + css_path => 'css', # Needed for menunew, see SL::Layout::Base::get_stylesheet_for_user + dateformat => $defaults->dateformat('dd.mm.yy'), + numberformat => $defaults->numberformat('1.000,00'), + stylesheet => $defaults->stylesheet('kivitendo.css'), + timeformat => $defaults->timeformat('hh:mm'), + %user_config, + ); } 1; -