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