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     ["--others",                       $locale->text("Others")],
1075     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
1076     ["config",                         $locale->text("Change kivitendo installation settings (all menu entries beneath 'System')")],
1077     ["admin",                          $locale->text("Administration (Used to access instance administration from user logins)")],
1078     ["productivity",                   $locale->text("Productivity")],
1079     ["display_admin_link",             $locale->text("Show administration link")],
1080     );
1081
1082   return @all_rights;
1083 }
1084
1085 sub all_rights {
1086   return grep !/^--/, map { $_->[0] } all_rights_full();
1087 }
1088
1089 sub read_groups {
1090   $main::lxdebug->enter_sub();
1091
1092   my $self = shift;
1093
1094   my $form   = $main::form;
1095   my $groups = {};
1096   my $dbh    = $self->dbconnect();
1097
1098   my $query  = 'SELECT * FROM auth."group"';
1099   my $sth    = prepare_execute_query($form, $dbh, $query);
1100
1101   my ($row, $group);
1102
1103   while ($row = $sth->fetchrow_hashref()) {
1104     $groups->{$row->{id}} = $row;
1105   }
1106   $sth->finish();
1107
1108   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1109   $sth   = prepare_query($form, $dbh, $query);
1110
1111   foreach $group (values %{$groups}) {
1112     my @members;
1113
1114     do_statement($form, $sth, $query, $group->{id});
1115
1116     while ($row = $sth->fetchrow_hashref()) {
1117       push @members, $row->{user_id};
1118     }
1119     $group->{members} = [ uniq @members ];
1120   }
1121   $sth->finish();
1122
1123   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1124   $sth   = prepare_query($form, $dbh, $query);
1125
1126   foreach $group (values %{$groups}) {
1127     $group->{rights} = {};
1128
1129     do_statement($form, $sth, $query, $group->{id});
1130
1131     while ($row = $sth->fetchrow_hashref()) {
1132       $group->{rights}->{$row->{right}} |= $row->{granted};
1133     }
1134
1135     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1136   }
1137   $sth->finish();
1138
1139   $main::lxdebug->leave_sub();
1140
1141   return $groups;
1142 }
1143
1144 sub save_group {
1145   $main::lxdebug->enter_sub();
1146
1147   my $self  = shift;
1148   my $group = shift;
1149
1150   my $form  = $main::form;
1151   my $dbh   = $self->dbconnect();
1152
1153   $dbh->begin_work;
1154
1155   my ($query, $sth, $row, $rights);
1156
1157   if (!$group->{id}) {
1158     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1159
1160     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1161     do_query($form, $dbh, $query, $group->{id});
1162   }
1163
1164   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1165
1166   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1167
1168   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1169   $sth    = prepare_query($form, $dbh, $query);
1170
1171   foreach my $user_id (uniq @{ $group->{members} }) {
1172     do_statement($form, $sth, $query, $user_id, $group->{id});
1173   }
1174   $sth->finish();
1175
1176   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1177
1178   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1179   $sth   = prepare_query($form, $dbh, $query);
1180
1181   foreach my $right (keys %{ $group->{rights} }) {
1182     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1183   }
1184   $sth->finish();
1185
1186   $dbh->commit();
1187
1188   $main::lxdebug->leave_sub();
1189 }
1190
1191 sub delete_group {
1192   $main::lxdebug->enter_sub();
1193
1194   my $self = shift;
1195   my $id   = shift;
1196
1197   my $form = $main::form;
1198
1199   my $dbh  = $self->dbconnect();
1200   $dbh->begin_work;
1201
1202   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1203   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1204   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1205
1206   $dbh->commit();
1207
1208   $main::lxdebug->leave_sub();
1209 }
1210
1211 sub evaluate_rights_ary {
1212   $main::lxdebug->enter_sub(2);
1213
1214   my $ary    = shift;
1215
1216   my $value  = 0;
1217   my $action = '|';
1218
1219   foreach my $el (@{$ary}) {
1220     if (ref $el eq "ARRAY") {
1221       if ($action eq '|') {
1222         $value |= evaluate_rights_ary($el);
1223       } else {
1224         $value &= evaluate_rights_ary($el);
1225       }
1226
1227     } elsif (($el eq '&') || ($el eq '|')) {
1228       $action = $el;
1229
1230     } elsif ($action eq '|') {
1231       $value |= $el;
1232
1233     } else {
1234       $value &= $el;
1235
1236     }
1237   }
1238
1239   $main::lxdebug->leave_sub(2);
1240
1241   return $value;
1242 }
1243
1244 sub _parse_rights_string {
1245   $main::lxdebug->enter_sub(2);
1246
1247   my $self   = shift;
1248
1249   my $login  = shift;
1250   my $access = shift;
1251
1252   my @stack;
1253   my $cur_ary = [];
1254
1255   push @stack, $cur_ary;
1256
1257   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1258     my $token = $1;
1259     substr($access, 0, length $1) = "";
1260
1261     next if ($token =~ /\s/);
1262
1263     if ($token eq "(") {
1264       my $new_cur_ary = [];
1265       push @stack, $new_cur_ary;
1266       push @{$cur_ary}, $new_cur_ary;
1267       $cur_ary = $new_cur_ary;
1268
1269     } elsif ($token eq ")") {
1270       pop @stack;
1271
1272       if (!@stack) {
1273         $main::lxdebug->leave_sub(2);
1274         return 0;
1275       }
1276
1277       $cur_ary = $stack[-1];
1278
1279     } elsif (($token eq "|") || ($token eq "&")) {
1280       push @{$cur_ary}, $token;
1281
1282     } else {
1283       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1284     }
1285   }
1286
1287   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1288
1289   $main::lxdebug->leave_sub(2);
1290
1291   return $result;
1292 }
1293
1294 sub check_right {
1295   $main::lxdebug->enter_sub(2);
1296
1297   my $self    = shift;
1298   my $login   = shift;
1299   my $right   = shift;
1300   my $default = shift;
1301
1302   $self->{FULL_RIGHTS}           ||= { };
1303   $self->{FULL_RIGHTS}->{$login} ||= { };
1304
1305   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1306     $self->{RIGHTS}           ||= { };
1307     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1308
1309     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1310   }
1311
1312   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1313   $granted    = $default if (!defined $granted);
1314
1315   $main::lxdebug->leave_sub(2);
1316
1317   return $granted;
1318 }
1319
1320 sub assert {
1321   $::lxdebug->enter_sub(2);
1322   my ($self, $right, $dont_abort) = @_;
1323
1324   if ($self->check_right($::myconfig{login}, $right)) {
1325     $::lxdebug->leave_sub(2);
1326     return 1;
1327   }
1328
1329   if (!$dont_abort) {
1330     delete $::form->{title};
1331     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1332   }
1333
1334   $::lxdebug->leave_sub(2);
1335
1336   return 0;
1337 }
1338
1339 sub load_rights_for_user {
1340   $::lxdebug->enter_sub;
1341
1342   my ($self, $login) = @_;
1343   my $dbh   = $self->dbconnect;
1344   my ($query, $sth, $row, $rights);
1345
1346   $rights = { map { $_ => 0 } all_rights() };
1347
1348   $query =
1349     qq|SELECT gr."right", gr.granted
1350        FROM auth.group_rights gr
1351        WHERE group_id IN
1352          (SELECT ug.group_id
1353           FROM auth.user_group ug
1354           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1355           WHERE u.login = ?)
1356        AND group_id IN
1357          (SELECT cg.group_id
1358           FROM auth.clients_groups cg
1359           WHERE cg.client_id = ?)|;
1360
1361   $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1362
1363   while ($row = $sth->fetchrow_hashref()) {
1364     $rights->{$row->{right}} |= $row->{granted};
1365   }
1366   $sth->finish();
1367
1368   $::lxdebug->leave_sub;
1369
1370   return $rights;
1371 }
1372
1373 1;
1374 __END__
1375
1376 =pod
1377
1378 =encoding utf8
1379
1380 =head1 NAME
1381
1382 SL::Auth - Authentication and session handling
1383
1384 =head1 FUNCTIONS
1385
1386 =over 4
1387
1388 =item C<set_session_value @values>
1389
1390 =item C<set_session_value %values>
1391
1392 Store all values of C<@values> or C<%values> in the session. Each
1393 member of C<@values> is tested if it is a hash reference. If it is
1394 then it must contain the keys C<key> and C<value> and can optionally
1395 contain the key C<auto_restore>. In this case C<value> is associated
1396 with C<key> and restored to C<$::form> upon the next request
1397 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1398 value.
1399
1400 If the current member of C<@values> is not a hash reference then it
1401 will be used as the C<key> and the next entry of C<@values> is used as
1402 the C<value> to store. In this case setting C<auto_restore> is not
1403 possible.
1404
1405 Therefore the following two invocations are identical:
1406
1407   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1408   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1409
1410 All of these values are copied back into C<$::form> for the next
1411 request automatically if they're scalar values or if they have
1412 C<auto_restore> set to trueish.
1413
1414 The values can be any Perl structure. They are stored as YAML dumps.
1415
1416 =item C<get_session_value $key>
1417
1418 Retrieve a value from the session. Returns C<undef> if the value
1419 doesn't exist.
1420
1421 =item C<create_unique_sesion_value $value, %params>
1422
1423 Create a unique key in the session and store C<$value>
1424 there.
1425
1426 Returns the key created in the session.
1427
1428 =item C<save_session>
1429
1430 Stores the session values in the database. This is the only function
1431 that actually stores stuff in the database. Neither the various
1432 setters nor the deleter access the database.
1433
1434 =item <save_form_in_session %params>
1435
1436 Stores the content of C<$params{form}> (default: C<$::form>) in the
1437 session using L</create_unique_sesion_value>.
1438
1439 If C<$params{non_scalars}> is trueish then non-scalar values will be
1440 stored as well. Default is to only store scalar values.
1441
1442 The following keys will never be saved: C<login>, C<password>,
1443 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1444 can be given as an array ref in C<$params{skip_keys}>.
1445
1446 Returns the unique key under which the form is stored.
1447
1448 =item <restore_form_from_session $key, %params>
1449
1450 Restores the form from the session into C<$params{form}> (default:
1451 C<$::form>).
1452
1453 If C<$params{clobber}> is falsish then existing values with the same
1454 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1455 is on by default.
1456
1457 Returns C<$self>.
1458
1459 =back
1460
1461 =head1 BUGS
1462
1463 Nothing here yet.
1464
1465 =head1 AUTHOR
1466
1467 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1468
1469 =cut