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