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