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   $self->{unique_counter}++ while exists $self->{SESSION}->{$key . ($self->{unique_counter} + 1)};
 819   $self->{unique_counter}++;
 820
 821   $self->set_session_value($key . $self->{unique_counter} => $value);
 822
 823   return $key . $self->{unique_counter};
 824 }
 825
 826 sub save_form_in_session {
 827   my ($self, %params) = @_;
 828
 829   my $form        = delete($params{form}) || $::form;
 830   my $non_scalars = delete $params{non_scalars};
 831   my $data        = {};
 832
 833   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
 834
 835   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
 836     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
 837   }
 838
 839   return $self->create_unique_sesion_value($data, %params);
 840 }
 841
 842 sub restore_form_from_session {
 843   my ($self, $key, %params) = @_;
 844
 845   my $data = $self->get_session_value($key);
 846   return $self unless $data;
 847
 848   my $form    = delete($params{form}) || $::form;
 849   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
 850
 851   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
 852
 853   return $self;
 854 }
 855
 856 sub set_cookie_environment_variable {
 857   my $self = shift;
 858   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
 859 }
 860
 861 sub get_session_cookie_name {
 862   my $self = shift;
 863
 864   return $self->{cookie_name} || 'lx_office_erp_session_id';
 865 }
 866
 867 sub get_session_id {
 868   return $session_id;
 869 }
 870
 871 sub session_tables_present {
 872   $main::lxdebug->enter_sub();
 873
 874   my $self = shift;
 875
 876   # Only re-check for the presence of auth tables if either the check
 877   # hasn't been done before of if they weren't present.
 878   if ($self->{session_tables_present}) {
 879     $main::lxdebug->leave_sub();
 880     return $self->{session_tables_present};
 881   }
 882
 883   my $dbh  = $self->dbconnect(1);
 884
 885   if (!$dbh) {
 886     $main::lxdebug->leave_sub();
 887     return 0;
 888   }
 889
 890   my $query =
 891     qq|SELECT COUNT(*)
 892        FROM pg_tables
 893        WHERE (schemaname = 'auth')
 894          AND (tablename IN ('session', 'session_content'))|;
 895
 896   my ($count) = selectrow_query($main::form, $dbh, $query);
 897
 898   $self->{session_tables_present} = 2 == $count;
 899
 900   $main::lxdebug->leave_sub();
 901
 902   return $self->{session_tables_present};
 903 }
 904
 905 # --------------------------------------
 906
 907 sub all_rights_full {
 908   my $locale = $main::locale;
 909
 910   my @all_rights = (
 911     ["--crm",                          $locale->text("CRM optional software")],
 912     ["crm_search",                     $locale->text("CRM search")],
 913     ["crm_new",                        $locale->text("CRM create customers, vendors and contacts")],
 914     ["crm_service",                    $locale->text("CRM services")],
 915     ["crm_admin",                      $locale->text("CRM admin")],
 916     ["crm_adminuser",                  $locale->text("CRM user")],
 917     ["crm_adminstatus",                $locale->text("CRM status")],
 918     ["crm_email",                      $locale->text("CRM send email")],
 919     ["crm_termin",                     $locale->text("CRM termin")],
 920     ["crm_opportunity",                $locale->text("CRM opportunity")],
 921     ["crm_knowhow",                    $locale->text("CRM know how")],
 922     ["crm_follow",                     $locale->text("CRM follow up")],
 923     ["crm_notices",                    $locale->text("CRM notices")],
 924     ["crm_other",                      $locale->text("CRM other")],
 925     ["--master_data",                  $locale->text("Master Data")],
 926     ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
 927     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
 928     ["project_edit",                   $locale->text("Create and edit projects")],
 929     ["--ar",                           $locale->text("AR")],
 930     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
 931     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
 932     ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
 933     ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
 934     ["dunning_edit",                   $locale->text("Create and edit dunnings")],
 935     ["sales_all_edit",                 $locale->text("View/edit all employees sales documents")],
 936     ["--ap",                           $locale->text("AP")],
 937     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
 938     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
 939     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
 940     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
 941     ["--warehouse_management",         $locale->text("Warehouse management")],
 942     ["warehouse_contents",             $locale->text("View warehouse content")],
 943     ["warehouse_management",           $locale->text("Warehouse management")],
 944     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
 945     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
 946     ["datev_export",                   $locale->text("DATEV Export")],
 947     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
 948     ["--reports",                      $locale->text('Reports')],
 949     ["report",                         $locale->text('All reports')],
 950     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
 951     ["--batch_printing",               $locale->text("Batch Printing")],
 952     ["batch_printing",                 $locale->text("Batch Printing")],
 953     ["--others",                       $locale->text("Others")],
 954     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
 955     ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
 956     );
 957
 958   return @all_rights;
 959 }
 960
 961 sub all_rights {
 962   return grep !/^--/, map { $_->[0] } all_rights_full();
 963 }
 964
 965 sub read_groups {
 966   $main::lxdebug->enter_sub();
 967
 968   my $self = shift;
 969
 970   my $form   = $main::form;
 971   my $groups = {};
 972   my $dbh    = $self->dbconnect();
 973
 974   my $query  = 'SELECT * FROM auth."group"';
 975   my $sth    = prepare_execute_query($form, $dbh, $query);
 976
 977   my ($row, $group);
 978
 979   while ($row = $sth->fetchrow_hashref()) {
 980     $groups->{$row->{id}} = $row;
 981   }
 982   $sth->finish();
 983
 984   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
 985   $sth   = prepare_query($form, $dbh, $query);
 986
 987   foreach $group (values %{$groups}) {
 988     my @members;
 989
 990     do_statement($form, $sth, $query, $group->{id});
 991
 992     while ($row = $sth->fetchrow_hashref()) {
 993       push @members, $row->{user_id};
 994     }
 995     $group->{members} = [ uniq @members ];
 996   }
 997   $sth->finish();
 998
 999   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1000   $sth   = prepare_query($form, $dbh, $query);
1001
1002   foreach $group (values %{$groups}) {
1003     $group->{rights} = {};
1004
1005     do_statement($form, $sth, $query, $group->{id});
1006
1007     while ($row = $sth->fetchrow_hashref()) {
1008       $group->{rights}->{$row->{right}} |= $row->{granted};
1009     }
1010
1011     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1012   }
1013   $sth->finish();
1014
1015   $main::lxdebug->leave_sub();
1016
1017   return $groups;
1018 }
1019
1020 sub save_group {
1021   $main::lxdebug->enter_sub();
1022
1023   my $self  = shift;
1024   my $group = shift;
1025
1026   my $form  = $main::form;
1027   my $dbh   = $self->dbconnect();
1028
1029   $dbh->begin_work;
1030
1031   my ($query, $sth, $row, $rights);
1032
1033   if (!$group->{id}) {
1034     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1035
1036     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1037     do_query($form, $dbh, $query, $group->{id});
1038   }
1039
1040   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1041
1042   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1043
1044   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1045   $sth    = prepare_query($form, $dbh, $query);
1046
1047   foreach my $user_id (uniq @{ $group->{members} }) {
1048     do_statement($form, $sth, $query, $user_id, $group->{id});
1049   }
1050   $sth->finish();
1051
1052   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1053
1054   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1055   $sth   = prepare_query($form, $dbh, $query);
1056
1057   foreach my $right (keys %{ $group->{rights} }) {
1058     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1059   }
1060   $sth->finish();
1061
1062   $dbh->commit();
1063
1064   $main::lxdebug->leave_sub();
1065 }
1066
1067 sub delete_group {
1068   $main::lxdebug->enter_sub();
1069
1070   my $self = shift;
1071   my $id   = shift;
1072
1073   my $form = $main::form;
1074
1075   my $dbh  = $self->dbconnect();
1076   $dbh->begin_work;
1077
1078   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1079   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1080   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1081
1082   $dbh->commit();
1083
1084   $main::lxdebug->leave_sub();
1085 }
1086
1087 sub evaluate_rights_ary {
1088   $main::lxdebug->enter_sub(2);
1089
1090   my $ary    = shift;
1091
1092   my $value  = 0;
1093   my $action = '|';
1094
1095   foreach my $el (@{$ary}) {
1096     if (ref $el eq "ARRAY") {
1097       if ($action eq '|') {
1098         $value |= evaluate_rights_ary($el);
1099       } else {
1100         $value &= evaluate_rights_ary($el);
1101       }
1102
1103     } elsif (($el eq '&') || ($el eq '|')) {
1104       $action = $el;
1105
1106     } elsif ($action eq '|') {
1107       $value |= $el;
1108
1109     } else {
1110       $value &= $el;
1111
1112     }
1113   }
1114
1115   $main::lxdebug->leave_sub(2);
1116
1117   return $value;
1118 }
1119
1120 sub _parse_rights_string {
1121   $main::lxdebug->enter_sub(2);
1122
1123   my $self   = shift;
1124
1125   my $login  = shift;
1126   my $access = shift;
1127
1128   my @stack;
1129   my $cur_ary = [];
1130
1131   push @stack, $cur_ary;
1132
1133   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1134     my $token = $1;
1135     substr($access, 0, length $1) = "";
1136
1137     next if ($token =~ /\s/);
1138
1139     if ($token eq "(") {
1140       my $new_cur_ary = [];
1141       push @stack, $new_cur_ary;
1142       push @{$cur_ary}, $new_cur_ary;
1143       $cur_ary = $new_cur_ary;
1144
1145     } elsif ($token eq ")") {
1146       pop @stack;
1147
1148       if (!@stack) {
1149         $main::lxdebug->leave_sub(2);
1150         return 0;
1151       }
1152
1153       $cur_ary = $stack[-1];
1154
1155     } elsif (($token eq "|") || ($token eq "&")) {
1156       push @{$cur_ary}, $token;
1157
1158     } else {
1159       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1160     }
1161   }
1162
1163   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1164
1165   $main::lxdebug->leave_sub(2);
1166
1167   return $result;
1168 }
1169
1170 sub check_right {
1171   $main::lxdebug->enter_sub(2);
1172
1173   my $self    = shift;
1174   my $login   = shift;
1175   my $right   = shift;
1176   my $default = shift;
1177
1178   $self->{FULL_RIGHTS}           ||= { };
1179   $self->{FULL_RIGHTS}->{$login} ||= { };
1180
1181   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1182     $self->{RIGHTS}           ||= { };
1183     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1184
1185     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1186   }
1187
1188   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1189   $granted    = $default if (!defined $granted);
1190
1191   $main::lxdebug->leave_sub(2);
1192
1193   return $granted;
1194 }
1195
1196 sub assert {
1197   $::lxdebug->enter_sub(2);
1198   my ($self, $right, $dont_abort) = @_;
1199
1200   if ($self->check_right($::myconfig{login}, $right)) {
1201     $::lxdebug->leave_sub(2);
1202     return 1;
1203   }
1204
1205   if (!$dont_abort) {
1206     delete $::form->{title};
1207     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1208   }
1209
1210   $::lxdebug->leave_sub(2);
1211
1212   return 0;
1213 }
1214
1215 sub load_rights_for_user {
1216   $::lxdebug->enter_sub;
1217
1218   my ($self, $login) = @_;
1219   my $dbh   = $self->dbconnect;
1220   my ($query, $sth, $row, $rights);
1221
1222   $rights = { map { $_ => 0 } all_rights() };
1223
1224   $query =
1225     qq|SELECT gr."right", gr.granted
1226        FROM auth.group_rights gr
1227        WHERE group_id IN
1228          (SELECT ug.group_id
1229           FROM auth.user_group ug
1230           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1231           WHERE u.login = ?)|;
1232
1233   $sth = prepare_execute_query($::form, $dbh, $query, $login);
1234
1235   while ($row = $sth->fetchrow_hashref()) {
1236     $rights->{$row->{right}} |= $row->{granted};
1237   }
1238   $sth->finish();
1239
1240   $::lxdebug->leave_sub;
1241
1242   return $rights;
1243 }
1244
1245 1;
1246 __END__
1247
1248 =pod
1249
1250 =encoding utf8
1251
1252 =head1 NAME
1253
1254 SL::Auth - Authentication and session handling
1255
1256 =head1 FUNCTIONS
1257
1258 =over 4
1259
1260 =item C<set_session_value @values>
1261 =item C<set_session_value %values>
1262
1263 Store all values of C<@values> or C<%values> in the session. Each
1264 member of C<@values> is tested if it is a hash reference. If it is
1265 then it must contain the keys C<key> and C<value> and can optionally
1266 contain the key C<auto_restore>. In this case C<value> is associated
1267 with C<key> and restored to C<$::form> upon the next request
1268 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1269 value.
1270
1271 If the current member of C<@values> is not a hash reference then it
1272 will be used as the C<key> and the next entry of C<@values> is used as
1273 the C<value> to store. In this case setting C<auto_restore> is not
1274 possible.
1275
1276 Therefore the following two invocations are identical:
1277
1278   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1279   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1280
1281 All of these values are copied back into C<$::form> for the next
1282 request automatically if they're scalar values or if they have
1283 C<auto_restore> set to trueish.
1284
1285 The values can be any Perl structure. They are stored as YAML dumps.
1286
1287 =item C<get_session_value $key>
1288
1289 Retrieve a value from the session. Returns C<undef> if the value
1290 doesn't exist.
1291
1292 =item C<create_unique_sesion_value $value, %params>
1293
1294 Create a unique key in the session and store C<$value>
1295 there.
1296
1297 Returns the key created in the session.
1298
1299 =item C<save_session>
1300
1301 Stores the session values in the database. This is the only function
1302 that actually stores stuff in the database. Neither the various
1303 setters nor the deleter access the database.
1304
1305 =item <save_form_in_session %params>
1306
1307 Stores the content of C<$params{form}> (default: C<$::form>) in the
1308 session using L</create_unique_sesion_value>.
1309
1310 If C<$params{non_scalars}> is trueish then non-scalar values will be
1311 stored as well. Default is to only store scalar values.
1312
1313 The following keys will never be saved: C<login>, C<password>,
1314 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1315 can be given as an array ref in C<$params{skip_keys}>.
1316
1317 Returns the unique key under which the form is stored.
1318
1319 =item <restore_form_from_session $key, %params>
1320
1321 Restores the form from the session into C<$params{form}> (default:
1322 C<$::form>).
1323
1324 If C<$params{clobber}> is falsish then existing values with the same
1325 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1326 is on by default.
1327
1328 Returns C<$self>.
1329
1330 =back
1331
1332 =head1 BUGS
1333
1334 Nothing here yet.
1335
1336 =head1 AUTHOR
1337
1338 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1339
1340 =cut