SL/Auth.pm

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