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 (my ($key, $value) = each %params) {
 681     $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
 682   }
 683
 684   $main::lxdebug->leave_sub();
 685
 686   return $self;
 687 }
 688
 689 sub delete_session_value {
 690   $main::lxdebug->enter_sub();
 691
 692   my $self = shift;
 693
 694   $self->{SESSION} ||= { };
 695   delete @{ $self->{SESSION} }{ @_ };
 696
 697   $main::lxdebug->leave_sub();
 698
 699   return $self;
 700 }
 701
 702 sub get_session_value {
 703   $main::lxdebug->enter_sub();
 704
 705   my $self   = shift;
 706   my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
 707
 708   $main::lxdebug->leave_sub();
 709
 710   return $params->{data};
 711 }
 712
 713 sub create_unique_sesion_value {
 714   my ($self, $value, %params) = @_;
 715
 716   $self->{SESSION} ||= { };
 717
 718   my @now                   = gettimeofday();
 719   my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
 720   $self->{unique_counter} ||= 0;
 721
 722   $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
 723   $self->{unique_counter}++;
 724
 725   $value  = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
 726               data       => $value,
 727             };
 728
 729   $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
 730
 731   return $key . $self->{unique_counter};
 732 }
 733
 734 sub save_form_in_session {
 735   my ($self, %params) = @_;
 736
 737   my $form        = delete($params{form}) || $::form;
 738   my $non_scalars = delete $params{non_scalars};
 739   my $data        = {};
 740
 741   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
 742
 743   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
 744     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
 745   }
 746
 747   return $self->create_unique_sesion_value($data, %params);
 748 }
 749
 750 sub restore_form_from_session {
 751   my ($self, $key, %params) = @_;
 752
 753   my $data = $self->get_session_value($key);
 754   return $self unless $data;
 755
 756   my $form    = delete($params{form}) || $::form;
 757   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
 758
 759   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
 760
 761   return $self;
 762 }
 763
 764 sub expire_session_keys {
 765   my ($self) = @_;
 766
 767   $self->{SESSION} ||= { };
 768
 769   my @now = gettimeofday();
 770   my $now = $now[0] * 1000000 + $now[1];
 771
 772   $self->delete_session_value(map  { $_->[0]                                                 }
 773                               grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
 774                               map  { [ $_, $self->_load_value($self->{SESSION}->{$_}) ]      }
 775                               keys %{ $self->{SESSION} });
 776
 777   return $self;
 778 }
 779
 780 sub _has_expiration {
 781   my ($value) = @_;
 782   return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
 783 }
 784
 785 sub set_cookie_environment_variable {
 786   my $self = shift;
 787   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
 788 }
 789
 790 sub get_session_cookie_name {
 791   my $self = shift;
 792
 793   return $self->{cookie_name} || 'lx_office_erp_session_id';
 794 }
 795
 796 sub get_session_id {
 797   return $session_id;
 798 }
 799
 800 sub session_tables_present {
 801   $main::lxdebug->enter_sub();
 802
 803   my $self = shift;
 804
 805   # Only re-check for the presence of auth tables if either the check
 806   # hasn't been done before of if they weren't present.
 807   if ($self->{session_tables_present}) {
 808     $main::lxdebug->leave_sub();
 809     return $self->{session_tables_present};
 810   }
 811
 812   my $dbh  = $self->dbconnect(1);
 813
 814   if (!$dbh) {
 815     $main::lxdebug->leave_sub();
 816     return 0;
 817   }
 818
 819   my $query =
 820     qq|SELECT COUNT(*)
 821        FROM pg_tables
 822        WHERE (schemaname = 'auth')
 823          AND (tablename IN ('session', 'session_content'))|;
 824
 825   my ($count) = selectrow_query($main::form, $dbh, $query);
 826
 827   $self->{session_tables_present} = 2 == $count;
 828
 829   $main::lxdebug->leave_sub();
 830
 831   return $self->{session_tables_present};
 832 }
 833
 834 # --------------------------------------
 835
 836 sub all_rights_full {
 837   my $locale = $main::locale;
 838
 839   my @all_rights = (
 840     ["--crm",                          $locale->text("CRM optional software")],
 841     ["crm_search",                     $locale->text("CRM search")],
 842     ["crm_new",                        $locale->text("CRM create customers, vendors and contacts")],
 843     ["crm_service",                    $locale->text("CRM services")],
 844     ["crm_admin",                      $locale->text("CRM admin")],
 845     ["crm_adminuser",                  $locale->text("CRM user")],
 846     ["crm_adminstatus",                $locale->text("CRM status")],
 847     ["crm_email",                      $locale->text("CRM send email")],
 848     ["crm_termin",                     $locale->text("CRM termin")],
 849     ["crm_opportunity",                $locale->text("CRM opportunity")],
 850     ["crm_knowhow",                    $locale->text("CRM know how")],
 851     ["crm_follow",                     $locale->text("CRM follow up")],
 852     ["crm_notices",                    $locale->text("CRM notices")],
 853     ["crm_other",                      $locale->text("CRM other")],
 854     ["--master_data",                  $locale->text("Master Data")],
 855     ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
 856     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
 857     ["project_edit",                   $locale->text("Create and edit projects")],
 858     ["license_edit",                   $locale->text("Manage license keys")],
 859     ["--ar",                           $locale->text("AR")],
 860     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
 861     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
 862     ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
 863     ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
 864     ["dunning_edit",                   $locale->text("Create and edit dunnings")],
 865     ["sales_all_edit",                 $locale->text("View/edit all employees sales documents")],
 866     ["--ap",                           $locale->text("AP")],
 867     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
 868     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
 869     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
 870     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
 871     ["--warehouse_management",         $locale->text("Warehouse management")],
 872     ["warehouse_contents",             $locale->text("View warehouse content")],
 873     ["warehouse_management",           $locale->text("Warehouse management")],
 874     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
 875     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
 876     ["datev_export",                   $locale->text("DATEV Export")],
 877     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
 878     ["--reports",                      $locale->text('Reports')],
 879     ["report",                         $locale->text('All reports')],
 880     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
 881     ["--batch_printing",               $locale->text("Batch Printing")],
 882     ["batch_printing",                 $locale->text("Batch Printing")],
 883     ["--others",                       $locale->text("Others")],
 884     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
 885     ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
 886     );
 887
 888   return @all_rights;
 889 }
 890
 891 sub all_rights {
 892   return grep !/^--/, map { $_->[0] } all_rights_full();
 893 }
 894
 895 sub read_groups {
 896   $main::lxdebug->enter_sub();
 897
 898   my $self = shift;
 899
 900   my $form   = $main::form;
 901   my $groups = {};
 902   my $dbh    = $self->dbconnect();
 903
 904   my $query  = 'SELECT * FROM auth."group"';
 905   my $sth    = prepare_execute_query($form, $dbh, $query);
 906
 907   my ($row, $group);
 908
 909   while ($row = $sth->fetchrow_hashref()) {
 910     $groups->{$row->{id}} = $row;
 911   }
 912   $sth->finish();
 913
 914   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
 915   $sth   = prepare_query($form, $dbh, $query);
 916
 917   foreach $group (values %{$groups}) {
 918     my @members;
 919
 920     do_statement($form, $sth, $query, $group->{id});
 921
 922     while ($row = $sth->fetchrow_hashref()) {
 923       push @members, $row->{user_id};
 924     }
 925     $group->{members} = [ uniq @members ];
 926   }
 927   $sth->finish();
 928
 929   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
 930   $sth   = prepare_query($form, $dbh, $query);
 931
 932   foreach $group (values %{$groups}) {
 933     $group->{rights} = {};
 934
 935     do_statement($form, $sth, $query, $group->{id});
 936
 937     while ($row = $sth->fetchrow_hashref()) {
 938       $group->{rights}->{$row->{right}} |= $row->{granted};
 939     }
 940
 941     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
 942   }
 943   $sth->finish();
 944
 945   $main::lxdebug->leave_sub();
 946
 947   return $groups;
 948 }
 949
 950 sub save_group {
 951   $main::lxdebug->enter_sub();
 952
 953   my $self  = shift;
 954   my $group = shift;
 955
 956   my $form  = $main::form;
 957   my $dbh   = $self->dbconnect();
 958
 959   $dbh->begin_work;
 960
 961   my ($query, $sth, $row, $rights);
 962
 963   if (!$group->{id}) {
 964     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
 965
 966     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
 967     do_query($form, $dbh, $query, $group->{id});
 968   }
 969
 970   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
 971
 972   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
 973
 974   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
 975   $sth    = prepare_query($form, $dbh, $query);
 976
 977   foreach my $user_id (uniq @{ $group->{members} }) {
 978     do_statement($form, $sth, $query, $user_id, $group->{id});
 979   }
 980   $sth->finish();
 981
 982   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
 983
 984   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
 985   $sth   = prepare_query($form, $dbh, $query);
 986
 987   foreach my $right (keys %{ $group->{rights} }) {
 988     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
 989   }
 990   $sth->finish();
 991
 992   $dbh->commit();
 993
 994   $main::lxdebug->leave_sub();
 995 }
 996
 997 sub delete_group {
 998   $main::lxdebug->enter_sub();
 999
1000   my $self = shift;
1001   my $id   = shift;
1002
1003   my $form = $main::form;
1004
1005   my $dbh  = $self->dbconnect();
1006   $dbh->begin_work;
1007
1008   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1009   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1010   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1011
1012   $dbh->commit();
1013
1014   $main::lxdebug->leave_sub();
1015 }
1016
1017 sub evaluate_rights_ary {
1018   $main::lxdebug->enter_sub(2);
1019
1020   my $ary    = shift;
1021
1022   my $value  = 0;
1023   my $action = '|';
1024
1025   foreach my $el (@{$ary}) {
1026     if (ref $el eq "ARRAY") {
1027       if ($action eq '|') {
1028         $value |= evaluate_rights_ary($el);
1029       } else {
1030         $value &= evaluate_rights_ary($el);
1031       }
1032
1033     } elsif (($el eq '&') || ($el eq '|')) {
1034       $action = $el;
1035
1036     } elsif ($action eq '|') {
1037       $value |= $el;
1038
1039     } else {
1040       $value &= $el;
1041
1042     }
1043   }
1044
1045   $main::lxdebug->leave_sub(2);
1046
1047   return $value;
1048 }
1049
1050 sub _parse_rights_string {
1051   $main::lxdebug->enter_sub(2);
1052
1053   my $self   = shift;
1054
1055   my $login  = shift;
1056   my $access = shift;
1057
1058   my @stack;
1059   my $cur_ary = [];
1060
1061   push @stack, $cur_ary;
1062
1063   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1064     my $token = $1;
1065     substr($access, 0, length $1) = "";
1066
1067     next if ($token =~ /\s/);
1068
1069     if ($token eq "(") {
1070       my $new_cur_ary = [];
1071       push @stack, $new_cur_ary;
1072       push @{$cur_ary}, $new_cur_ary;
1073       $cur_ary = $new_cur_ary;
1074
1075     } elsif ($token eq ")") {
1076       pop @stack;
1077
1078       if (!@stack) {
1079         $main::lxdebug->leave_sub(2);
1080         return 0;
1081       }
1082
1083       $cur_ary = $stack[-1];
1084
1085     } elsif (($token eq "|") || ($token eq "&")) {
1086       push @{$cur_ary}, $token;
1087
1088     } else {
1089       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1090     }
1091   }
1092
1093   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1094
1095   $main::lxdebug->leave_sub(2);
1096
1097   return $result;
1098 }
1099
1100 sub check_right {
1101   $main::lxdebug->enter_sub(2);
1102
1103   my $self    = shift;
1104   my $login   = shift;
1105   my $right   = shift;
1106   my $default = shift;
1107
1108   $self->{FULL_RIGHTS}           ||= { };
1109   $self->{FULL_RIGHTS}->{$login} ||= { };
1110
1111   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1112     $self->{RIGHTS}           ||= { };
1113     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1114
1115     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1116   }
1117
1118   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1119   $granted    = $default if (!defined $granted);
1120
1121   $main::lxdebug->leave_sub(2);
1122
1123   return $granted;
1124 }
1125
1126 sub assert {
1127   $::lxdebug->enter_sub(2);
1128   my ($self, $right, $dont_abort) = @_;
1129
1130   if ($self->check_right($::myconfig{login}, $right)) {
1131     $::lxdebug->leave_sub(2);
1132     return 1;
1133   }
1134
1135   if (!$dont_abort) {
1136     delete $::form->{title};
1137     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1138   }
1139
1140   $::lxdebug->leave_sub(2);
1141
1142   return 0;
1143 }
1144
1145 sub load_rights_for_user {
1146   $::lxdebug->enter_sub;
1147
1148   my ($self, $login) = @_;
1149   my $dbh   = $self->dbconnect;
1150   my ($query, $sth, $row, $rights);
1151
1152   $rights = { map { $_ => 0 } all_rights() };
1153
1154   $query =
1155     qq|SELECT gr."right", gr.granted
1156        FROM auth.group_rights gr
1157        WHERE group_id IN
1158          (SELECT ug.group_id
1159           FROM auth.user_group ug
1160           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1161           WHERE u.login = ?)|;
1162
1163   $sth = prepare_execute_query($::form, $dbh, $query, $login);
1164
1165   while ($row = $sth->fetchrow_hashref()) {
1166     $rights->{$row->{right}} |= $row->{granted};
1167   }
1168   $sth->finish();
1169
1170   $::lxdebug->leave_sub;
1171
1172   return $rights;
1173 }
1174
1175 1;
1176 __END__
1177
1178 =pod
1179
1180 =encoding utf8
1181
1182 =head1 NAME
1183
1184 SL::Auth - Authentication and session handling
1185
1186 =head1 FUNCTIONS
1187
1188 =over 4
1189
1190 =item C<set_session_value %values>
1191
1192 Store all key/value pairs in C<%values> in the session. All of these
1193 values are copied back into C<$::form> in the next request
1194 automatically.
1195
1196 The values can be any Perl structure. They are stored as YAML dumps.
1197
1198 =item C<get_session_value $key>
1199
1200 Retrieve a value from the session. Returns C<undef> if the value
1201 doesn't exist.
1202
1203 =item C<create_unique_sesion_value $value, %params>
1204
1205 Create a unique key in the session and store C<$value>
1206 there.
1207
1208 If C<$params{expiration}> is set then it is interpreted as a number of
1209 seconds after which the value is removed from the session. It will
1210 never expire if that parameter is falsish.
1211
1212 Returns the key created in the session.
1213
1214 =item C<expire_session_keys>
1215
1216 Removes all keys from the session that have an expiration time set and
1217 whose expiration time is in the past.
1218
1219 =item C<save_session>
1220
1221 Stores the session values in the database. This is the only function
1222 that actually stores stuff in the database. Neither the various
1223 setters nor the deleter access the database.
1224
1225 =item <save_form_in_session %params>
1226
1227 Stores the content of C<$params{form}> (default: C<$::form>) in the
1228 session using L</create_unique_sesion_value>.
1229
1230 If C<$params{non_scalars}> is trueish then non-scalar values will be
1231 stored as well. Default is to only store scalar values.
1232
1233 The following keys will never be saved: C<login>, C<password>,
1234 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1235 can be given as an array ref in C<$params{skip_keys}>.
1236
1237 Returns the unique key under which the form is stored.
1238
1239 =item <restore_form_from_session $key, %params>
1240
1241 Restores the form from the session into C<$params{form}> (default:
1242 C<$::form>).
1243
1244 If C<$params{clobber}> is falsish then existing values with the same
1245 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1246 is on by default.
1247
1248 Returns C<$self>.
1249
1250 =back
1251
1252 =head1 BUGS
1253
1254 Nothing here yet.
1255
1256 =head1 AUTHOR
1257
1258 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1259
1260 =cut