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   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
 515   $session_id        =~ s|[^0-9a-f]||g if $session_id;
 516
 517   $self->{SESSION}   = { };
 518
 519   if (!$session_id) {
 520     $main::lxdebug->leave_sub();
 521     return SESSION_NONE;
 522   }
 523
 524   my ($dbh, $query, $sth, $cookie, $ref, $form);
 525
 526   $form   = $main::form;
 527
 528   # Don't fail if the auth DB doesn't yet.
 529   if (!( $dbh = $self->dbconnect(1) )) {
 530     $::lxdebug->leave_sub;
 531     return SESSION_NONE;
 532   }
 533
 534   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
 535   # admin is creating the session tables at the moment.
 536   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
 537
 538   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
 539     $sth->finish if $sth;
 540     $::lxdebug->leave_sub;
 541     return SESSION_NONE;
 542   }
 543
 544   $cookie = $sth->fetchrow_hashref;
 545   $sth->finish;
 546
 547   if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
 548     $self->destroy_session();
 549     $main::lxdebug->leave_sub();
 550     return $cookie ? SESSION_EXPIRED : SESSION_NONE;
 551   }
 552
 553   if ($self->{column_information}->has('auto_restore')) {
 554     $self->_load_with_auto_restore_column($dbh, $session_id);
 555   } else {
 556     $self->_load_without_auto_restore_column($dbh, $session_id);
 557   }
 558
 559   $main::lxdebug->leave_sub();
 560
 561   return SESSION_OK;
 562 }
 563
 564 sub _load_without_auto_restore_column {
 565   my ($self, $dbh, $session_id) = @_;
 566
 567   my $query = <<SQL;
 568     SELECT sess_key, sess_value
 569     FROM auth.session_content
 570     WHERE (session_id = ?)
 571 SQL
 572   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 573
 574   while (my $ref = $sth->fetchrow_hashref) {
 575     my $value = SL::Auth::SessionValue->new(auth  => $self,
 576                                             key   => $ref->{sess_key},
 577                                             value => $ref->{sess_value},
 578                                             raw   => 1);
 579     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 580
 581     next if defined $::form->{$ref->{sess_key}};
 582
 583     my $data                    = $value->get;
 584     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 585   }
 586 }
 587
 588 sub _load_with_auto_restore_column {
 589   my ($self, $dbh, $session_id) = @_;
 590
 591   my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
 592
 593   my $query = <<SQL;
 594     SELECT sess_key, sess_value, auto_restore
 595     FROM auth.session_content
 596     WHERE (session_id = ?)
 597       AND (   auto_restore
 598            OR sess_key IN (${auto_restore_keys}))
 599 SQL
 600   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 601
 602   while (my $ref = $sth->fetchrow_hashref) {
 603     my $value = SL::Auth::SessionValue->new(auth         => $self,
 604                                             key          => $ref->{sess_key},
 605                                             value        => $ref->{sess_value},
 606                                             auto_restore => $ref->{auto_restore},
 607                                             raw          => 1);
 608     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 609
 610     next if defined $::form->{$ref->{sess_key}};
 611
 612     my $data                    = $value->get;
 613     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 614   }
 615
 616   $sth->finish;
 617
 618   $query = <<SQL;
 619     SELECT sess_key
 620     FROM auth.session_content
 621     WHERE (session_id = ?)
 622       AND NOT COALESCE(auto_restore, FALSE)
 623       AND (sess_key NOT IN (${auto_restore_keys}))
 624 SQL
 625   $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 626
 627   while (my $ref = $sth->fetchrow_hashref) {
 628     my $value = SL::Auth::SessionValue->new(auth => $self,
 629                                             key  => $ref->{sess_key});
 630     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 631   }
 632 }
 633
 634 sub destroy_session {
 635   $main::lxdebug->enter_sub();
 636
 637   my $self = shift;
 638
 639   if ($session_id) {
 640     my $dbh = $self->dbconnect();
 641
 642     $dbh->begin_work;
 643
 644     do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
 645     do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
 646
 647     $dbh->commit();
 648
 649     SL::SessionFile->destroy_session($session_id);
 650
 651     $session_id      = undef;
 652     $self->{SESSION} = { };
 653   }
 654
 655   $main::lxdebug->leave_sub();
 656 }
 657
 658 sub expire_sessions {
 659   $main::lxdebug->enter_sub();
 660
 661   my $self  = shift;
 662
 663   $main::lxdebug->leave_sub and return if !$self->session_tables_present;
 664
 665   my $dbh   = $self->dbconnect();
 666
 667   my $query = qq|SELECT id
 668                  FROM auth.session
 669                  WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
 670
 671   my @ids   = selectall_array_query($::form, $dbh, $query);
 672
 673   if (@ids) {
 674     $dbh->begin_work;
 675
 676     SL::SessionFile->destroy_session($_) for @ids;
 677
 678     $query = qq|DELETE FROM auth.session_content
 679                 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 680     do_query($main::form, $dbh, $query, @ids);
 681
 682     $query = qq|DELETE FROM auth.session
 683                 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 684     do_query($main::form, $dbh, $query, @ids);
 685
 686     $dbh->commit();
 687   }
 688
 689   $main::lxdebug->leave_sub();
 690 }
 691
 692 sub _create_session_id {
 693   $main::lxdebug->enter_sub();
 694
 695   my @data;
 696   map { push @data, int(rand() * 255); } (1..32);
 697
 698   my $id = md5_hex(pack 'C*', @data);
 699
 700   $main::lxdebug->leave_sub();
 701
 702   return $id;
 703 }
 704
 705 sub create_or_refresh_session {
 706   $session_id ||= shift->_create_session_id;
 707 }
 708
 709 sub save_session {
 710   $::lxdebug->enter_sub;
 711   my $self         = shift;
 712   my $provided_dbh = shift;
 713
 714   my $dbh          = $provided_dbh || $self->dbconnect(1);
 715
 716   $::lxdebug->leave_sub && return unless $dbh && $session_id;
 717
 718   $dbh->begin_work unless $provided_dbh;
 719
 720   # If this fails then the "auth" schema might not exist yet, e.g. if
 721   # the admin is just trying to create the auth database.
 722   if (!$dbh->do(qq|LOCK auth.session_content|)) {
 723     $dbh->rollback unless $provided_dbh;
 724     $::lxdebug->leave_sub;
 725     return;
 726   }
 727
 728   my @unfetched_keys = map     { $_->{key}        }
 729                        grep    { ! $_->{fetched}  }
 730                        values %{ $self->{SESSION} };
 731   # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
 732   # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
 733   my $query          = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
 734   $query            .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
 735
 736   do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
 737
 738   my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
 739
 740   if ($id) {
 741     do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
 742   } else {
 743     do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
 744   }
 745
 746   my @values_to_save = grep    { $_->{fetched} }
 747                        values %{ $self->{SESSION} };
 748   if (@values_to_save) {
 749     my ($columns, $placeholders) = ('', '');
 750     my $auto_restore             = $self->{column_information}->has('auto_restore');
 751
 752     if ($auto_restore) {
 753       $columns      .= ', auto_restore';
 754       $placeholders .= ', ?';
 755     }
 756
 757     $query  = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
 758     my $sth = prepare_query($::form, $dbh, $query);
 759
 760     foreach my $value (@values_to_save) {
 761       my @values = ($value->{key}, $value->get_dumped);
 762       push @values, $value->{auto_restore} if $auto_restore;
 763
 764       do_statement($::form, $sth, $query, $session_id, @values);
 765     }
 766
 767     $sth->finish();
 768   }
 769
 770   $dbh->commit() unless $provided_dbh;
 771   $::lxdebug->leave_sub;
 772 }
 773
 774 sub set_session_value {
 775   $main::lxdebug->enter_sub();
 776
 777   my $self   = shift;
 778   my @params = @_;
 779
 780   $self->{SESSION} ||= { };
 781
 782   while (@params) {
 783     my $key = shift @params;
 784
 785     if (ref $key eq 'HASH') {
 786       $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key          => $key->{key},
 787                                                                       value        => $key->{value},
 788                                                                       auto_restore => $key->{auto_restore});
 789
 790     } else {
 791       my $value = shift @params;
 792       $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key   => $key,
 793                                                                value => $value);
 794     }
 795   }
 796
 797   $main::lxdebug->leave_sub();
 798
 799   return $self;
 800 }
 801
 802 sub delete_session_value {
 803   $main::lxdebug->enter_sub();
 804
 805   my $self = shift;
 806
 807   $self->{SESSION} ||= { };
 808   delete @{ $self->{SESSION} }{ @_ };
 809
 810   $main::lxdebug->leave_sub();
 811
 812   return $self;
 813 }
 814
 815 sub get_session_value {
 816   $main::lxdebug->enter_sub();
 817
 818   my $self = shift;
 819   my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
 820
 821   $main::lxdebug->leave_sub();
 822
 823   return $data;
 824 }
 825
 826 sub create_unique_sesion_value {
 827   my ($self, $value, %params) = @_;
 828
 829   $self->{SESSION} ||= { };
 830
 831   my @now                   = gettimeofday();
 832   my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
 833   $self->{unique_counter} ||= 0;
 834
 835   my $hashed_key;
 836   do {
 837     $self->{unique_counter}++;
 838     $hashed_key = md5_hex($key . $self->{unique_counter});
 839   } while (exists $self->{SESSION}->{$hashed_key});
 840
 841   $self->set_session_value($hashed_key => $value);
 842
 843   return $hashed_key;
 844 }
 845
 846 sub save_form_in_session {
 847   my ($self, %params) = @_;
 848
 849   my $form        = delete($params{form}) || $::form;
 850   my $non_scalars = delete $params{non_scalars};
 851   my $data        = {};
 852
 853   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
 854
 855   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
 856     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
 857   }
 858
 859   return $self->create_unique_sesion_value($data, %params);
 860 }
 861
 862 sub restore_form_from_session {
 863   my ($self, $key, %params) = @_;
 864
 865   my $data = $self->get_session_value($key);
 866   return $self unless $data;
 867
 868   my $form    = delete($params{form}) || $::form;
 869   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
 870
 871   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
 872
 873   return $self;
 874 }
 875
 876 sub set_cookie_environment_variable {
 877   my $self = shift;
 878   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
 879 }
 880
 881 sub get_session_cookie_name {
 882   my $self = shift;
 883
 884   return $self->{cookie_name} || 'lx_office_erp_session_id';
 885 }
 886
 887 sub get_session_id {
 888   return $session_id;
 889 }
 890
 891 sub session_tables_present {
 892   $main::lxdebug->enter_sub();
 893
 894   my $self = shift;
 895
 896   # Only re-check for the presence of auth tables if either the check
 897   # hasn't been done before of if they weren't present.
 898   if ($self->{session_tables_present}) {
 899     $main::lxdebug->leave_sub();
 900     return $self->{session_tables_present};
 901   }
 902
 903   my $dbh  = $self->dbconnect(1);
 904
 905   if (!$dbh) {
 906     $main::lxdebug->leave_sub();
 907     return 0;
 908   }
 909
 910   my $query =
 911     qq|SELECT COUNT(*)
 912        FROM pg_tables
 913        WHERE (schemaname = 'auth')
 914          AND (tablename IN ('session', 'session_content'))|;
 915
 916   my ($count) = selectrow_query($main::form, $dbh, $query);
 917
 918   $self->{session_tables_present} = 2 == $count;
 919
 920   $main::lxdebug->leave_sub();
 921
 922   return $self->{session_tables_present};
 923 }
 924
 925 # --------------------------------------
 926
 927 sub all_rights_full {
 928   my $locale = $main::locale;
 929
 930   my @all_rights = (
 931     ["--crm",                          $locale->text("CRM optional software")],
 932     ["crm_search",                     $locale->text("CRM search")],
 933     ["crm_new",                        $locale->text("CRM create customers, vendors and contacts")],
 934     ["crm_service",                    $locale->text("CRM services")],
 935     ["crm_admin",                      $locale->text("CRM admin")],
 936     ["crm_adminuser",                  $locale->text("CRM user")],
 937     ["crm_adminstatus",                $locale->text("CRM status")],
 938     ["crm_email",                      $locale->text("CRM send email")],
 939     ["crm_termin",                     $locale->text("CRM termin")],
 940     ["crm_opportunity",                $locale->text("CRM opportunity")],
 941     ["crm_knowhow",                    $locale->text("CRM know how")],
 942     ["crm_follow",                     $locale->text("CRM follow up")],
 943     ["crm_notices",                    $locale->text("CRM notices")],
 944     ["crm_other",                      $locale->text("CRM other")],
 945     ["--master_data",                  $locale->text("Master Data")],
 946     ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
 947     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
 948     ["project_edit",                   $locale->text("Create and edit projects")],
 949     ["--ar",                           $locale->text("AR")],
 950     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
 951     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
 952     ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
 953     ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
 954     ["dunning_edit",                   $locale->text("Create and edit dunnings")],
 955     ["sales_all_edit",                 $locale->text("View/edit all employees sales documents")],
 956     ["edit_prices",                    $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
 957     ["--ap",                           $locale->text("AP")],
 958     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
 959     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
 960     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
 961     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
 962     ["--warehouse_management",         $locale->text("Warehouse management")],
 963     ["warehouse_contents",             $locale->text("View warehouse content")],
 964     ["warehouse_management",           $locale->text("Warehouse management")],
 965     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
 966     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
 967     ["datev_export",                   $locale->text("DATEV Export")],
 968     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
 969     ["--reports",                      $locale->text('Reports')],
 970     ["report",                         $locale->text('All reports')],
 971     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
 972     ["--batch_printing",               $locale->text("Batch Printing")],
 973     ["batch_printing",                 $locale->text("Batch Printing")],
 974     ["--others",                       $locale->text("Others")],
 975     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
 976     ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
 977     );
 978
 979   return @all_rights;
 980 }
 981
 982 sub all_rights {
 983   return grep !/^--/, map { $_->[0] } all_rights_full();
 984 }
 985
 986 sub read_groups {
 987   $main::lxdebug->enter_sub();
 988
 989   my $self = shift;
 990
 991   my $form   = $main::form;
 992   my $groups = {};
 993   my $dbh    = $self->dbconnect();
 994
 995   my $query  = 'SELECT * FROM auth."group"';
 996   my $sth    = prepare_execute_query($form, $dbh, $query);
 997
 998   my ($row, $group);
 999
1000   while ($row = $sth->fetchrow_hashref()) {
1001     $groups->{$row->{id}} = $row;
1002   }
1003   $sth->finish();
1004
1005   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1006   $sth   = prepare_query($form, $dbh, $query);
1007
1008   foreach $group (values %{$groups}) {
1009     my @members;
1010
1011     do_statement($form, $sth, $query, $group->{id});
1012
1013     while ($row = $sth->fetchrow_hashref()) {
1014       push @members, $row->{user_id};
1015     }
1016     $group->{members} = [ uniq @members ];
1017   }
1018   $sth->finish();
1019
1020   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1021   $sth   = prepare_query($form, $dbh, $query);
1022
1023   foreach $group (values %{$groups}) {
1024     $group->{rights} = {};
1025
1026     do_statement($form, $sth, $query, $group->{id});
1027
1028     while ($row = $sth->fetchrow_hashref()) {
1029       $group->{rights}->{$row->{right}} |= $row->{granted};
1030     }
1031
1032     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1033   }
1034   $sth->finish();
1035
1036   $main::lxdebug->leave_sub();
1037
1038   return $groups;
1039 }
1040
1041 sub save_group {
1042   $main::lxdebug->enter_sub();
1043
1044   my $self  = shift;
1045   my $group = shift;
1046
1047   my $form  = $main::form;
1048   my $dbh   = $self->dbconnect();
1049
1050   $dbh->begin_work;
1051
1052   my ($query, $sth, $row, $rights);
1053
1054   if (!$group->{id}) {
1055     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1056
1057     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1058     do_query($form, $dbh, $query, $group->{id});
1059   }
1060
1061   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1062
1063   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1064
1065   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1066   $sth    = prepare_query($form, $dbh, $query);
1067
1068   foreach my $user_id (uniq @{ $group->{members} }) {
1069     do_statement($form, $sth, $query, $user_id, $group->{id});
1070   }
1071   $sth->finish();
1072
1073   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1074
1075   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1076   $sth   = prepare_query($form, $dbh, $query);
1077
1078   foreach my $right (keys %{ $group->{rights} }) {
1079     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1080   }
1081   $sth->finish();
1082
1083   $dbh->commit();
1084
1085   $main::lxdebug->leave_sub();
1086 }
1087
1088 sub delete_group {
1089   $main::lxdebug->enter_sub();
1090
1091   my $self = shift;
1092   my $id   = shift;
1093
1094   my $form = $main::form;
1095
1096   my $dbh  = $self->dbconnect();
1097   $dbh->begin_work;
1098
1099   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1100   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1101   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1102
1103   $dbh->commit();
1104
1105   $main::lxdebug->leave_sub();
1106 }
1107
1108 sub evaluate_rights_ary {
1109   $main::lxdebug->enter_sub(2);
1110
1111   my $ary    = shift;
1112
1113   my $value  = 0;
1114   my $action = '|';
1115
1116   foreach my $el (@{$ary}) {
1117     if (ref $el eq "ARRAY") {
1118       if ($action eq '|') {
1119         $value |= evaluate_rights_ary($el);
1120       } else {
1121         $value &= evaluate_rights_ary($el);
1122       }
1123
1124     } elsif (($el eq '&') || ($el eq '|')) {
1125       $action = $el;
1126
1127     } elsif ($action eq '|') {
1128       $value |= $el;
1129
1130     } else {
1131       $value &= $el;
1132
1133     }
1134   }
1135
1136   $main::lxdebug->leave_sub(2);
1137
1138   return $value;
1139 }
1140
1141 sub _parse_rights_string {
1142   $main::lxdebug->enter_sub(2);
1143
1144   my $self   = shift;
1145
1146   my $login  = shift;
1147   my $access = shift;
1148
1149   my @stack;
1150   my $cur_ary = [];
1151
1152   push @stack, $cur_ary;
1153
1154   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1155     my $token = $1;
1156     substr($access, 0, length $1) = "";
1157
1158     next if ($token =~ /\s/);
1159
1160     if ($token eq "(") {
1161       my $new_cur_ary = [];
1162       push @stack, $new_cur_ary;
1163       push @{$cur_ary}, $new_cur_ary;
1164       $cur_ary = $new_cur_ary;
1165
1166     } elsif ($token eq ")") {
1167       pop @stack;
1168
1169       if (!@stack) {
1170         $main::lxdebug->leave_sub(2);
1171         return 0;
1172       }
1173
1174       $cur_ary = $stack[-1];
1175
1176     } elsif (($token eq "|") || ($token eq "&")) {
1177       push @{$cur_ary}, $token;
1178
1179     } else {
1180       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1181     }
1182   }
1183
1184   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1185
1186   $main::lxdebug->leave_sub(2);
1187
1188   return $result;
1189 }
1190
1191 sub check_right {
1192   $main::lxdebug->enter_sub(2);
1193
1194   my $self    = shift;
1195   my $login   = shift;
1196   my $right   = shift;
1197   my $default = shift;
1198
1199   $self->{FULL_RIGHTS}           ||= { };
1200   $self->{FULL_RIGHTS}->{$login} ||= { };
1201
1202   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1203     $self->{RIGHTS}           ||= { };
1204     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1205
1206     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1207   }
1208
1209   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1210   $granted    = $default if (!defined $granted);
1211
1212   $main::lxdebug->leave_sub(2);
1213
1214   return $granted;
1215 }
1216
1217 sub assert {
1218   $::lxdebug->enter_sub(2);
1219   my ($self, $right, $dont_abort) = @_;
1220
1221   if ($self->check_right($::myconfig{login}, $right)) {
1222     $::lxdebug->leave_sub(2);
1223     return 1;
1224   }
1225
1226   if (!$dont_abort) {
1227     delete $::form->{title};
1228     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1229   }
1230
1231   $::lxdebug->leave_sub(2);
1232
1233   return 0;
1234 }
1235
1236 sub load_rights_for_user {
1237   $::lxdebug->enter_sub;
1238
1239   my ($self, $login) = @_;
1240   my $dbh   = $self->dbconnect;
1241   my ($query, $sth, $row, $rights);
1242
1243   $rights = { map { $_ => 0 } all_rights() };
1244
1245   $query =
1246     qq|SELECT gr."right", gr.granted
1247        FROM auth.group_rights gr
1248        WHERE group_id IN
1249          (SELECT ug.group_id
1250           FROM auth.user_group ug
1251           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1252           WHERE u.login = ?)|;
1253
1254   $sth = prepare_execute_query($::form, $dbh, $query, $login);
1255
1256   while ($row = $sth->fetchrow_hashref()) {
1257     $rights->{$row->{right}} |= $row->{granted};
1258   }
1259   $sth->finish();
1260
1261   $::lxdebug->leave_sub;
1262
1263   return $rights;
1264 }
1265
1266 1;
1267 __END__
1268
1269 =pod
1270
1271 =encoding utf8
1272
1273 =head1 NAME
1274
1275 SL::Auth - Authentication and session handling
1276
1277 =head1 FUNCTIONS
1278
1279 =over 4
1280
1281 =item C<set_session_value @values>
1282 =item C<set_session_value %values>
1283
1284 Store all values of C<@values> or C<%values> in the session. Each
1285 member of C<@values> is tested if it is a hash reference. If it is
1286 then it must contain the keys C<key> and C<value> and can optionally
1287 contain the key C<auto_restore>. In this case C<value> is associated
1288 with C<key> and restored to C<$::form> upon the next request
1289 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1290 value.
1291
1292 If the current member of C<@values> is not a hash reference then it
1293 will be used as the C<key> and the next entry of C<@values> is used as
1294 the C<value> to store. In this case setting C<auto_restore> is not
1295 possible.
1296
1297 Therefore the following two invocations are identical:
1298
1299   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1300   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1301
1302 All of these values are copied back into C<$::form> for the next
1303 request automatically if they're scalar values or if they have
1304 C<auto_restore> set to trueish.
1305
1306 The values can be any Perl structure. They are stored as YAML dumps.
1307
1308 =item C<get_session_value $key>
1309
1310 Retrieve a value from the session. Returns C<undef> if the value
1311 doesn't exist.
1312
1313 =item C<create_unique_sesion_value $value, %params>
1314
1315 Create a unique key in the session and store C<$value>
1316 there.
1317
1318 Returns the key created in the session.
1319
1320 =item C<save_session>
1321
1322 Stores the session values in the database. This is the only function
1323 that actually stores stuff in the database. Neither the various
1324 setters nor the deleter access the database.
1325
1326 =item <save_form_in_session %params>
1327
1328 Stores the content of C<$params{form}> (default: C<$::form>) in the
1329 session using L</create_unique_sesion_value>.
1330
1331 If C<$params{non_scalars}> is trueish then non-scalar values will be
1332 stored as well. Default is to only store scalar values.
1333
1334 The following keys will never be saved: C<login>, C<password>,
1335 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1336 can be given as an array ref in C<$params{skip_keys}>.
1337
1338 Returns the unique key under which the form is stored.
1339
1340 =item <restore_form_from_session $key, %params>
1341
1342 Restores the form from the session into C<$params{form}> (default:
1343 C<$::form>).
1344
1345 If C<$params{clobber}> is falsish then existing values with the same
1346 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1347 is on by default.
1348
1349 Returns C<$self>.
1350
1351 =back
1352
1353 =head1 BUGS
1354
1355 Nothing here yet.
1356
1357 =head1 AUTHOR
1358
1359 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1360
1361 =cut