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