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