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