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