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