remove unnecessary spaces
[kivitendo-erp.git] / SL / User.pm
1 #=====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (C) 2001
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 #  Contributors:
16 #
17 # This program is free software; you can redistribute it and/or modify
18 # it under the terms of the GNU General Public License as published by
19 # the Free Software Foundation; either version 2 of the License, or
20 # (at your option) any later version.
21 #
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
25 # GNU General Public License for more details.
26 # You should have received a copy of the GNU General Public License
27 # along with this program; if not, write to the Free Software
28 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
29 # MA 02110-1335, USA.
30 #=====================================================================
31 #
32 # user related functions
33 #
34 #=====================================================================
35
36 package User;
37
38 use IO::File;
39 use List::MoreUtils qw(any);
40
41 use SL::DB;
42 #use SL::Auth;
43 use SL::DB::AuthClient;
44 use SL::DB::Employee;
45 use SL::DBConnect;
46 use SL::DBUpgrade2;
47 use SL::DBUtils;
48 use SL::Iconv;
49 use SL::Inifile;
50 use SL::System::InstallationLock;
51 use SL::DefaultManager;
52
53 use strict;
54
55 use constant LOGIN_OK                      =>  0;
56 use constant LOGIN_BASIC_TABLES_MISSING    => -1;
57 use constant LOGIN_DBUPDATE_AVAILABLE      => -2;
58 use constant LOGIN_AUTH_DBUPDATE_AVAILABLE => -3;
59 use constant LOGIN_GENERAL_ERROR           => -4;
60
61 sub new {
62   $main::lxdebug->enter_sub();
63
64   my ($type, %params) = @_;
65
66   my $self = {};
67
68   if ($params{id} || $params{login}) {
69     my %user_data = $main::auth->read_user(%params);
70     map { $self->{$_} = $user_data{$_} } keys %user_data;
71   }
72
73   $main::lxdebug->leave_sub();
74
75   bless $self, $type;
76 }
77
78 sub country_codes {
79   $main::lxdebug->enter_sub();
80
81   local *DIR;
82
83   my %cc       = ();
84   my @language = ();
85
86   # scan the locale directory and read in the LANGUAGE files
87   opendir(DIR, "locale");
88
89   my @dir = grep(!/(^\.\.?$|\..*)/, readdir(DIR));
90
91   foreach my $dir (@dir) {
92     next unless open(my $fh, '<:encoding(UTF-8)', "locale/$dir/LANGUAGE");
93     @language = <$fh>;
94     close $fh;
95
96     $cc{$dir} = "@language";
97   }
98
99   closedir(DIR);
100
101   $main::lxdebug->leave_sub();
102
103   return %cc;
104 }
105
106 sub _handle_superuser_privileges {
107   my ($self, $form) = @_;
108
109   if ($form->{database_superuser_username}) {
110     $::auth->set_session_value("database_superuser_username" => $form->{database_superuser_username}, "database_superuser_password" => $form->{database_superuser_password});
111   }
112
113   my %dbconnect_form          = %{ $form };
114   my ($su_user, $su_password) = map { $::auth->get_session_value("database_superuser_$_") } qw(username password);
115
116   if ($su_user) {
117     $dbconnect_form{dbuser}   = $su_user;
118     $dbconnect_form{dbpasswd} = $su_password;
119   }
120
121   dbconnect_vars(\%dbconnect_form, $form->{dbname});
122
123   my %result = (
124     username => $dbconnect_form{dbuser},
125     password => $dbconnect_form{dbpasswd},
126   );
127
128   $::auth->set_session_value("database_superuser_username" => $dbconnect_form{dbuser}, "database_superuser_password" => $dbconnect_form{dbpasswd});
129
130   my $dbh = SL::DBConnect->connect($dbconnect_form{dbconnect}, $dbconnect_form{dbuser}, $dbconnect_form{dbpasswd}, SL::DBConnect->get_options);
131   return (%result, error => $::locale->text('The credentials (username & password) for connecting database are wrong.')) if !$dbh;
132
133   my $is_superuser = SL::DBUtils::role_is_superuser($dbh, $dbconnect_form{dbuser});
134
135   $dbh->disconnect;
136
137   return (%result, have_privileges => 1) if $is_superuser;
138   return (%result)                       if !$su_user; # no error message if credentials weren't set by the user
139   return (%result, error => $::locale->text('The database user \'#1\' does not have superuser privileges.', $dbconnect_form{dbuser}));
140 }
141
142 sub login {
143   my ($self, $form) = @_;
144
145   return LOGIN_GENERAL_ERROR() if !$self->{login} || !$::auth->client;
146
147   my %myconfig = $main::auth->read_user(login => $self->{login});
148
149   # Auth DB upgrades available?
150   my $dbupdater_auth = SL::DBUpgrade2->new(form => $form, auth => 1)->parse_dbupdate_controls;
151   return LOGIN_AUTH_DBUPDATE_AVAILABLE() if $dbupdater_auth->unapplied_upgrade_scripts($::auth->dbconnect);
152
153   # check if database is down
154   my $dbh = SL::DB->client->dbh;
155
156   # we got a connection, check the version
157   my ($dbversion) = $dbh->selectrow_array(qq|SELECT version FROM defaults|);
158   if (!$dbversion) {
159     $dbh->disconnect;
160     return LOGIN_BASIC_TABLES_MISSING();
161   }
162
163   $self->create_schema_info_table($form, $dbh);
164
165   my $dbupdater        = SL::DBUpgrade2->new(form => $form)->parse_dbupdate_controls;
166   my @unapplied_scripts = $dbupdater->unapplied_upgrade_scripts($dbh);
167 #   $dbh->disconnect;
168
169   if (!@unapplied_scripts) {
170     SL::DB::Manager::Employee->update_entries_for_authorized_users;
171     return LOGIN_OK();
172   }
173
174   # Store the fact that we're applying database upgrades at the
175   # moment. That way functions called from the layout modules that may
176   # require updated tables can chose only to use basic features.
177   $::request->applying_database_upgrades(1);
178
179   $form->{$_} = $::auth->client->{$_} for qw(dbname dbhost dbport dbuser dbpasswd);
180   $form->{$_} = $myconfig{$_}         for qw(datestyle);
181
182   $form->{"title"} = $main::locale->text("Dataset upgrade");
183   $form->header(no_layout => $form->{no_layout});
184   print $form->parse_html_template("dbupgrade/header");
185
186   $form->{dbupdate} = "db" . $::auth->client->{dbname};
187
188   my $show_update_warning = $form->{"show_dbupdate_warning"};
189   my %superuser           = (need_privileges => (any { $_->{superuser_privileges} } @unapplied_scripts));
190
191   if ($superuser{need_privileges}) {
192     %superuser = (
193       %superuser,
194       $self->_handle_superuser_privileges($form),
195     );
196     $show_update_warning = 1 if !$superuser{have_privileges};
197   }
198
199   if ($show_update_warning) {
200     print $form->parse_html_template("dbupgrade/warning", {
201       unapplied_scripts => \@unapplied_scripts,
202       superuser         => \%superuser,
203     });
204     $::dispatcher->end_request;
205   }
206
207   # update the tables
208   SL::System::InstallationLock->lock;
209
210   # ignore HUP, QUIT in case the webserver times out
211   $SIG{HUP}  = 'IGNORE';
212   $SIG{QUIT} = 'IGNORE';
213
214   $self->dbupdate2(form => $form, updater => $dbupdater, database => $::auth->client->{dbname});
215
216   # If $self->dbupdate2 returns than this means all upgrade scripts
217   # have been applied successfully, none required user
218   # interaction. Otherwise the deeper layers would have called
219   # $::dispatcher->end_request already, and return would not have returned to
220   # us. Therefore we can now use RDBO instances because their supposed
221   # table structures do match the actual structures. So let's ensure
222   # that the "employee" table contains the appropriate entries for all
223   # users authorized for the current client.
224   SL::DB::Manager::Employee->update_entries_for_authorized_users;
225
226   SL::System::InstallationLock->unlock;
227
228   print $form->parse_html_template("dbupgrade/footer");
229
230   return LOGIN_DBUPDATE_AVAILABLE();
231 }
232
233 sub dbconnect_vars {
234   $main::lxdebug->enter_sub();
235
236   my ($form, $db) = @_;
237
238   my %dboptions = (
239     'yy-mm-dd'   => 'set DateStyle to \'ISO\'',
240     'yyyy-mm-dd' => 'set DateStyle to \'ISO\'',
241     'mm/dd/yy'   => 'set DateStyle to \'SQL, US\'',
242     'dd/mm/yy'   => 'set DateStyle to \'SQL, EUROPEAN\'',
243     'dd.mm.yy'   => 'set DateStyle to \'GERMAN\''
244   );
245
246   $form->{dboptions} = $dboptions{ $form->{dateformat} };
247   $form->{dbconnect} = "dbi:Pg:dbname=${db};host=" . ($form->{dbhost} || 'localhost') . ";port=" . ($form->{dbport} || 5432);
248
249   $main::lxdebug->leave_sub();
250 }
251
252 sub dbsources {
253   $main::lxdebug->enter_sub();
254
255   my ($self, $form) = @_;
256
257   my @dbsources = ();
258   my ($sth, $query);
259
260   $form->{dbdefault} = $form->{dbuser} unless $form->{dbdefault};
261   &dbconnect_vars($form, $form->{dbdefault});
262
263   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
264     or $form->dberror;
265
266   $query =
267     qq|SELECT datname FROM pg_database | .
268     qq|WHERE NOT datname IN ('template0', 'template1')|;
269   $sth = $dbh->prepare($query);
270   $sth->execute() || $form->dberror($query);
271
272   while (my ($db) = $sth->fetchrow_array) {
273
274     if ($form->{only_acc_db}) {
275
276       next if ($db =~ /^template/);
277
278       &dbconnect_vars($form, $db);
279       my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
280         or $form->dberror;
281
282       $query =
283         qq|SELECT tablename FROM pg_tables | .
284         qq|WHERE (tablename = 'defaults') AND (tableowner = ?)|;
285       my $sth = $dbh->prepare($query);
286       $sth->execute($form->{dbuser}) ||
287         $form->dberror($query . " ($form->{dbuser})");
288
289       if ($sth->fetchrow_array) {
290         push(@dbsources, $db);
291       }
292       $sth->finish;
293       $dbh->disconnect;
294       next;
295     }
296     push(@dbsources, $db);
297   }
298
299   $sth->finish;
300   $dbh->disconnect;
301
302   $main::lxdebug->leave_sub();
303
304   return @dbsources;
305 }
306
307 sub dbcreate {
308   $main::lxdebug->enter_sub();
309
310   my ($self, $form) = @_;
311
312   &dbconnect_vars($form, $form->{dbdefault});
313   my $dbh =
314     SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
315     or $form->dberror;
316   $form->{db} =~ s/\"//g;
317
318   my @dboptions;
319
320   push @dboptions, "ENCODING = " . $dbh->quote($form->{"encoding"}) if $form->{"encoding"};
321   if ($form->{"dbdefault"}) {
322     my $dbdefault = $form->{"dbdefault"};
323     $dbdefault =~ s/[^a-zA-Z0-9_\-]//g;
324     push @dboptions, "TEMPLATE = $dbdefault";
325   }
326
327   my $query = qq|CREATE DATABASE "$form->{db}"|;
328   $query   .= " WITH " . join(" ", @dboptions) if @dboptions;
329
330   # Ignore errors if the database exists.
331   $dbh->do($query);
332
333   $dbh->disconnect;
334
335   &dbconnect_vars($form, $form->{db});
336
337   # make a shim myconfig so that rose db connections work
338   $::myconfig{$_}     = $form->{$_} for qw(dbhost dbport dbuser dbpasswd);
339   $::myconfig{dbname} = $form->{db};
340
341   $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
342     or $form->dberror;
343
344   my $dbupdater = SL::DBUpgrade2->new(form => $form, return_on_error => 1, silent => 1)->parse_dbupdate_controls;
345   # create the tables
346   $dbupdater->process_query($dbh, "sql/lx-office.sql");
347   $dbupdater->process_query($dbh, "sql/$form->{chart}-chart.sql");
348
349   $query = qq|UPDATE defaults SET coa = ?|;
350   do_query($form, $dbh, $query, map { $form->{$_} } qw(chart));
351
352   $dbh->disconnect;
353
354   # update new database
355   $self->dbupdate2(form => $form, updater => $dbupdater, database => $form->{db}, silent => 1);
356
357   $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
358     or $form->dberror;
359
360   $query = "SELECT * FROM currencies WHERE name = ?";
361   my $curr = selectfirst_hashref_query($form, $dbh, $query, $form->{defaultcurrency});
362   if (!$curr->{id}) {
363     do_query($form, $dbh, "INSERT INTO currencies (name) VALUES (?)", $form->{defaultcurrency});
364     $curr = selectfirst_hashref_query($form, $dbh, $query, $form->{defaultcurrency});
365   }
366
367   $query = qq|UPDATE defaults SET
368     accounting_method = ?,
369     profit_determination = ?,
370     inventory_system = ?,
371     precision = ?,
372     currency_id = ?,
373     feature_balance = ?,
374     feature_datev = ?,
375     feature_erfolgsrechnung = ?,
376     feature_eurechnung = ?,
377     feature_ustva = ?
378   |;
379   do_query($form, $dbh, $query,
380     $form->{accounting_method},
381     $form->{profit_determination},
382     $form->{inventory_system},
383     $form->parse_amount(\%::myconfig, $form->{precision_as_number}),
384     $curr->{id},
385     $form->{feature_balance},
386     $form->{feature_datev},
387     $form->{feature_erfolgsrechnung},
388     $form->{feature_eurechnung},
389     $form->{feature_ustva}
390   );
391
392   $dbh->disconnect;
393
394   $main::lxdebug->leave_sub();
395 }
396
397 sub dbdelete {
398   $main::lxdebug->enter_sub();
399
400   my ($self, $form) = @_;
401   $form->{db} =~ s/\"//g;
402
403   &dbconnect_vars($form, $form->{dbdefault});
404   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options)
405     or $form->dberror;
406   my $query = qq|DROP DATABASE "$form->{db}"|;
407   do_query($form, $dbh, $query);
408
409   $dbh->disconnect;
410
411   $main::lxdebug->leave_sub();
412 }
413
414 sub calc_version {
415   $main::lxdebug->enter_sub(2);
416
417   my (@v, $version, $i);
418
419   @v = split(/\./, $_[0]);
420   while (scalar(@v) < 4) {
421     push(@v, 0);
422   }
423   $version = 0;
424   for ($i = 0; $i < 4; $i++) {
425     $version *= 1000;
426     $version += $v[$i];
427   }
428
429   $main::lxdebug->leave_sub(2);
430   return $version;
431 }
432
433 sub cmp_script_version {
434   my ($a_from, $a_to, $b_from, $b_to);
435   my ($i, $res_a, $res_b);
436   my ($my_a, $my_b) = do { no warnings 'once'; ($a, $b) };
437
438   $my_a =~ s/.*-upgrade-//;
439   $my_a =~ s/.sql$//;
440   $my_b =~ s/.*-upgrade-//;
441   $my_b =~ s/.sql$//;
442   my ($my_a_from, $my_a_to) = split(/-/, $my_a);
443   my ($my_b_from, $my_b_to) = split(/-/, $my_b);
444
445   $res_a = calc_version($my_a_from);
446   $res_b = calc_version($my_b_from);
447
448   if ($res_a == $res_b) {
449     $res_a = calc_version($my_a_to);
450     $res_b = calc_version($my_b_to);
451   }
452
453   return $res_a <=> $res_b;
454 }
455
456 sub create_schema_info_table {
457   $main::lxdebug->enter_sub();
458
459   my ($self, $form, $dbh) = @_;
460
461   my $query = "SELECT tag FROM schema_info LIMIT 1";
462   if (!$dbh->do($query)) {
463     $dbh->rollback();
464     $query =
465       qq|CREATE TABLE schema_info (| .
466       qq|  tag text, | .
467       qq|  login text, | .
468       qq|  itime timestamp DEFAULT now(), | .
469       qq|  PRIMARY KEY (tag))|;
470     $dbh->do($query) || $form->dberror($query);
471   }
472
473   $main::lxdebug->leave_sub();
474 }
475
476 sub dbupdate2 {
477   my ($self, %params) = @_;
478
479   my $form            = $params{form};
480   my $dbupdater       = $params{updater};
481   my $db              = $params{database};
482   my $silent          = $params{silent};
483
484   map { $_->{description} = SL::Iconv::convert($_->{charset}, 'UTF-8', $_->{description}) } values %{ $dbupdater->{all_controls} };
485
486   &dbconnect_vars($form, $db);
487
488   my $dbh = SL::DBConnect->connect($form->{dbconnect}, $form->{dbuser}, $form->{dbpasswd}, SL::DBConnect->get_options) or $form->dberror;
489
490   $dbh->do($form->{dboptions}) if ($form->{dboptions});
491
492   $self->create_schema_info_table($form, $dbh);
493
494   my @upgradescripts = $dbupdater->unapplied_upgrade_scripts($dbh);
495   my $need_superuser = (any { $_->{superuser_privileges} } @upgradescripts);
496   my $superuser_dbh;
497
498   if ($need_superuser) {
499     my %dbconnect_form = (
500       %{ $form },
501       dbuser   => $::auth->get_session_value("database_superuser_username"),
502       dbpasswd => $::auth->get_session_value("database_superuser_password"),
503     );
504
505     if ($dbconnect_form{dbuser} ne $form->{dbuser}) {
506       dbconnect_vars(\%dbconnect_form, $db);
507       $superuser_dbh = SL::DBConnect->connect($dbconnect_form{dbconnect}, $dbconnect_form{dbuser}, $dbconnect_form{dbpasswd}, SL::DBConnect->get_options) or $form->dberror;
508     }
509   }
510
511   $::lxdebug->log_time("DB upgrades commencing");
512
513   foreach my $control (@upgradescripts) {
514     # Apply upgrade. Control will only return to us if the upgrade has
515     # been applied correctly and if the update has not requested user
516     # interaction.
517     my $script_dbh = $control->{superuser_privileges} ? ($superuser_dbh // $dbh) : $dbh;
518
519     $::lxdebug->message(LXDebug->DEBUG2(), "Applying Update $control->{file}" . ($control->{superuser_privileges} ? " with superuser privileges" : ""));
520     print $form->parse_html_template("dbupgrade/upgrade_message2", $control) unless $silent;
521
522     $dbupdater->process_file($script_dbh, "sql/Pg-upgrade2/$control->{file}", $control);
523   }
524
525   $::lxdebug->log_time("DB upgrades finished");
526
527   $dbh->disconnect;
528   $superuser_dbh->disconnect if $superuser_dbh;
529 }
530
531 sub data {
532   +{ %{ $_[0] } }
533 }
534
535 sub get_default_myconfig {
536   my ($self_or_class, %user_config) = @_;
537   my $defaults = SL::DefaultManager->new($::lx_office_conf{system}->{default_manager});
538
539   return (
540     countrycode  => $defaults->language('de'),
541     css_path     => 'css',      # Needed for menunew, see SL::Layout::Base::get_stylesheet_for_user
542     dateformat   => $defaults->dateformat('dd.mm.yy'),
543     numberformat => $defaults->numberformat('1.000,00'),
544     stylesheet   => $defaults->stylesheet('kivitendo.css'),
545     timeformat   => $defaults->timeformat('hh:mm'),
546     %user_config,
547   );
548 }
549
550 1;