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