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