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