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     ["--ap",                           $locale->text("AP")],
 957     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
 958     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
 959     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
 960     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
 961     ["--warehouse_management",         $locale->text("Warehouse management")],
 962     ["warehouse_contents",             $locale->text("View warehouse content")],
 963     ["warehouse_management",           $locale->text("Warehouse management")],
 964     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
 965     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
 966     ["datev_export",                   $locale->text("DATEV Export")],
 967     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
 968     ["--reports",                      $locale->text('Reports')],
 969     ["report",                         $locale->text('All reports')],
 970     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
 971     ["--batch_printing",               $locale->text("Batch Printing")],
 972     ["batch_printing",                 $locale->text("Batch Printing")],
 973     ["--others",                       $locale->text("Others")],
 974     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
 975     ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
 976     );
 977
 978   return @all_rights;
 979 }
 980
 981 sub all_rights {
 982   return grep !/^--/, map { $_->[0] } all_rights_full();
 983 }
 984
 985 sub read_groups {
 986   $main::lxdebug->enter_sub();
 987
 988   my $self = shift;
 989
 990   my $form   = $main::form;
 991   my $groups = {};
 992   my $dbh    = $self->dbconnect();
 993
 994   my $query  = 'SELECT * FROM auth."group"';
 995   my $sth    = prepare_execute_query($form, $dbh, $query);
 996
 997   my ($row, $group);
 998
 999   while ($row = $sth->fetchrow_hashref()) {
1000     $groups->{$row->{id}} = $row;
1001   }
1002   $sth->finish();
1003
1004   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1005   $sth   = prepare_query($form, $dbh, $query);
1006
1007   foreach $group (values %{$groups}) {
1008     my @members;
1009
1010     do_statement($form, $sth, $query, $group->{id});
1011
1012     while ($row = $sth->fetchrow_hashref()) {
1013       push @members, $row->{user_id};
1014     }
1015     $group->{members} = [ uniq @members ];
1016   }
1017   $sth->finish();
1018
1019   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1020   $sth   = prepare_query($form, $dbh, $query);
1021
1022   foreach $group (values %{$groups}) {
1023     $group->{rights} = {};
1024
1025     do_statement($form, $sth, $query, $group->{id});
1026
1027     while ($row = $sth->fetchrow_hashref()) {
1028       $group->{rights}->{$row->{right}} |= $row->{granted};
1029     }
1030
1031     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1032   }
1033   $sth->finish();
1034
1035   $main::lxdebug->leave_sub();
1036
1037   return $groups;
1038 }
1039
1040 sub save_group {
1041   $main::lxdebug->enter_sub();
1042
1043   my $self  = shift;
1044   my $group = shift;
1045
1046   my $form  = $main::form;
1047   my $dbh   = $self->dbconnect();
1048
1049   $dbh->begin_work;
1050
1051   my ($query, $sth, $row, $rights);
1052
1053   if (!$group->{id}) {
1054     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1055
1056     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1057     do_query($form, $dbh, $query, $group->{id});
1058   }
1059
1060   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1061
1062   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1063
1064   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1065   $sth    = prepare_query($form, $dbh, $query);
1066
1067   foreach my $user_id (uniq @{ $group->{members} }) {
1068     do_statement($form, $sth, $query, $user_id, $group->{id});
1069   }
1070   $sth->finish();
1071
1072   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1073
1074   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1075   $sth   = prepare_query($form, $dbh, $query);
1076
1077   foreach my $right (keys %{ $group->{rights} }) {
1078     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1079   }
1080   $sth->finish();
1081
1082   $dbh->commit();
1083
1084   $main::lxdebug->leave_sub();
1085 }
1086
1087 sub delete_group {
1088   $main::lxdebug->enter_sub();
1089
1090   my $self = shift;
1091   my $id   = shift;
1092
1093   my $form = $main::form;
1094
1095   my $dbh  = $self->dbconnect();
1096   $dbh->begin_work;
1097
1098   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1099   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1100   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1101
1102   $dbh->commit();
1103
1104   $main::lxdebug->leave_sub();
1105 }
1106
1107 sub evaluate_rights_ary {
1108   $main::lxdebug->enter_sub(2);
1109
1110   my $ary    = shift;
1111
1112   my $value  = 0;
1113   my $action = '|';
1114
1115   foreach my $el (@{$ary}) {
1116     if (ref $el eq "ARRAY") {
1117       if ($action eq '|') {
1118         $value |= evaluate_rights_ary($el);
1119       } else {
1120         $value &= evaluate_rights_ary($el);
1121       }
1122
1123     } elsif (($el eq '&') || ($el eq '|')) {
1124       $action = $el;
1125
1126     } elsif ($action eq '|') {
1127       $value |= $el;
1128
1129     } else {
1130       $value &= $el;
1131
1132     }
1133   }
1134
1135   $main::lxdebug->leave_sub(2);
1136
1137   return $value;
1138 }
1139
1140 sub _parse_rights_string {
1141   $main::lxdebug->enter_sub(2);
1142
1143   my $self   = shift;
1144
1145   my $login  = shift;
1146   my $access = shift;
1147
1148   my @stack;
1149   my $cur_ary = [];
1150
1151   push @stack, $cur_ary;
1152
1153   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1154     my $token = $1;
1155     substr($access, 0, length $1) = "";
1156
1157     next if ($token =~ /\s/);
1158
1159     if ($token eq "(") {
1160       my $new_cur_ary = [];
1161       push @stack, $new_cur_ary;
1162       push @{$cur_ary}, $new_cur_ary;
1163       $cur_ary = $new_cur_ary;
1164
1165     } elsif ($token eq ")") {
1166       pop @stack;
1167
1168       if (!@stack) {
1169         $main::lxdebug->leave_sub(2);
1170         return 0;
1171       }
1172
1173       $cur_ary = $stack[-1];
1174
1175     } elsif (($token eq "|") || ($token eq "&")) {
1176       push @{$cur_ary}, $token;
1177
1178     } else {
1179       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1180     }
1181   }
1182
1183   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1184
1185   $main::lxdebug->leave_sub(2);
1186
1187   return $result;
1188 }
1189
1190 sub check_right {
1191   $main::lxdebug->enter_sub(2);
1192
1193   my $self    = shift;
1194   my $login   = shift;
1195   my $right   = shift;
1196   my $default = shift;
1197
1198   $self->{FULL_RIGHTS}           ||= { };
1199   $self->{FULL_RIGHTS}->{$login} ||= { };
1200
1201   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1202     $self->{RIGHTS}           ||= { };
1203     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1204
1205     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1206   }
1207
1208   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1209   $granted    = $default if (!defined $granted);
1210
1211   $main::lxdebug->leave_sub(2);
1212
1213   return $granted;
1214 }
1215
1216 sub assert {
1217   $::lxdebug->enter_sub(2);
1218   my ($self, $right, $dont_abort) = @_;
1219
1220   if ($self->check_right($::myconfig{login}, $right)) {
1221     $::lxdebug->leave_sub(2);
1222     return 1;
1223   }
1224
1225   if (!$dont_abort) {
1226     delete $::form->{title};
1227     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1228   }
1229
1230   $::lxdebug->leave_sub(2);
1231
1232   return 0;
1233 }
1234
1235 sub load_rights_for_user {
1236   $::lxdebug->enter_sub;
1237
1238   my ($self, $login) = @_;
1239   my $dbh   = $self->dbconnect;
1240   my ($query, $sth, $row, $rights);
1241
1242   $rights = { map { $_ => 0 } all_rights() };
1243
1244   $query =
1245     qq|SELECT gr."right", gr.granted
1246        FROM auth.group_rights gr
1247        WHERE group_id IN
1248          (SELECT ug.group_id
1249           FROM auth.user_group ug
1250           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1251           WHERE u.login = ?)|;
1252
1253   $sth = prepare_execute_query($::form, $dbh, $query, $login);
1254
1255   while ($row = $sth->fetchrow_hashref()) {
1256     $rights->{$row->{right}} |= $row->{granted};
1257   }
1258   $sth->finish();
1259
1260   $::lxdebug->leave_sub;
1261
1262   return $rights;
1263 }
1264
1265 1;
1266 __END__
1267
1268 =pod
1269
1270 =encoding utf8
1271
1272 =head1 NAME
1273
1274 SL::Auth - Authentication and session handling
1275
1276 =head1 FUNCTIONS
1277
1278 =over 4
1279
1280 =item C<set_session_value @values>
1281 =item C<set_session_value %values>
1282
1283 Store all values of C<@values> or C<%values> in the session. Each
1284 member of C<@values> is tested if it is a hash reference. If it is
1285 then it must contain the keys C<key> and C<value> and can optionally
1286 contain the key C<auto_restore>. In this case C<value> is associated
1287 with C<key> and restored to C<$::form> upon the next request
1288 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1289 value.
1290
1291 If the current member of C<@values> is not a hash reference then it
1292 will be used as the C<key> and the next entry of C<@values> is used as
1293 the C<value> to store. In this case setting C<auto_restore> is not
1294 possible.
1295
1296 Therefore the following two invocations are identical:
1297
1298   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1299   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1300
1301 All of these values are copied back into C<$::form> for the next
1302 request automatically if they're scalar values or if they have
1303 C<auto_restore> set to trueish.
1304
1305 The values can be any Perl structure. They are stored as YAML dumps.
1306
1307 =item C<get_session_value $key>
1308
1309 Retrieve a value from the session. Returns C<undef> if the value
1310 doesn't exist.
1311
1312 =item C<create_unique_sesion_value $value, %params>
1313
1314 Create a unique key in the session and store C<$value>
1315 there.
1316
1317 Returns the key created in the session.
1318
1319 =item C<save_session>
1320
1321 Stores the session values in the database. This is the only function
1322 that actually stores stuff in the database. Neither the various
1323 setters nor the deleter access the database.
1324
1325 =item <save_form_in_session %params>
1326
1327 Stores the content of C<$params{form}> (default: C<$::form>) in the
1328 session using L</create_unique_sesion_value>.
1329
1330 If C<$params{non_scalars}> is trueish then non-scalar values will be
1331 stored as well. Default is to only store scalar values.
1332
1333 The following keys will never be saved: C<login>, C<password>,
1334 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1335 can be given as an array ref in C<$params{skip_keys}>.
1336
1337 Returns the unique key under which the form is stored.
1338
1339 =item <restore_form_from_session $key, %params>
1340
1341 Restores the form from the session into C<$params{form}> (default:
1342 C<$::form>).
1343
1344 If C<$params{clobber}> is falsish then existing values with the same
1345 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1346 is on by default.
1347
1348 Returns C<$self>.
1349
1350 =back
1351
1352 =head1 BUGS
1353
1354 Nothing here yet.
1355
1356 =head1 AUTHOR
1357
1358 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1359
1360 =cut