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