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