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 use Regexp::IPv6 qw($IPv6_re);
  11
  12 use SL::Auth::ColumnInformation;
  13 use SL::Auth::Constants qw(:all);
  14 use SL::Auth::DB;
  15 use SL::Auth::LDAP;
  16 use SL::Auth::Password;
  17 use SL::Auth::SessionValue;
  18
  19 use SL::SessionFile;
  20 use SL::User;
  21 use SL::DBConnect;
  22 use SL::DBUpgrade2;
  23 use SL::DBUtils qw(do_query do_statement prepare_execute_query prepare_query selectall_array_query selectrow_query selectall_ids);
  24
  25 use strict;
  26
  27 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
  28 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
  29
  30 use Rose::Object::MakeMethods::Generic (
  31   scalar => [ qw(client) ],
  32 );
  33
  34
  35 sub new {
  36   my ($type, %params) = @_;
  37   my $self            = bless {}, $type;
  38
  39   $self->_read_auth_config(%params);
  40   $self->init;
  41
  42   return $self;
  43 }
  44
  45 sub init {
  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 }
  54
  55 sub reset {
  56   my ($self, %params) = @_;
  57
  58   $self->{SESSION}        = { };
  59   $self->{FULL_RIGHTS}    = { };
  60   $self->{RIGHTS}         = { };
  61   $self->{unique_counter} = 0;
  62
  63   if ($self->is_db_connected) {
  64     # reset is called during request shutdown already. In case of a
  65     # completely new auth DB this would fail and generate an error
  66     # message even if the user is currently trying to create said auth
  67     # DB. Therefore only fetch the column information if a connection
  68     # has been established.
  69     $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
  70     $self->{column_information}->_fetch;
  71   } else {
  72     delete $self->{column_information};
  73   }
  74
  75   $self->{authenticator}->reset;
  76
  77   $self->client(undef);
  78 }
  79
  80 sub set_client {
  81   my ($self, $id_or_name) = @_;
  82
  83   $self->client(undef);
  84
  85   return undef unless $id_or_name;
  86
  87   my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
  88   my $dbh    = $self->dbconnect;
  89
  90   return undef unless $dbh;
  91
  92   $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
  93
  94   return $self->client;
  95 }
  96
  97 sub get_default_client_id {
  98   my ($self) = @_;
  99
 100   my $dbh    = $self->dbconnect;
 101
 102   return unless $dbh;
 103
 104   my $row = $dbh->selectrow_hashref(qq|SELECT id FROM auth.clients WHERE is_default = TRUE LIMIT 1|);
 105
 106   return $row->{id} if $row;
 107 }
 108
 109 sub DESTROY {
 110   my $self = shift;
 111
 112   $self->{dbh}->disconnect() if ($self->{dbh});
 113 }
 114
 115 # form isn't loaded yet, so auth needs it's own error.
 116 sub mini_error {
 117   $::lxdebug->show_backtrace();
 118
 119   my ($self, @msg) = @_;
 120   if ($ENV{HTTP_USER_AGENT}) {
 121     # $::form might not be initialized yet at this point — therefore
 122     # we cannot use "create_http_response" yet.
 123     my $cgi = CGI->new('');
 124     print $cgi->header('-type' => 'text/html', '-charset' => 'UTF-8');
 125     print "<pre>", join ('<br>', @msg), "</pre>";
 126   } else {
 127     print STDERR "Error: @msg\n";
 128   }
 129   $::dispatcher->end_request;
 130 }
 131
 132 sub _read_auth_config {
 133   my ($self, %params) = @_;
 134
 135   map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
 136
 137   # Prevent password leakage to log files when dumping Auth instances.
 138   $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
 139
 140   if ($params{unit_tests_database}) {
 141     $self->{DB_config}   = $::lx_office_conf{'testing/database'};
 142     $self->{module}      = 'DB';
 143
 144   } else {
 145     $self->{DB_config}   = $::lx_office_conf{'authentication/database'};
 146   }
 147
 148   if ($self->{module} eq 'DB') {
 149     $self->{authenticator} = SL::Auth::DB->new($self);
 150
 151   } elsif ($self->{module} eq 'LDAP') {
 152     $self->{authenticator} = SL::Auth::LDAP->new($::lx_office_conf{'authentication/ldap'});
 153   }
 154
 155   if (!$self->{authenticator}) {
 156     my $locale = Locale->new('en');
 157     $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
 158   }
 159
 160   my $cfg = $self->{DB_config};
 161
 162   if (!$cfg) {
 163     my $locale = Locale->new('en');
 164     $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
 165   }
 166
 167   if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
 168     my $locale = Locale->new('en');
 169     $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
 170   }
 171
 172   $self->{authenticator}->verify_config();
 173
 174   $self->{session_timeout} *= 1;
 175   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
 176 }
 177
 178 sub has_access_to_client {
 179   my ($self, $login) = @_;
 180
 181   return 0 if !$self->client || !$self->client->{id};
 182
 183   my $sql = <<SQL;
 184     SELECT cu.client_id
 185     FROM auth.clients_users cu
 186     LEFT JOIN auth."user" u ON (cu.user_id = u.id)
 187     WHERE (u.login      = ?)
 188       AND (cu.client_id = ?)
 189 SQL
 190
 191   my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
 192   return $has_access;
 193 }
 194
 195 sub authenticate_root {
 196   my ($self, $password) = @_;
 197
 198   my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
 199   if (defined $session_root_auth && $session_root_auth == OK) {
 200     return OK;
 201   }
 202
 203   if (!defined $password) {
 204     return ERR_PASSWORD;
 205   }
 206
 207   my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
 208   $password             = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
 209
 210   my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
 211   $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
 212
 213   return $result;
 214 }
 215
 216 sub authenticate {
 217   my ($self, $login, $password) = @_;
 218
 219   if (!$self->client || !$self->has_access_to_client($login)) {
 220     return ERR_PASSWORD;
 221   }
 222
 223   my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
 224   if (defined $session_auth && $session_auth == OK) {
 225     return OK;
 226   }
 227
 228   if (!defined $password) {
 229     return ERR_PASSWORD;
 230   }
 231
 232   my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
 233   $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
 234   return $result;
 235 }
 236
 237 sub punish_wrong_login {
 238   my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
 239   sleep $failed_login_penalty if $failed_login_penalty;
 240 }
 241
 242 sub get_stored_password {
 243   my ($self, $login) = @_;
 244
 245   my $dbh            = $self->dbconnect;
 246
 247   return undef unless $dbh;
 248
 249   my $query             = qq|SELECT password FROM auth."user" WHERE login = ?|;
 250   my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
 251
 252   return $stored_password;
 253 }
 254
 255 sub dbconnect {
 256   my $self     = shift;
 257   my $may_fail = shift;
 258
 259   if ($self->{dbh}) {
 260     return $self->{dbh};
 261   }
 262
 263   my $cfg = $self->{DB_config};
 264   my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
 265
 266   if ($cfg->{port}) {
 267     $dsn .= ';port=' . $cfg->{port};
 268   }
 269
 270   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 271
 272   $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
 273
 274   if (!$may_fail && !$self->{dbh}) {
 275     delete $self->{dbh};
 276     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
 277   }
 278
 279   return $self->{dbh};
 280 }
 281
 282 sub dbdisconnect {
 283   my $self = shift;
 284
 285   if ($self->{dbh}) {
 286     $self->{dbh}->disconnect();
 287     delete $self->{dbh};
 288   }
 289 }
 290
 291 sub is_db_connected {
 292   my ($self) = @_;
 293   return !!$self->{dbh};
 294 }
 295
 296 sub check_tables {
 297   my ($self, $dbh)    = @_;
 298
 299   $dbh   ||= $self->dbconnect();
 300   my $query   = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
 301
 302   my ($count) = $dbh->selectrow_array($query);
 303
 304   return $count > 0;
 305 }
 306
 307 sub check_database {
 308   my $self = shift;
 309
 310   my $dbh  = $self->dbconnect(1);
 311
 312   return $dbh ? 1 : 0;
 313 }
 314
 315 sub create_database {
 316   my $self   = shift;
 317   my %params = @_;
 318
 319   my $cfg    = $self->{DB_config};
 320
 321   if (!$params{superuser}) {
 322     $params{superuser}          = $cfg->{user};
 323     $params{superuser_password} = $cfg->{password};
 324   }
 325
 326   $params{template} ||= 'template0';
 327   $params{template}   =~ s|[^a-zA-Z0-9_\-]||g;
 328
 329   my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
 330
 331   if ($cfg->{port}) {
 332     $dsn .= ';port=' . $cfg->{port};
 333   }
 334
 335   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
 336
 337   my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
 338
 339   if (!$dbh) {
 340     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
 341   }
 342
 343   my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
 344
 345   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
 346
 347   $dbh->do($query);
 348
 349   if ($dbh->err) {
 350     my $error = $dbh->errstr();
 351
 352     $query                 = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 353     my ($cluster_encoding) = $dbh->selectrow_array($query);
 354
 355     if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
 356       $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
 357     }
 358
 359     $dbh->disconnect();
 360
 361     $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
 362   }
 363
 364   $dbh->disconnect();
 365 }
 366
 367 sub create_tables {
 368   my $self = shift;
 369   my $dbh  = $self->dbconnect();
 370
 371   $dbh->rollback();
 372   SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
 373 }
 374
 375 sub save_user {
 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
 414 sub can_change_password {
 415   my $self = shift;
 416
 417   return $self->{authenticator}->can_change_password();
 418 }
 419
 420 sub change_password {
 421   my ($self, $login, $new_password) = @_;
 422
 423   my $result = $self->{authenticator}->change_password($login, $new_password);
 424
 425   return $result;
 426 }
 427
 428 sub read_all_users {
 429   my $self  = shift;
 430
 431   my $dbh   = $self->dbconnect();
 432   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
 433
 434                  FROM auth."user" AS  u
 435
 436                  LEFT JOIN auth.user_config AS cfg
 437                    ON (cfg.user_id = u.id)
 438
 439                  LEFT JOIN auth.session_content AS sc_login
 440                    ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
 441
 442                  LEFT JOIN auth.session AS s
 443                    ON (s.id = sc_login.session_id)
 444               |;
 445   my $sth   = prepare_execute_query($main::form, $dbh, $query);
 446
 447   my %users;
 448
 449   while (my $ref = $sth->fetchrow_hashref()) {
 450
 451     $users{$ref->{login}}                    ||= {
 452                                                 'login' => $ref->{login},
 453                                                 'id' => $ref->{id},
 454                                                 'last_action' => $ref->{last_action},
 455                                              };
 456     $users{$ref->{login}}->{$ref->{cfg_key}}   = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
 457   }
 458
 459   $sth->finish();
 460
 461   return %users;
 462 }
 463
 464 sub read_user {
 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   return %user_data;
 505 }
 506
 507 sub get_user_id {
 508   my $self  = shift;
 509   my $login = shift;
 510
 511   my $dbh   = $self->dbconnect();
 512   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
 513
 514   return $id;
 515 }
 516
 517 sub delete_user {
 518   my $self  = shift;
 519   my $login = shift;
 520
 521   my $dbh   = $self->dbconnect;
 522   my $id    = $self->get_user_id($login);
 523
 524   if (!$id) {
 525     $dbh->rollback;
 526     return;
 527   }
 528
 529   $dbh->begin_work;
 530
 531   do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
 532   do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
 533   do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
 534
 535   # TODO: SL::Auth::delete_user
 536   # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
 537
 538   $dbh->commit;
 539 }
 540
 541 # --------------------------------------
 542
 543 my $session_id;
 544
 545 sub restore_session {
 546   my $self = shift;
 547
 548   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
 549   $session_id        =~ s|[^0-9a-f]||g if $session_id;
 550
 551   $self->{SESSION}   = { };
 552
 553   if (!$session_id) {
 554     return $self->session_restore_result(SESSION_NONE());
 555   }
 556
 557   my ($dbh, $query, $sth, $cookie, $ref, $form);
 558
 559   $form   = $main::form;
 560
 561   # Don't fail if the auth DB doesn't exist yet.
 562   if (!( $dbh = $self->dbconnect(1) )) {
 563     return $self->session_restore_result(SESSION_NONE());
 564   }
 565
 566   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
 567   # admin is creating the session tables at the moment.
 568   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
 569
 570   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
 571     $sth->finish if $sth;
 572     return $self->session_restore_result(SESSION_NONE());
 573   }
 574
 575   $cookie = $sth->fetchrow_hashref;
 576   $sth->finish;
 577
 578   # The session ID provided is valid in the following cases:
 579   #  1. session ID exists in the database
 580   #  2. hasn't expired yet
 581   #  3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
 582   $self->{api_token}   = $cookie->{api_token} if $cookie;
 583   my $api_token_cookie = $self->get_api_token_cookie;
 584   my $cookie_is_bad    = !$cookie || $cookie->{is_expired};
 585   $cookie_is_bad     ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if  $api_token_cookie;
 586   if ($cookie_is_bad) {
 587     $self->destroy_session();
 588     return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
 589   }
 590
 591   if ($self->{column_information}->has('auto_restore')) {
 592     $self->_load_with_auto_restore_column($dbh, $session_id);
 593   } else {
 594     $self->_load_without_auto_restore_column($dbh, $session_id);
 595   }
 596
 597   return $self->session_restore_result(SESSION_OK());
 598 }
 599
 600 sub session_restore_result {
 601   my $self = shift;
 602   if (@_) {
 603     $self->{session_restore_result} = $_[0];
 604   }
 605   return $self->{session_restore_result};
 606 }
 607
 608 sub _load_without_auto_restore_column {
 609   my ($self, $dbh, $session_id) = @_;
 610
 611   my $query = <<SQL;
 612     SELECT sess_key, sess_value
 613     FROM auth.session_content
 614     WHERE (session_id = ?)
 615 SQL
 616   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 617
 618   while (my $ref = $sth->fetchrow_hashref) {
 619     my $value = SL::Auth::SessionValue->new(auth  => $self,
 620                                             key   => $ref->{sess_key},
 621                                             value => $ref->{sess_value},
 622                                             raw   => 1);
 623     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 624
 625     next if defined $::form->{$ref->{sess_key}};
 626
 627     my $data                    = $value->get;
 628     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 629   }
 630 }
 631
 632 sub _load_with_auto_restore_column {
 633   my ($self, $dbh, $session_id) = @_;
 634
 635   my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
 636
 637   my $query = <<SQL;
 638     SELECT sess_key, sess_value, auto_restore
 639     FROM auth.session_content
 640     WHERE (session_id = ?) AND (auto_restore OR sess_key IN (@{[ join ',', ("?") x keys %auto_restore_keys ]}))
 641 SQL
 642   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id, keys %auto_restore_keys);
 643
 644   my $need_delete;
 645   while (my $ref = $sth->fetchrow_hashref) {
 646     $need_delete = 1 if $ref->{auto_restore};
 647     my $value = SL::Auth::SessionValue->new(auth         => $self,
 648                                             key          => $ref->{sess_key},
 649                                             value        => $ref->{sess_value},
 650                                             auto_restore => $ref->{auto_restore},
 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   $sth->finish;
 661
 662   if ($need_delete) {
 663     do_query($::form, $dbh, 'DELETE FROM auth.session_content WHERE auto_restore AND session_id = ?', $session_id);
 664   }
 665 }
 666
 667 sub destroy_session {
 668   my $self = shift;
 669
 670   if ($session_id) {
 671     my $dbh = $self->dbconnect();
 672
 673     $dbh->begin_work;
 674
 675     do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
 676     do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
 677
 678     $dbh->commit();
 679
 680     SL::SessionFile->destroy_session($session_id);
 681
 682     $session_id      = undef;
 683     $self->{SESSION} = { };
 684   }
 685 }
 686
 687 sub active_session_ids {
 688   my $self  = shift;
 689   my $dbh   = $self->dbconnect;
 690
 691   my $query = qq|SELECT id FROM auth.session|;
 692
 693   my @ids   = selectall_array_query($::form, $dbh, $query);
 694
 695   return @ids;
 696 }
 697
 698 sub expire_sessions {
 699   my $self  = shift;
 700
 701   return if !$self->session_tables_present;
 702
 703   my $dbh   = $self->dbconnect();
 704
 705   my $query = qq|SELECT id
 706                  FROM auth.session
 707                  WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
 708
 709   my @ids   = selectall_array_query($::form, $dbh, $query);
 710
 711   if (@ids) {
 712     $dbh->begin_work;
 713
 714     SL::SessionFile->destroy_session($_) for @ids;
 715
 716     $query = qq|DELETE FROM auth.session_content
 717                 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 718     do_query($main::form, $dbh, $query, @ids);
 719
 720     $query = qq|DELETE FROM auth.session
 721                 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 722     do_query($main::form, $dbh, $query, @ids);
 723
 724     $dbh->commit();
 725   }
 726 }
 727
 728 sub _create_session_id {
 729   my @data;
 730   map { push @data, int(rand() * 255); } (1..32);
 731
 732   my $id = md5_hex(pack 'C*', @data);
 733
 734   return $id;
 735 }
 736
 737 sub create_or_refresh_session {
 738   $session_id ||= shift->_create_session_id;
 739 }
 740
 741 sub save_session {
 742   my $self         = shift;
 743   my $provided_dbh = shift;
 744
 745   my $dbh          = $provided_dbh || $self->dbconnect(1);
 746
 747   return unless $dbh && $session_id;
 748
 749   $dbh->begin_work unless $provided_dbh;
 750
 751   # If this fails then the "auth" schema might not exist yet, e.g. if
 752   # the admin is just trying to create the auth database.
 753   if (!$dbh->do(qq|LOCK auth.session_content|)) {
 754     $dbh->rollback unless $provided_dbh;
 755     return;
 756   }
 757
 758   my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
 759
 760   if ($id) {
 761     do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
 762   } else {
 763     do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
 764   }
 765
 766   if ($self->{column_information}->has('api_token', 'session')) {
 767     my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
 768     do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
 769   }
 770
 771   my @values_to_save = grep    { $_->{modified} }
 772                        values %{ $self->{SESSION} };
 773   if (@values_to_save) {
 774     my %known_keys = map { $_ => 1 }
 775       selectall_ids($::form, $dbh, qq|SELECT sess_key FROM auth.session_content WHERE session_id = ?|, 'sess_key', $session_id);
 776     my $auto_restore             = $self->{column_information}->has('auto_restore');
 777
 778     my $insert_query  = $auto_restore
 779       ? "INSERT INTO auth.session_content (session_id, sess_key, sess_value, auto_restore) VALUES (?, ?, ?, ?)"
 780       : "INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)";
 781     my $insert_sth = prepare_query($::form, $dbh, $insert_query);
 782
 783     my $update_query  = $auto_restore
 784       ? "UPDATE auth.session_content SET sess_value = ?, auto_restore = ? WHERE session_id = ? AND sess_key = ?"
 785       : "UPDATE auth.session_content SET sess_value = ? WHERE session_id = ? AND sess_key = ?";
 786     my $update_sth = prepare_query($::form, $dbh, $update_query);
 787
 788     foreach my $value (@values_to_save) {
 789       my @values = ($value->{key}, $value->get_dumped);
 790       push @values, $value->{auto_restore} if $auto_restore;
 791
 792       if ($known_keys{$value->{key}}) {
 793         do_statement($::form, $update_sth, $update_query,
 794           $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore, $session_id, $value->{key}
 795         );
 796       } else {
 797         do_statement($::form, $insert_sth, $insert_query,
 798           $session_id, $value->{key}, $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore
 799         );
 800       }
 801     }
 802
 803     $insert_sth->finish;
 804     $update_sth->finish;
 805   }
 806
 807   $dbh->commit() unless $provided_dbh;
 808 }
 809
 810 sub set_session_value {
 811   my $self   = shift;
 812   my @params = @_;
 813
 814   $self->{SESSION} ||= { };
 815
 816   while (@params) {
 817     my $key = shift @params;
 818
 819     if (ref $key eq 'HASH') {
 820       $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key          => $key->{key},
 821                                                                       value        => $key->{value},
 822                                                                       modified     => 1,
 823                                                                       auto_restore => $key->{auto_restore});
 824
 825     } else {
 826       my $value = shift @params;
 827       $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key   => $key,
 828                                                                value => $value,
 829                                                                modified => 1);
 830     }
 831   }
 832
 833   return $self;
 834 }
 835
 836 sub delete_session_value {
 837   my $self = shift;
 838
 839   $self->{SESSION} ||= { };
 840   delete @{ $self->{SESSION} }{ @_ };
 841
 842   return $self;
 843 }
 844
 845 sub get_session_value {
 846   my ($self, $key) = @_;
 847
 848   return if !$self->{SESSION};
 849
 850   ($self->{SESSION}{$key} //= SL::Auth::SessionValue->new(auth => $self, key => $key))->get
 851 }
 852
 853 sub create_unique_sesion_value {
 854   my ($self, $value, %params) = @_;
 855
 856   $self->{SESSION} ||= { };
 857
 858   my @now                   = gettimeofday();
 859   my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
 860   $self->{unique_counter} ||= 0;
 861
 862   my $hashed_key;
 863   do {
 864     $self->{unique_counter}++;
 865     $hashed_key = md5_hex($key . $self->{unique_counter});
 866   } while (exists $self->{SESSION}->{$hashed_key});
 867
 868   $self->set_session_value($hashed_key => $value);
 869
 870   return $hashed_key;
 871 }
 872
 873 sub save_form_in_session {
 874   my ($self, %params) = @_;
 875
 876   my $form        = delete($params{form}) || $::form;
 877   my $non_scalars = delete $params{non_scalars};
 878   my $data        = {};
 879
 880   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
 881
 882   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
 883     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
 884   }
 885
 886   return $self->create_unique_sesion_value($data, %params);
 887 }
 888
 889 sub restore_form_from_session {
 890   my ($self, $key, %params) = @_;
 891
 892   my $data = $self->get_session_value($key);
 893   return $self unless $data;
 894
 895   my $form    = delete($params{form}) || $::form;
 896   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
 897
 898   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
 899
 900   return $self;
 901 }
 902
 903 sub set_cookie_environment_variable {
 904   my $self = shift;
 905   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
 906 }
 907
 908 sub get_session_cookie_name {
 909   my ($self, %params) = @_;
 910
 911   $params{type}     ||= 'id';
 912   my $name            = $self->{cookie_name} || 'lx_office_erp_session_id';
 913   $name              .= '_api_token' if $params{type} eq 'api_token';
 914
 915   return $name;
 916 }
 917
 918 sub get_session_id {
 919   return $session_id;
 920 }
 921
 922 sub get_api_token_cookie {
 923   my ($self) = @_;
 924
 925   $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
 926 }
 927
 928 sub is_api_token_cookie_valid {
 929   my ($self)             = @_;
 930   my $provided_api_token = $self->get_api_token_cookie;
 931   return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
 932 }
 933
 934 sub _tables_present {
 935   my ($self, @tables) = @_;
 936   my $cache_key = join '_', @tables;
 937
 938   # Only re-check for the presence of auth tables if either the check
 939   # hasn't been done before of if they weren't present.
 940   return $self->{"$cache_key\_tables_present"} ||= do {
 941     my $dbh  = $self->dbconnect(1);
 942
 943     if (!$dbh) {
 944       return 0;
 945     }
 946
 947     my $query =
 948       qq|SELECT COUNT(*)
 949          FROM pg_tables
 950          WHERE (schemaname = 'auth')
 951            AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))|;
 952
 953     my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
 954
 955     scalar @tables == $count;
 956   }
 957 }
 958
 959 sub session_tables_present {
 960   $_[0]->_tables_present('session', 'session_content');
 961 }
 962
 963 sub master_rights_present {
 964   $_[0]->_tables_present('master_rights');
 965 }
 966
 967 # --------------------------------------
 968
 969 sub all_rights_full {
 970   my ($self) = @_;
 971
 972   @{ $self->{master_rights} ||= do {
 973       $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position");
 974     }
 975   }
 976 }
 977
 978 sub all_rights {
 979   return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
 980 }
 981
 982 sub read_groups {
 983   my $self = shift;
 984
 985   my $form   = $main::form;
 986   my $groups = {};
 987   my $dbh    = $self->dbconnect();
 988
 989   my $query  = 'SELECT * FROM auth."group"';
 990   my $sth    = prepare_execute_query($form, $dbh, $query);
 991
 992   my ($row, $group);
 993
 994   while ($row = $sth->fetchrow_hashref()) {
 995     $groups->{$row->{id}} = $row;
 996   }
 997   $sth->finish();
 998
 999   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1000   $sth   = prepare_query($form, $dbh, $query);
1001
1002   foreach $group (values %{$groups}) {
1003     my @members;
1004
1005     do_statement($form, $sth, $query, $group->{id});
1006
1007     while ($row = $sth->fetchrow_hashref()) {
1008       push @members, $row->{user_id};
1009     }
1010     $group->{members} = [ uniq @members ];
1011   }
1012   $sth->finish();
1013
1014   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1015   $sth   = prepare_query($form, $dbh, $query);
1016
1017   foreach $group (values %{$groups}) {
1018     $group->{rights} = {};
1019
1020     do_statement($form, $sth, $query, $group->{id});
1021
1022     while ($row = $sth->fetchrow_hashref()) {
1023       $group->{rights}->{$row->{right}} |= $row->{granted};
1024     }
1025
1026     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
1027   }
1028   $sth->finish();
1029
1030   return $groups;
1031 }
1032
1033 sub save_group {
1034   my $self  = shift;
1035   my $group = shift;
1036
1037   my $form  = $main::form;
1038   my $dbh   = $self->dbconnect();
1039
1040   $dbh->begin_work;
1041
1042   my ($query, $sth, $row, $rights);
1043
1044   if (!$group->{id}) {
1045     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1046
1047     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1048     do_query($form, $dbh, $query, $group->{id});
1049   }
1050
1051   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1052
1053   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1054
1055   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1056   $sth    = prepare_query($form, $dbh, $query);
1057
1058   foreach my $user_id (uniq @{ $group->{members} }) {
1059     do_statement($form, $sth, $query, $user_id, $group->{id});
1060   }
1061   $sth->finish();
1062
1063   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1064
1065   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1066   $sth   = prepare_query($form, $dbh, $query);
1067
1068   foreach my $right (keys %{ $group->{rights} }) {
1069     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1070   }
1071   $sth->finish();
1072
1073   $dbh->commit();
1074 }
1075
1076 sub delete_group {
1077   my $self = shift;
1078   my $id   = shift;
1079
1080   my $form = $main::form;
1081
1082   my $dbh  = $self->dbconnect();
1083   $dbh->begin_work;
1084
1085   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1086   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1087   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1088
1089   $dbh->commit();
1090 }
1091
1092 sub evaluate_rights_ary {
1093   my $ary    = shift;
1094
1095   my $value  = 0;
1096   my $action = '|';
1097   my $negate = 0;
1098
1099   foreach my $el (@{$ary}) {
1100     if (ref $el eq "ARRAY") {
1101       my $val = evaluate_rights_ary($el);
1102       $val    = !$val if $negate;
1103       $negate = 0;
1104       if ($action eq '|') {
1105         $value |= $val;
1106       } else {
1107         $value &= $val;
1108       }
1109
1110     } elsif (($el eq '&') || ($el eq '|')) {
1111       $action = $el;
1112
1113     } elsif ($el eq '!') {
1114       $negate = !$negate;
1115
1116     } elsif ($action eq '|') {
1117       my $val = $el;
1118       $val    = !$val if $negate;
1119       $negate = 0;
1120       $value |= $val;
1121
1122     } else {
1123       my $val = $el;
1124       $val    = !$val if $negate;
1125       $negate = 0;
1126       $value &= $val;
1127
1128     }
1129   }
1130
1131   return $value;
1132 }
1133
1134 sub _parse_rights_string {
1135   my $self   = shift;
1136
1137   my $login  = shift;
1138   my $access = shift;
1139
1140   my @stack;
1141   my $cur_ary = [];
1142
1143   push @stack, $cur_ary;
1144
1145   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1146     my $token = $1;
1147     substr($access, 0, length $1) = "";
1148
1149     next if ($token =~ /\s/);
1150
1151     if ($token eq "(") {
1152       my $new_cur_ary = [];
1153       push @stack, $new_cur_ary;
1154       push @{$cur_ary}, $new_cur_ary;
1155       $cur_ary = $new_cur_ary;
1156
1157     } elsif ($token eq ")") {
1158       pop @stack;
1159
1160       if (!@stack) {
1161         return 0;
1162       }
1163
1164       $cur_ary = $stack[-1];
1165
1166     } elsif (($token eq "|") || ($token eq "&")) {
1167       push @{$cur_ary}, $token;
1168
1169     } else {
1170       push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
1171     }
1172   }
1173
1174   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1175
1176   return $result;
1177 }
1178
1179 sub check_right {
1180   my $self    = shift;
1181   my $login   = shift;
1182   my $right   = shift;
1183   my $default = shift;
1184
1185   $self->{FULL_RIGHTS}           ||= { };
1186   $self->{FULL_RIGHTS}->{$login} ||= { };
1187
1188   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1189     $self->{RIGHTS}           ||= { };
1190     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1191
1192     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1193   }
1194
1195   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1196   $granted    = $default if (!defined $granted);
1197
1198   return $granted;
1199 }
1200
1201 sub assert {
1202   my ($self, $right, $dont_abort) = @_;
1203
1204   if ($self->check_right($::myconfig{login}, $right)) {
1205     return 1;
1206   }
1207
1208   if (!$dont_abort) {
1209     delete $::form->{title};
1210     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1211   }
1212
1213   return 0;
1214 }
1215
1216 sub load_rights_for_user {
1217   my ($self, $login) = @_;
1218   my $dbh   = $self->dbconnect;
1219   my ($query, $sth, $row, $rights);
1220
1221   $rights = { map { $_ => 0 } $self->all_rights };
1222
1223   return $rights if !$self->client || !$login;
1224
1225   $query =
1226     qq|SELECT gr."right", gr.granted
1227        FROM auth.group_rights gr
1228        WHERE group_id IN
1229          (SELECT ug.group_id
1230           FROM auth.user_group ug
1231           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1232           WHERE u.login = ?)
1233        AND group_id IN
1234          (SELECT cg.group_id
1235           FROM auth.clients_groups cg
1236           WHERE cg.client_id = ?)|;
1237
1238   $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1239
1240   while ($row = $sth->fetchrow_hashref()) {
1241     $rights->{$row->{right}} |= $row->{granted};
1242   }
1243   $sth->finish();
1244
1245   return $rights;
1246 }
1247
1248 1;
1249 __END__
1250
1251 =pod
1252
1253 =encoding utf8
1254
1255 =head1 NAME
1256
1257 SL::Auth - Authentication and session handling
1258
1259 =head1 METHODS
1260
1261 =over 4
1262
1263 =item C<set_session_value @values>
1264
1265 =item C<set_session_value %values>
1266
1267 Store all values of C<@values> or C<%values> in the session. Each
1268 member of C<@values> is tested if it is a hash reference. If it is
1269 then it must contain the keys C<key> and C<value> and can optionally
1270 contain the key C<auto_restore>. In this case C<value> is associated
1271 with C<key> and restored to C<$::form> upon the next request
1272 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1273 value.
1274
1275 If the current member of C<@values> is not a hash reference then it
1276 will be used as the C<key> and the next entry of C<@values> is used as
1277 the C<value> to store. In this case setting C<auto_restore> is not
1278 possible.
1279
1280 Therefore the following two invocations are identical:
1281
1282   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1283   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1284
1285 All of these values are copied back into C<$::form> for the next
1286 request automatically if they're scalar values or if they have
1287 C<auto_restore> set to trueish.
1288
1289 The values can be any Perl structure. They are stored as YAML dumps.
1290
1291 =item C<get_session_value $key>
1292
1293 Retrieve a value from the session. Returns C<undef> if the value
1294 doesn't exist.
1295
1296 =item C<create_unique_sesion_value $value, %params>
1297
1298 Create a unique key in the session and store C<$value>
1299 there.
1300
1301 Returns the key created in the session.
1302
1303 =item C<save_session>
1304
1305 Stores the session values in the database. This is the only function
1306 that actually stores stuff in the database. Neither the various
1307 setters nor the deleter access the database.
1308
1309 =item C<save_form_in_session %params>
1310
1311 Stores the content of C<$params{form}> (default: C<$::form>) in the
1312 session using L</create_unique_sesion_value>.
1313
1314 If C<$params{non_scalars}> is trueish then non-scalar values will be
1315 stored as well. Default is to only store scalar values.
1316
1317 The following keys will never be saved: C<login>, C<password>,
1318 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1319 can be given as an array ref in C<$params{skip_keys}>.
1320
1321 Returns the unique key under which the form is stored.
1322
1323 =item C<restore_form_from_session $key, %params>
1324
1325 Restores the form from the session into C<$params{form}> (default:
1326 C<$::form>).
1327
1328 If C<$params{clobber}> is falsish then existing values with the same
1329 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1330 is on by default.
1331
1332 Returns C<$self>.
1333
1334 =item C<reset>
1335
1336 C<reset> deletes every state information from previous requests, but does not
1337 close the database connection.
1338
1339 Creating a new database handle on each request can take up to 30% of the
1340 pre-request startup time, so we want to avoid that for fast ajax calls.
1341
1342 =item C<assert, $right, $dont_abort>
1343
1344 Checks if current user has the C<$right>. If C<$dont_abort> is falsish
1345 the request dies with a access denied error, otherwise returns true or false.
1346
1347 =back
1348
1349 =head1 BUGS
1350
1351 Nothing here yet.
1352
1353 =head1 AUTHOR
1354
1355 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1356
1357 =cut