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