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