SL/Auth.pm

   1 package SL::Auth;
   2
   3 use DBI;
   4
   5 use Digest::MD5 qw(md5_hex);
   6 use IO::File;
   7 use Time::HiRes qw(gettimeofday);
   8 use List::MoreUtils qw(uniq);
   9 use YAML;
  10
  11 use SL::Auth::ColumnInformation;
  12 use SL::Auth::Constants qw(:all);
  13 use SL::Auth::DB;
  14 use SL::Auth::LDAP;
  15 use SL::Auth::Password;
  16 use SL::Auth::SessionValue;
  17
  18 use SL::SessionFile;
  19 use SL::User;
  20 use SL::DBConnect;
  21 use SL::DBUpgrade2;
  22 use SL::DBUtils;
  23
  24 use strict;
  25
  26 sub new {
  27   $main::lxdebug->enter_sub();
  28
  29   my $type = shift;
  30   my $self = {};
  31
  32   bless $self, $type;
  33
  34   $self->_read_auth_config();
  35   $self->reset;
  36
  37   $main::lxdebug->leave_sub();
  38
  39   return $self;
  40 }
  41
  42 sub reset {
  43   my ($self, %params) = @_;
  44
  45   $self->{SESSION}            = { };
  46   $self->{FULL_RIGHTS}        = { };
  47   $self->{RIGHTS}             = { };
  48   $self->{unique_counter}     = 0;
  49   $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
  50   $self->{authenticator}->reset;
  51 }
  52
  53 sub get_user_dbh {
  54   my ($self, $login, %params) = @_;
  55   my $may_fail = delete $params{may_fail};
  56
  57   my %user = $self->read_user($login);
  58   my $dbh  = SL::DBConnect->connect(
  59     $user{dbconnect},
  60     $user{dbuser},
  61     $user{dbpasswd},
  62     {
  63       pg_enable_utf8 => $::locale->is_utf8,
  64       AutoCommit     => 0
  65     }
  66   );
  67
  68   if (!$may_fail && !$dbh) {
  69     $::form->error($::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
  70   }
  71
  72   if ($user{dboptions} && $dbh) {
  73     $dbh->do($user{dboptions}) or $::form->dberror($user{dboptions});
  74   }
  75
  76   return $dbh;
  77 }
  78
  79 sub DESTROY {
  80   my $self = shift;
  81
  82   $self->{dbh}->disconnect() if ($self->{dbh});
  83 }
  84
  85 # form isn't loaded yet, so auth needs it's own error.
  86 sub mini_error {
  87   $::lxdebug->show_backtrace();
  88
  89   my ($self, @msg) = @_;
  90   if ($ENV{HTTP_USER_AGENT}) {
  91     print Form->create_http_response(content_type => 'text/html');
  92     print "<pre>", join ('<br>', @msg), "</pre>";
  93   } else {
  94     print STDERR "Error: @msg\n";
  95   }
  96   ::end_of_request();
  97 }
  98
  99 sub _read_auth_config {
 100   $main::lxdebug->enter_sub();
 101
 102   my $self = shift;
 103
 104   map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
 105   $self->{DB_config}   = $::lx_office_conf{'authentication/database'};
 106   $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
 107
 108   if ($self->{module} eq 'DB') {
 109     $self->{authenticator} = SL::Auth::DB->new($self);
 110
 111   } elsif ($self->{module} eq 'LDAP') {
 112     $self->{authenticator} = SL::Auth::LDAP->new($self);
 113   }
 114
 115   if (!$self->{authenticator}) {
 116     my $locale = Locale->new('en');
 117     $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/lx_office.conf".'));
 118   }
 119
 120   my $cfg = $self->{DB_config};
 121
 122   if (!$cfg) {
 123     my $locale = Locale->new('en');
 124     $self->mini_error($locale->text('config/lx_office.conf: Key "DB_config" is missing.'));
 125   }
 126
 127   if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
 128     my $locale = Locale->new('en');
 129     $self->mini_error($locale->text('config/lx_office.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
 130   }
 131
 132   $self->{authenticator}->verify_config();
 133
 134   $self->{session_timeout} *= 1;
 135   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
 136
 137   $main::lxdebug->leave_sub();
 138 }
 139
 140 sub authenticate_root {
 141   $main::lxdebug->enter_sub();
 142
 143   my ($self, $password) = @_;
 144
 145   $password             = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $password);
 146   my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password});
 147
 148   $main::lxdebug->leave_sub();
 149
 150   return OK if $password eq $admin_password;
 151   sleep 5;
 152   return ERR_PASSWORD;
 153 }
 154
 155 sub authenticate {
 156   $main::lxdebug->enter_sub();
 157
 158   my ($self, $login, $password) = @_;
 159
 160   $main::lxdebug->leave_sub();
 161
 162   my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
 163   return OK if $result eq OK;
 164   sleep 5;
 165   return $result;
 166 }
 167
 168 sub store_credentials_in_session {
 169   my ($self, %params) = @_;
 170
 171   if (!$self->{authenticator}->requires_cleartext_password) {
 172     $params{password} = SL::Auth::Password->hash_if_unhashed(login             => $params{login},
 173                                                              password          => $params{password},
 174                                                              look_up_algorithm => 1,
 175                                                              auth              => $self);
 176   }
 177
 178   $self->set_session_value(login => $params{login}, password => $params{password});
 179 }
 180
 181 sub store_root_credentials_in_session {
 182   my ($self, $rpw) = @_;
 183
 184   $self->set_session_value(rpw => SL::Auth::Password->hash_if_unhashed(login => 'root', password => $rpw));
 185 }
 186
 187 sub get_stored_password {
 188   my ($self, $login) = @_;
 189
 190   my $dbh            = $self->dbconnect;
 191
 192   return undef unless $dbh;
 193
 194   my $query             = qq|SELECT password FROM auth."user" WHERE login = ?|;
 195   my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
 196
 197   return $stored_password;
 198 }
 199
 200 sub dbconnect {
 201   $main::lxdebug->enter_sub(2);
 202
 203   my $self     = shift;
 204   my $may_fail = shift;
 205
 206   if ($self->{dbh}) {
 207     $main::lxdebug->leave_sub(2);
 208     return $self->{dbh};
 209   }
 210
 211   my $cfg = $self->{DB_config};
 212   my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
 213
 214   if ($cfg->{port}) {
 215     $dsn .= ';port=' . $cfg->{port};
 216   }
 217
 218   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 219
 220   $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => $::locale->is_utf8, AutoCommit => 1 });
 221
 222   if (!$may_fail && !$self->{dbh}) {
 223     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
 224   }
 225
 226   $main::lxdebug->leave_sub(2);
 227
 228   return $self->{dbh};
 229 }
 230
 231 sub dbdisconnect {
 232   $main::lxdebug->enter_sub();
 233
 234   my $self = shift;
 235
 236   if ($self->{dbh}) {
 237     $self->{dbh}->disconnect();
 238     delete $self->{dbh};
 239   }
 240
 241   $main::lxdebug->leave_sub();
 242 }
 243
 244 sub check_tables {
 245   $main::lxdebug->enter_sub();
 246
 247   my $self    = shift;
 248
 249   my $dbh     = $self->dbconnect();
 250   my $query   = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
 251
 252   my ($count) = $dbh->selectrow_array($query);
 253
 254   $main::lxdebug->leave_sub();
 255
 256   return $count > 0;
 257 }
 258
 259 sub check_database {
 260   $main::lxdebug->enter_sub();
 261
 262   my $self = shift;
 263
 264   my $dbh  = $self->dbconnect(1);
 265
 266   $main::lxdebug->leave_sub();
 267
 268   return $dbh ? 1 : 0;
 269 }
 270
 271 sub create_database {
 272   $main::lxdebug->enter_sub();
 273
 274   my $self   = shift;
 275   my %params = @_;
 276
 277   my $cfg    = $self->{DB_config};
 278
 279   if (!$params{superuser}) {
 280     $params{superuser}          = $cfg->{user};
 281     $params{superuser_password} = $cfg->{password};
 282   }
 283
 284   $params{template} ||= 'template0';
 285   $params{template}   =~ s|[^a-zA-Z0-9_\-]||g;
 286
 287   my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
 288
 289   if ($cfg->{port}) {
 290     $dsn .= ';port=' . $cfg->{port};
 291   }
 292
 293   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
 294
 295   my $charset    = $::lx_office_conf{system}->{dbcharset};
 296   $charset     ||= Common::DEFAULT_CHARSET;
 297   my $encoding   = $Common::charset_to_db_encoding{$charset};
 298   $encoding    ||= 'UNICODE';
 299
 300   my $dbh        = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => scalar($charset =~ m/^utf-?8$/i) });
 301
 302   if (!$dbh) {
 303     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
 304   }
 305
 306   my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
 307
 308   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
 309
 310   $dbh->do($query);
 311
 312   if ($dbh->err) {
 313     my $error = $dbh->errstr();
 314
 315     $query                 = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 316     my ($cluster_encoding) = $dbh->selectrow_array($query);
 317
 318     if ($cluster_encoding && ($cluster_encoding =~ m/^(?:UTF-?8|UNICODE)$/i) && ($encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
 319       $error = $main::locale->text('Your PostgreSQL installationen uses UTF-8 as its encoding. Therefore you have to configure Lx-Office to use UTF-8 as well.');
 320     }
 321
 322     $dbh->disconnect();
 323
 324     $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
 325   }
 326
 327   $dbh->disconnect();
 328
 329   $main::lxdebug->leave_sub();
 330 }
 331
 332 sub create_tables {
 333   $main::lxdebug->enter_sub();
 334
 335   my $self = shift;
 336   my $dbh  = $self->dbconnect();
 337
 338   my $charset    = $::lx_office_conf{system}->{dbcharset};
 339   $charset     ||= Common::DEFAULT_CHARSET;
 340
 341   $dbh->rollback();
 342   SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql', undef, $charset);
 343
 344   $main::lxdebug->leave_sub();
 345 }
 346
 347 sub save_user {
 348   $main::lxdebug->enter_sub();
 349
 350   my $self   = shift;
 351   my $login  = shift;
 352   my %params = @_;
 353
 354   my $form   = $main::form;
 355
 356   my $dbh    = $self->dbconnect();
 357
 358   my ($sth, $query, $user_id);
 359
 360   $dbh->begin_work;
 361
 362   $query     = qq|SELECT id FROM auth."user" WHERE login = ?|;
 363   ($user_id) = selectrow_query($form, $dbh, $query, $login);
 364
 365   if (!$user_id) {
 366     $query     = qq|SELECT nextval('auth.user_id_seq')|;
 367     ($user_id) = selectrow_query($form, $dbh, $query);
 368
 369     $query     = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
 370     do_query($form, $dbh, $query, $user_id, $login);
 371   }
 372
 373   $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
 374   do_query($form, $dbh, $query, $user_id);
 375
 376   $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
 377   $sth   = prepare_query($form, $dbh, $query);
 378
 379   while (my ($cfg_key, $cfg_value) = each %params) {
 380     next if ($cfg_key eq 'password');
 381
 382     do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
 383   }
 384
 385   $dbh->commit();
 386
 387   $main::lxdebug->leave_sub();
 388 }
 389
 390 sub can_change_password {
 391   my $self = shift;
 392
 393   return $self->{authenticator}->can_change_password();
 394 }
 395
 396 sub change_password {
 397   $main::lxdebug->enter_sub();
 398
 399   my ($self, $login, $new_password) = @_;
 400
 401   my $result = $self->{authenticator}->change_password($login, $new_password);
 402
 403   $self->store_credentials_in_session(login             => $login,
 404                                       password          => $new_password,
 405                                       look_up_algorithm => 1,
 406                                       auth              => $self);
 407
 408   $main::lxdebug->leave_sub();
 409
 410   return $result;
 411 }
 412
 413 sub read_all_users {
 414   $main::lxdebug->enter_sub();
 415
 416   my $self  = shift;
 417
 418   my $dbh   = $self->dbconnect();
 419   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
 420                  FROM auth.user_config cfg
 421                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
 422   my $sth   = prepare_execute_query($main::form, $dbh, $query);
 423
 424   my %users;
 425
 426   while (my $ref = $sth->fetchrow_hashref()) {
 427     $users{$ref->{login}}                    ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
 428     $users{$ref->{login}}->{$ref->{cfg_key}}   = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
 429   }
 430
 431   $sth->finish();
 432
 433   $main::lxdebug->leave_sub();
 434
 435   return %users;
 436 }
 437
 438 sub read_user {
 439   $main::lxdebug->enter_sub();
 440
 441   my $self  = shift;
 442   my $login = shift;
 443
 444   my $dbh   = $self->dbconnect();
 445   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
 446                  FROM auth.user_config cfg
 447                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
 448                  WHERE (u.login = ?)|;
 449   my $sth   = prepare_execute_query($main::form, $dbh, $query, $login);
 450
 451   my %user_data;
 452
 453   while (my $ref = $sth->fetchrow_hashref()) {
 454     $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
 455     @user_data{qw(id login)}    = @{$ref}{qw(id login)};
 456   }
 457
 458   # The XUL/XML backed menu has been removed.
 459   $user_data{menustyle} = 'v3' if lc($user_data{menustyle} || '') eq 'xml';
 460
 461   $sth->finish();
 462
 463   $main::lxdebug->leave_sub();
 464
 465   return %user_data;
 466 }
 467
 468 sub get_user_id {
 469   $main::lxdebug->enter_sub();
 470
 471   my $self  = shift;
 472   my $login = shift;
 473
 474   my $dbh   = $self->dbconnect();
 475   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
 476
 477   $main::lxdebug->leave_sub();
 478
 479   return $id;
 480 }
 481
 482 sub delete_user {
 483   $::lxdebug->enter_sub;
 484
 485   my $self  = shift;
 486   my $login = shift;
 487
 488   my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
 489   my $dbh   = $self->dbconnect;
 490
 491   $dbh->begin_work;
 492
 493   my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
 494
 495   my ($id)  = selectrow_query($::form, $dbh, $query, $login);
 496
 497   $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
 498
 499   do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
 500   do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
 501   do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh;
 502
 503   $dbh->commit;
 504   $u_dbh->commit if $u_dbh;
 505
 506   $::lxdebug->leave_sub;
 507 }
 508
 509 # --------------------------------------
 510
 511 my $session_id;
 512
 513 sub restore_session {
 514   $main::lxdebug->enter_sub();
 515
 516   my $self = shift;
 517
 518   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
 519   $session_id        =~ s|[^0-9a-f]||g if $session_id;
 520
 521   $self->{SESSION}   = { };
 522
 523   if (!$session_id) {
 524     $main::lxdebug->leave_sub();
 525     return SESSION_NONE;
 526   }
 527
 528   my ($dbh, $query, $sth, $cookie, $ref, $form);
 529
 530   $form   = $main::form;
 531
 532   # Don't fail if the auth DB doesn't yet.
 533   if (!( $dbh = $self->dbconnect(1) )) {
 534     $::lxdebug->leave_sub;
 535     return SESSION_NONE;
 536   }
 537
 538   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
 539   # admin is creating the session tables at the moment.
 540   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
 541
 542   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
 543     $sth->finish if $sth;
 544     $::lxdebug->leave_sub;
 545     return SESSION_NONE;
 546   }
 547
 548   $cookie = $sth->fetchrow_hashref;
 549   $sth->finish;
 550
 551   if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
 552     $self->destroy_session();
 553     $main::lxdebug->leave_sub();
 554     return $cookie ? SESSION_EXPIRED : SESSION_NONE;
 555   }
 556
 557   if ($self->{column_information}->has('auto_restore')) {
 558     $self->_load_with_auto_restore_column($dbh, $session_id);
 559   } else {
 560     $self->_load_without_auto_restore_column($dbh, $session_id);
 561   }
 562
 563   $main::lxdebug->leave_sub();
 564
 565   return SESSION_OK;
 566 }
 567
 568 sub _load_without_auto_restore_column {
 569   my ($self, $dbh, $session_id) = @_;
 570
 571   my $query = <<SQL;
 572     SELECT sess_key, sess_value
 573     FROM auth.session_content
 574     WHERE (session_id = ?)
 575 SQL
 576   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 577
 578   while (my $ref = $sth->fetchrow_hashref) {
 579     my $value = SL::Auth::SessionValue->new(auth  => $self,
 580                                             key   => $ref->{sess_key},
 581                                             value => $ref->{sess_value},
 582                                             raw   => 1);
 583     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 584
 585     next if defined $::form->{$ref->{sess_key}};
 586
 587     my $data                    = $value->get;
 588     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 589   }
 590 }
 591
 592 sub _load_with_auto_restore_column {
 593   my ($self, $dbh, $session_id) = @_;
 594
 595   my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
 596
 597   my $query = <<SQL;
 598     SELECT sess_key, sess_value, auto_restore
 599     FROM auth.session_content
 600     WHERE (session_id = ?)
 601       AND (   auto_restore
 602            OR sess_key IN (${auto_restore_keys}))
 603 SQL
 604   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 605
 606   while (my $ref = $sth->fetchrow_hashref) {
 607     my $value = SL::Auth::SessionValue->new(auth         => $self,
 608                                             key          => $ref->{sess_key},
 609                                             value        => $ref->{sess_value},
 610                                             auto_restore => $ref->{auto_restore},
 611                                             raw          => 1);
 612     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 613
 614     next if defined $::form->{$ref->{sess_key}};
 615
 616     my $data                    = $value->get;
 617     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 618   }
 619
 620   $sth->finish;
 621
 622   $query = <<SQL;
 623     SELECT sess_key
 624     FROM auth.session_content
 625     WHERE (session_id = ?)
 626       AND NOT COALESCE(auto_restore, FALSE)
 627       AND (sess_key NOT IN (${auto_restore_keys}))
 628 SQL
 629   $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 630
 631   while (my $ref = $sth->fetchrow_hashref) {
 632     my $value = SL::Auth::SessionValue->new(auth => $self,
 633                                             key  => $ref->{sess_key});
 634     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 635   }
 636 }
 637
 638 sub destroy_session {
 639   $main::lxdebug->enter_sub();
 640
 641   my $self = shift;
 642
 643   if ($session_id) {
 644     my $dbh = $self->dbconnect();
 645
 646     $dbh->begin_work;
 647
 648     do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
 649     do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
 650
 651     $dbh->commit();
 652
 653     SL::SessionFile->destroy_session($session_id);
 654
 655     $session_id      = undef;
 656     $self->{SESSION} = { };
 657   }
 658
 659   $main::lxdebug->leave_sub();
 660 }
 661
 662 sub expire_sessions {
 663   $main::lxdebug->enter_sub();
 664
 665   my $self  = shift;
 666
 667   $main::lxdebug->leave_sub and return if !$self->session_tables_present;
 668
 669   my $dbh   = $self->dbconnect();
 670
 671   my $query = qq|SELECT id
 672                  FROM auth.session
 673                  WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
 674
 675   my @ids   = selectall_array_query($::form, $dbh, $query);
 676
 677   if (@ids) {
 678     $dbh->begin_work;
 679
 680     SL::SessionFile->destroy_session($_) for @ids;
 681
 682     $query = qq|DELETE FROM auth.session_content
 683                 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 684     do_query($main::form, $dbh, $query, @ids);
 685
 686     $query = qq|DELETE FROM auth.session
 687                 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 688     do_query($main::form, $dbh, $query, @ids);
 689
 690     $dbh->commit();
 691   }
 692
 693   $main::lxdebug->leave_sub();
 694 }
 695
 696 sub _create_session_id {
 697   $main::lxdebug->enter_sub();
 698
 699   my @data;
 700   map { push @data, int(rand() * 255); } (1..32);
 701
 702   my $id = md5_hex(pack 'C*', @data);
 703
 704   $main::lxdebug->leave_sub();
 705
 706   return $id;
 707 }
 708
 709 sub create_or_refresh_session {
 710   $session_id ||= shift->_create_session_id;
 711 }
 712
 713 sub save_session {
 714   $::lxdebug->enter_sub;
 715   my $self         = shift;
 716   my $provided_dbh = shift;
 717
 718   my $dbh          = $provided_dbh || $self->dbconnect(1);
 719
 720   $::lxdebug->leave_sub && return unless $dbh && $session_id;
 721
 722   $dbh->begin_work unless $provided_dbh;
 723
 724   # If this fails then the "auth" schema might not exist yet, e.g. if
 725   # the admin is just trying to create the auth database.
 726   if (!$dbh->do(qq|LOCK auth.session_content|)) {
 727     $dbh->rollback unless $provided_dbh;
 728     $::lxdebug->leave_sub;
 729     return;
 730   }
 731
 732   my @unfetched_keys = map     { $_->{key}        }
 733                        grep    { ! $_->{fetched}  }
 734                        values %{ $self->{SESSION} };
 735   # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
 736   # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
 737   my $query          = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
 738   $query            .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
 739
 740   do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
 741
 742   my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
 743
 744   if ($id) {
 745     do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
 746   } else {
 747     do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
 748   }
 749
 750   my @values_to_save = grep    { $_->{fetched} }
 751                        values %{ $self->{SESSION} };
 752   if (@values_to_save) {
 753     my ($columns, $placeholders) = ('', '');
 754     my $auto_restore             = $self->{column_information}->has('auto_restore');
 755
 756     if ($auto_restore) {
 757       $columns      .= ', auto_restore';
 758       $placeholders .= ', ?';
 759     }
 760
 761     $query  = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
 762     my $sth = prepare_query($::form, $dbh, $query);
 763
 764     foreach my $value (@values_to_save) {
 765       my @values = ($value->{key}, $value->get_dumped);
 766       push @values, $value->{auto_restore} if $auto_restore;
 767
 768       do_statement($::form, $sth, $query, $session_id, @values);
 769     }
 770
 771     $sth->finish();
 772   }
 773
 774   $dbh->commit() unless $provided_dbh;
 775   $::lxdebug->leave_sub;
 776 }
 777
 778 sub set_session_value {
 779   $main::lxdebug->enter_sub();
 780
 781   my $self   = shift;
 782   my @params = @_;
 783
 784   $self->{SESSION} ||= { };
 785
 786   while (@params) {
 787     my $key = shift @params;
 788
 789     if (ref $key eq 'HASH') {
 790       $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key          => $key->{key},
 791                                                                       value        => $key->{value},
 792                                                                       auto_restore => $key->{auto_restore});
 793
 794     } else {
 795       my $value = shift @params;
 796       $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key   => $key,
 797                                                                value => $value);
 798     }
 799   }
 800
 801   $main::lxdebug->leave_sub();
 802
 803   return $self;
 804 }
 805
 806 sub delete_session_value {
 807   $main::lxdebug->enter_sub();
 808
 809   my $self = shift;
 810
 811   $self->{SESSION} ||= { };
 812   delete @{ $self->{SESSION} }{ @_ };
 813
 814   $main::lxdebug->leave_sub();
 815
 816   return $self;
 817 }
 818
 819 sub get_session_value {
 820   $main::lxdebug->enter_sub();
 821
 822   my $self = shift;
 823   my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
 824
 825   $main::lxdebug->leave_sub();
 826
 827   return $data;
 828 }
 829
 830 sub create_unique_sesion_value {
 831   my ($self, $value, %params) = @_;
 832
 833   $self->{SESSION} ||= { };
 834
 835   my @now                   = gettimeofday();
 836   my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
 837   $self->{unique_counter} ||= 0;
 838
 839   my $hashed_key;
 840   do {
 841     $self->{unique_counter}++;
 842     $hashed_key = md5_hex($key . $self->{unique_counter});
 843   } while (exists $self->{SESSION}->{$hashed_key});
 844
 845   $self->set_session_value($hashed_key => $value);
 846
 847   return $hashed_key;
 848 }
 849
 850 sub save_form_in_session {
 851   my ($self, %params) = @_;
 852
 853   my $form        = delete($params{form}) || $::form;
 854   my $non_scalars = delete $params{non_scalars};
 855   my $data        = {};
 856
 857   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
 858
 859   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
 860     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
 861   }
 862
 863   return $self->create_unique_sesion_value($data, %params);
 864 }
 865
 866 sub restore_form_from_session {
 867   my ($self, $key, %params) = @_;
 868
 869   my $data = $self->get_session_value($key);
 870   return $self unless $data;
 871
 872   my $form    = delete($params{form}) || $::form;
 873   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
 874
 875   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
 876
 877   return $self;
 878 }
 879
 880 sub set_cookie_environment_variable {
 881   my $self = shift;
 882   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
 883 }
 884
 885 sub get_session_cookie_name {
 886   my $self = shift;
 887
 888   return $self->{cookie_name} || 'lx_office_erp_session_id';
 889 }
 890
 891 sub get_session_id {
 892   return $session_id;
 893 }
 894
 895 sub session_tables_present {
 896   $main::lxdebug->enter_sub();
 897
 898   my $self = shift;
 899
 900   # Only re-check for the presence of auth tables if either the check
 901   # hasn't been done before of if they weren't present.
 902   if ($self->{session_tables_present}) {
 903     $main::lxdebug->leave_sub();
 904     return $self->{session_tables_present};
 905   }
 906
 907   my $dbh  = $self->dbconnect(1);
 908
 909   if (!$dbh) {
 910     $main::lxdebug->leave_sub();
 911     return 0;
 912   }
 913
 914   my $query =
 915     qq|SELECT COUNT(*)
 916        FROM pg_tables
 917        WHERE (schemaname = 'auth')
 918          AND (tablename IN ('session', 'session_content'))|;
 919
 920   my ($count) = selectrow_query($main::form, $dbh, $query);
 921
 922   $self->{session_tables_present} = 2 == $count;
 923
 924   $main::lxdebug->leave_sub();
 925
 926   return $self->{session_tables_present};
 927 }
 928
 929 # --------------------------------------
 930
 931 sub all_rights_full {
 932   my $locale = $main::locale;
 933
 934   my @all_rights = (
 935     ["--crm",                          $locale->text("CRM optional software")],
 936     ["crm_search",                     $locale->text("CRM search")],
 937     ["crm_new",                        $locale->text("CRM create customers, vendors and contacts")],
 938     ["crm_service",                    $locale->text("CRM services")],
 939     ["crm_admin",                      $locale->text("CRM admin")],
 940     ["crm_adminuser",                  $locale->text("CRM user")],
 941     ["crm_adminstatus",                $locale->text("CRM status")],
 942     ["crm_email",                      $locale->text("CRM send email")],
 943     ["crm_termin",                     $locale->text("CRM termin")],
 944     ["crm_opportunity",                $locale->text("CRM opportunity")],
 945     ["crm_knowhow",                    $locale->text("CRM know how")],
 946     ["crm_follow",                     $locale->text("CRM follow up")],
 947     ["crm_notices",                    $locale->text("CRM notices")],
 948     ["crm_other",                      $locale->text("CRM other")],
 949     ["--master_data",                  $locale->text("Master Data")],
 950     ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
 951     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
 952     ["project_edit",                   $locale->text("Create and edit projects")],
 953     ["--ar",                           $locale->text("AR")],
 954     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
 955     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
 956     ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
 957     ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
 958     ["dunning_edit",                   $locale->text("Create and edit dunnings")],
 959     ["sales_all_edit",                 $locale->text("View/edit all employees sales documents")],
 960     ["edit_prices",                    $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
 961     ["--ap",                           $locale->text("AP")],
 962     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
 963     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
 964     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
 965     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
 966     ["--warehouse_management",         $locale->text("Warehouse management")],
 967     ["warehouse_contents",             $locale->text("View warehouse content")],
 968     ["warehouse_management",           $locale->text("Warehouse management")],
 969     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
 970     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
 971     ["datev_export",                   $locale->text("DATEV Export")],
 972     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
 973     ["--reports",                      $locale->text('Reports')],
 974     ["report",                         $locale->text('All reports')],
 975     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
 976     ["--batch_printing",               $locale->text("Batch Printing")],
 977     ["batch_printing",                 $locale->text("Batch Printing")],
 978     ["--others",                       $locale->text("Others")],
 979     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
 980     ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
 981     );
 982
 983   return @all_rights;
 984 }
 985
 986 sub all_rights {
 987   return grep !/^--/, map { $_->[0] } all_rights_full();
 988 }
 989
 990 sub read_groups {
 991   $main::lxdebug->enter_sub();
 992
 993   my $self = shift;
 994
 995   my $form   = $main::form;
 996   my $groups = {};
 997   my $dbh    = $self->dbconnect();
 998
 999   my $query  = 'SELECT * FROM auth."group"';
1000   my $sth    = prepare_execute_query($form, $dbh, $query);
1001
1002   my ($row, $group);
1003
1004   while ($row = $sth->fetchrow_hashref()) {
1005     $groups->{$row->{id}} = $row;
1006   }
1007   $sth->finish();
1008
1009   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1010   $sth   = prepare_query($form, $dbh, $query);
1011
1012   foreach $group (values %{$groups}) {
1013     my @members;
1014
1015     do_statement($form, $sth, $query, $group->{id});
1016
1017     while ($row = $sth->fetchrow_hashref()) {
1018       push @members, $row->{user_id};
1019     }
1020     $group->{members} = [ uniq @members ];
1021   }
1022   $sth->finish();
1023
1024   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1025   $sth   = prepare_query($form, $dbh, $query);
1026
1027   foreach $group (values %{$groups}) {
1028     $group->{rights} = {};
1029
1030     do_statement($form, $sth, $query, $group->{id});
1031
1032     while ($row = $sth->fetchrow_hashref()) {
1033       $group->{rights}->{$row->{right}} |= $row->{granted};
1034     }
1035
1036     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1037   }
1038   $sth->finish();
1039
1040   $main::lxdebug->leave_sub();
1041
1042   return $groups;
1043 }
1044
1045 sub save_group {
1046   $main::lxdebug->enter_sub();
1047
1048   my $self  = shift;
1049   my $group = shift;
1050
1051   my $form  = $main::form;
1052   my $dbh   = $self->dbconnect();
1053
1054   $dbh->begin_work;
1055
1056   my ($query, $sth, $row, $rights);
1057
1058   if (!$group->{id}) {
1059     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1060
1061     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1062     do_query($form, $dbh, $query, $group->{id});
1063   }
1064
1065   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1066
1067   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1068
1069   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1070   $sth    = prepare_query($form, $dbh, $query);
1071
1072   foreach my $user_id (uniq @{ $group->{members} }) {
1073     do_statement($form, $sth, $query, $user_id, $group->{id});
1074   }
1075   $sth->finish();
1076
1077   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1078
1079   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1080   $sth   = prepare_query($form, $dbh, $query);
1081
1082   foreach my $right (keys %{ $group->{rights} }) {
1083     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1084   }
1085   $sth->finish();
1086
1087   $dbh->commit();
1088
1089   $main::lxdebug->leave_sub();
1090 }
1091
1092 sub delete_group {
1093   $main::lxdebug->enter_sub();
1094
1095   my $self = shift;
1096   my $id   = shift;
1097
1098   my $form = $main::form;
1099
1100   my $dbh  = $self->dbconnect();
1101   $dbh->begin_work;
1102
1103   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1104   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1105   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1106
1107   $dbh->commit();
1108
1109   $main::lxdebug->leave_sub();
1110 }
1111
1112 sub evaluate_rights_ary {
1113   $main::lxdebug->enter_sub(2);
1114
1115   my $ary    = shift;
1116
1117   my $value  = 0;
1118   my $action = '|';
1119
1120   foreach my $el (@{$ary}) {
1121     if (ref $el eq "ARRAY") {
1122       if ($action eq '|') {
1123         $value |= evaluate_rights_ary($el);
1124       } else {
1125         $value &= evaluate_rights_ary($el);
1126       }
1127
1128     } elsif (($el eq '&') || ($el eq '|')) {
1129       $action = $el;
1130
1131     } elsif ($action eq '|') {
1132       $value |= $el;
1133
1134     } else {
1135       $value &= $el;
1136
1137     }
1138   }
1139
1140   $main::lxdebug->leave_sub(2);
1141
1142   return $value;
1143 }
1144
1145 sub _parse_rights_string {
1146   $main::lxdebug->enter_sub(2);
1147
1148   my $self   = shift;
1149
1150   my $login  = shift;
1151   my $access = shift;
1152
1153   my @stack;
1154   my $cur_ary = [];
1155
1156   push @stack, $cur_ary;
1157
1158   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1159     my $token = $1;
1160     substr($access, 0, length $1) = "";
1161
1162     next if ($token =~ /\s/);
1163
1164     if ($token eq "(") {
1165       my $new_cur_ary = [];
1166       push @stack, $new_cur_ary;
1167       push @{$cur_ary}, $new_cur_ary;
1168       $cur_ary = $new_cur_ary;
1169
1170     } elsif ($token eq ")") {
1171       pop @stack;
1172
1173       if (!@stack) {
1174         $main::lxdebug->leave_sub(2);
1175         return 0;
1176       }
1177
1178       $cur_ary = $stack[-1];
1179
1180     } elsif (($token eq "|") || ($token eq "&")) {
1181       push @{$cur_ary}, $token;
1182
1183     } else {
1184       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1185     }
1186   }
1187
1188   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1189
1190   $main::lxdebug->leave_sub(2);
1191
1192   return $result;
1193 }
1194
1195 sub check_right {
1196   $main::lxdebug->enter_sub(2);
1197
1198   my $self    = shift;
1199   my $login   = shift;
1200   my $right   = shift;
1201   my $default = shift;
1202
1203   $self->{FULL_RIGHTS}           ||= { };
1204   $self->{FULL_RIGHTS}->{$login} ||= { };
1205
1206   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1207     $self->{RIGHTS}           ||= { };
1208     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1209
1210     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1211   }
1212
1213   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1214   $granted    = $default if (!defined $granted);
1215
1216   $main::lxdebug->leave_sub(2);
1217
1218   return $granted;
1219 }
1220
1221 sub assert {
1222   $::lxdebug->enter_sub(2);
1223   my ($self, $right, $dont_abort) = @_;
1224
1225   if ($self->check_right($::myconfig{login}, $right)) {
1226     $::lxdebug->leave_sub(2);
1227     return 1;
1228   }
1229
1230   if (!$dont_abort) {
1231     delete $::form->{title};
1232     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1233   }
1234
1235   $::lxdebug->leave_sub(2);
1236
1237   return 0;
1238 }
1239
1240 sub load_rights_for_user {
1241   $::lxdebug->enter_sub;
1242
1243   my ($self, $login) = @_;
1244   my $dbh   = $self->dbconnect;
1245   my ($query, $sth, $row, $rights);
1246
1247   $rights = { map { $_ => 0 } all_rights() };
1248
1249   $query =
1250     qq|SELECT gr."right", gr.granted
1251        FROM auth.group_rights gr
1252        WHERE group_id IN
1253          (SELECT ug.group_id
1254           FROM auth.user_group ug
1255           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1256           WHERE u.login = ?)|;
1257
1258   $sth = prepare_execute_query($::form, $dbh, $query, $login);
1259
1260   while ($row = $sth->fetchrow_hashref()) {
1261     $rights->{$row->{right}} |= $row->{granted};
1262   }
1263   $sth->finish();
1264
1265   $::lxdebug->leave_sub;
1266
1267   return $rights;
1268 }
1269
1270 1;
1271 __END__
1272
1273 =pod
1274
1275 =encoding utf8
1276
1277 =head1 NAME
1278
1279 SL::Auth - Authentication and session handling
1280
1281 =head1 FUNCTIONS
1282
1283 =over 4
1284
1285 =item C<set_session_value @values>
1286 =item C<set_session_value %values>
1287
1288 Store all values of C<@values> or C<%values> in the session. Each
1289 member of C<@values> is tested if it is a hash reference. If it is
1290 then it must contain the keys C<key> and C<value> and can optionally
1291 contain the key C<auto_restore>. In this case C<value> is associated
1292 with C<key> and restored to C<$::form> upon the next request
1293 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1294 value.
1295
1296 If the current member of C<@values> is not a hash reference then it
1297 will be used as the C<key> and the next entry of C<@values> is used as
1298 the C<value> to store. In this case setting C<auto_restore> is not
1299 possible.
1300
1301 Therefore the following two invocations are identical:
1302
1303   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1304   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1305
1306 All of these values are copied back into C<$::form> for the next
1307 request automatically if they're scalar values or if they have
1308 C<auto_restore> set to trueish.
1309
1310 The values can be any Perl structure. They are stored as YAML dumps.
1311
1312 =item C<get_session_value $key>
1313
1314 Retrieve a value from the session. Returns C<undef> if the value
1315 doesn't exist.
1316
1317 =item C<create_unique_sesion_value $value, %params>
1318
1319 Create a unique key in the session and store C<$value>
1320 there.
1321
1322 Returns the key created in the session.
1323
1324 =item C<save_session>
1325
1326 Stores the session values in the database. This is the only function
1327 that actually stores stuff in the database. Neither the various
1328 setters nor the deleter access the database.
1329
1330 =item <save_form_in_session %params>
1331
1332 Stores the content of C<$params{form}> (default: C<$::form>) in the
1333 session using L</create_unique_sesion_value>.
1334
1335 If C<$params{non_scalars}> is trueish then non-scalar values will be
1336 stored as well. Default is to only store scalar values.
1337
1338 The following keys will never be saved: C<login>, C<password>,
1339 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1340 can be given as an array ref in C<$params{skip_keys}>.
1341
1342 Returns the unique key under which the form is stored.
1343
1344 =item <restore_form_from_session $key, %params>
1345
1346 Restores the form from the session into C<$params{form}> (default:
1347 C<$::form>).
1348
1349 If C<$params{clobber}> is falsish then existing values with the same
1350 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1351 is on by default.
1352
1353 Returns C<$self>.
1354
1355 =back
1356
1357 =head1 BUGS
1358
1359 Nothing here yet.
1360
1361 =head1 AUTHOR
1362
1363 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1364
1365 =cut