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);
  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   $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
  63   $self->{column_information}->_fetch;
  64   $self->{authenticator}->reset;
  65
  66   $self->client(undef);
  67 }
  68
  69 sub set_client {
  70   my ($self, $id_or_name) = @_;
  71
  72   $self->client(undef);
  73
  74   return undef unless $id_or_name;
  75
  76   my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
  77   my $dbh    = $self->dbconnect;
  78
  79   return undef unless $dbh;
  80
  81   $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
  82
  83   return $self->client;
  84 }
  85
  86 sub DESTROY {
  87   my $self = shift;
  88
  89   $self->{dbh}->disconnect() if ($self->{dbh});
  90 }
  91
  92 # form isn't loaded yet, so auth needs it's own error.
  93 sub mini_error {
  94   $::lxdebug->show_backtrace();
  95
  96   my ($self, @msg) = @_;
  97   if ($ENV{HTTP_USER_AGENT}) {
  98     print Form->create_http_response(content_type => 'text/html');
  99     print "<pre>", join ('<br>', @msg), "</pre>";
 100   } else {
 101     print STDERR "Error: @msg\n";
 102   }
 103   $::dispatcher->end_request;
 104 }
 105
 106 sub _read_auth_config {
 107   my ($self, %params) = @_;
 108
 109   map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
 110
 111   # Prevent password leakage to log files when dumping Auth instances.
 112   $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
 113
 114   if ($params{unit_tests_database}) {
 115     $self->{DB_config}   = $::lx_office_conf{'testing/database'};
 116     $self->{module}      = 'DB';
 117
 118   } else {
 119     $self->{DB_config}   = $::lx_office_conf{'authentication/database'};
 120     $self->{LDAP_config} = $::lx_office_conf{'authentication/ldap'};
 121   }
 122
 123   if ($self->{module} eq 'DB') {
 124     $self->{authenticator} = SL::Auth::DB->new($self);
 125
 126   } elsif ($self->{module} eq 'LDAP') {
 127     $self->{authenticator} = SL::Auth::LDAP->new($self);
 128   }
 129
 130   if (!$self->{authenticator}) {
 131     my $locale = Locale->new('en');
 132     $self->mini_error($locale->text('No or an unknown authenticantion module specified in "config/kivitendo.conf".'));
 133   }
 134
 135   my $cfg = $self->{DB_config};
 136
 137   if (!$cfg) {
 138     my $locale = Locale->new('en');
 139     $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
 140   }
 141
 142   if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
 143     my $locale = Locale->new('en');
 144     $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
 145   }
 146
 147   $self->{authenticator}->verify_config();
 148
 149   $self->{session_timeout} *= 1;
 150   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
 151 }
 152
 153 sub has_access_to_client {
 154   my ($self, $login) = @_;
 155
 156   return 0 if !$self->client || !$self->client->{id};
 157
 158   my $sql = <<SQL;
 159     SELECT cu.client_id
 160     FROM auth.clients_users cu
 161     LEFT JOIN auth."user" u ON (cu.user_id = u.id)
 162     WHERE (u.login      = ?)
 163       AND (cu.client_id = ?)
 164 SQL
 165
 166   my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
 167   return $has_access;
 168 }
 169
 170 sub authenticate_root {
 171   my ($self, $password) = @_;
 172
 173   my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
 174   if (defined $session_root_auth && $session_root_auth == OK) {
 175     return OK;
 176   }
 177
 178   if (!defined $password) {
 179     return ERR_PASSWORD;
 180   }
 181
 182   my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
 183   $password             = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
 184
 185   my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
 186   $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
 187
 188   return $result;
 189 }
 190
 191 sub authenticate {
 192   my ($self, $login, $password) = @_;
 193
 194   if (!$self->client || !$self->has_access_to_client($login)) {
 195     return ERR_PASSWORD;
 196   }
 197
 198   my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
 199   if (defined $session_auth && $session_auth == OK) {
 200     return OK;
 201   }
 202
 203   if (!defined $password) {
 204     return ERR_PASSWORD;
 205   }
 206
 207   my $result = $login ? $self->{authenticator}->authenticate($login, $password) : ERR_USER;
 208   $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
 209   return $result;
 210 }
 211
 212 sub punish_wrong_login {
 213   my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
 214   sleep $failed_login_penalty if $failed_login_penalty;
 215 }
 216
 217 sub get_stored_password {
 218   my ($self, $login) = @_;
 219
 220   my $dbh            = $self->dbconnect;
 221
 222   return undef unless $dbh;
 223
 224   my $query             = qq|SELECT password FROM auth."user" WHERE login = ?|;
 225   my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
 226
 227   return $stored_password;
 228 }
 229
 230 sub dbconnect {
 231   my $self     = shift;
 232   my $may_fail = shift;
 233
 234   if ($self->{dbh}) {
 235     return $self->{dbh};
 236   }
 237
 238   my $cfg = $self->{DB_config};
 239   my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
 240
 241   if ($cfg->{port}) {
 242     $dsn .= ';port=' . $cfg->{port};
 243   }
 244
 245   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 246
 247   $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
 248
 249   if (!$may_fail && !$self->{dbh}) {
 250     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
 251   }
 252
 253   return $self->{dbh};
 254 }
 255
 256 sub dbdisconnect {
 257   my $self = shift;
 258
 259   if ($self->{dbh}) {
 260     $self->{dbh}->disconnect();
 261     delete $self->{dbh};
 262   }
 263 }
 264
 265 sub check_tables {
 266   my ($self, $dbh)    = @_;
 267
 268   $dbh   ||= $self->dbconnect();
 269   my $query   = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
 270
 271   my ($count) = $dbh->selectrow_array($query);
 272
 273   return $count > 0;
 274 }
 275
 276 sub check_database {
 277   my $self = shift;
 278
 279   my $dbh  = $self->dbconnect(1);
 280
 281   return $dbh ? 1 : 0;
 282 }
 283
 284 sub create_database {
 285   my $self   = shift;
 286   my %params = @_;
 287
 288   my $cfg    = $self->{DB_config};
 289
 290   if (!$params{superuser}) {
 291     $params{superuser}          = $cfg->{user};
 292     $params{superuser_password} = $cfg->{password};
 293   }
 294
 295   $params{template} ||= 'template0';
 296   $params{template}   =~ s|[^a-zA-Z0-9_\-]||g;
 297
 298   my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
 299
 300   if ($cfg->{port}) {
 301     $dsn .= ';port=' . $cfg->{port};
 302   }
 303
 304   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
 305
 306   my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
 307
 308   if (!$dbh) {
 309     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
 310   }
 311
 312   my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
 313
 314   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
 315
 316   $dbh->do($query);
 317
 318   if ($dbh->err) {
 319     my $error = $dbh->errstr();
 320
 321     $query                 = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 322     my ($cluster_encoding) = $dbh->selectrow_array($query);
 323
 324     if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
 325       $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
 326     }
 327
 328     $dbh->disconnect();
 329
 330     $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
 331   }
 332
 333   $dbh->disconnect();
 334 }
 335
 336 sub create_tables {
 337   my $self = shift;
 338   my $dbh  = $self->dbconnect();
 339
 340   $dbh->rollback();
 341   SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
 342 }
 343
 344 sub save_user {
 345   my $self   = shift;
 346   my $login  = shift;
 347   my %params = @_;
 348
 349   my $form   = $main::form;
 350
 351   my $dbh    = $self->dbconnect();
 352
 353   my ($sth, $query, $user_id);
 354
 355   $dbh->begin_work;
 356
 357   $query     = qq|SELECT id FROM auth."user" WHERE login = ?|;
 358   ($user_id) = selectrow_query($form, $dbh, $query, $login);
 359
 360   if (!$user_id) {
 361     $query     = qq|SELECT nextval('auth.user_id_seq')|;
 362     ($user_id) = selectrow_query($form, $dbh, $query);
 363
 364     $query     = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
 365     do_query($form, $dbh, $query, $user_id, $login);
 366   }
 367
 368   $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
 369   do_query($form, $dbh, $query, $user_id);
 370
 371   $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
 372   $sth   = prepare_query($form, $dbh, $query);
 373
 374   while (my ($cfg_key, $cfg_value) = each %params) {
 375     next if ($cfg_key eq 'password');
 376
 377     do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
 378   }
 379
 380   $dbh->commit();
 381 }
 382
 383 sub can_change_password {
 384   my $self = shift;
 385
 386   return $self->{authenticator}->can_change_password();
 387 }
 388
 389 sub change_password {
 390   my ($self, $login, $new_password) = @_;
 391
 392   my $result = $self->{authenticator}->change_password($login, $new_password);
 393
 394   return $result;
 395 }
 396
 397 sub read_all_users {
 398   my $self  = shift;
 399
 400   my $dbh   = $self->dbconnect();
 401   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
 402
 403                  FROM auth."user" AS  u
 404
 405                  LEFT JOIN auth.user_config AS cfg
 406                    ON (cfg.user_id = u.id)
 407
 408                  LEFT JOIN auth.session_content AS sc_login
 409                    ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
 410
 411                  LEFT JOIN auth.session AS s
 412                    ON (s.id = sc_login.session_id)
 413               |;
 414   my $sth   = prepare_execute_query($main::form, $dbh, $query);
 415
 416   my %users;
 417
 418   while (my $ref = $sth->fetchrow_hashref()) {
 419
 420     $users{$ref->{login}}                    ||= {
 421                                                 'login' => $ref->{login},
 422                                                 'id' => $ref->{id},
 423                                                 'last_action' => $ref->{last_action},
 424                                              };
 425     $users{$ref->{login}}->{$ref->{cfg_key}}   = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
 426   }
 427
 428   $sth->finish();
 429
 430   return %users;
 431 }
 432
 433 sub read_user {
 434   my ($self, %params) = @_;
 435
 436   my $dbh   = $self->dbconnect();
 437
 438   my (@where, @values);
 439   if ($params{login}) {
 440     push @where,  'u.login = ?';
 441     push @values, $params{login};
 442   }
 443   if ($params{id}) {
 444     push @where,  'u.id = ?';
 445     push @values, $params{id};
 446   }
 447   my $where = join ' AND ', '1 = 1', @where;
 448   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
 449                  FROM auth.user_config cfg
 450                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
 451                  WHERE $where|;
 452   my $sth   = prepare_execute_query($main::form, $dbh, $query, @values);
 453
 454   my %user_data;
 455
 456   while (my $ref = $sth->fetchrow_hashref()) {
 457     $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
 458     @user_data{qw(id login)}    = @{$ref}{qw(id login)};
 459   }
 460
 461   # The XUL/XML & 'CSS new' backed menus have been removed.
 462   my %menustyle_map = ( xml => 'new', v4 => 'v3' );
 463   $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
 464
 465   # The 'Win2000.css' stylesheet has been removed.
 466   $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
 467
 468   # Set default language if selected language does not exist (anymore).
 469   $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
 470
 471   $sth->finish();
 472
 473   return %user_data;
 474 }
 475
 476 sub get_user_id {
 477   my $self  = shift;
 478   my $login = shift;
 479
 480   my $dbh   = $self->dbconnect();
 481   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
 482
 483   return $id;
 484 }
 485
 486 sub delete_user {
 487   my $self  = shift;
 488   my $login = shift;
 489
 490   my $dbh   = $self->dbconnect;
 491   my $id    = $self->get_user_id($login);
 492
 493   if (!$id) {
 494     $dbh->rollback;
 495     return;
 496   }
 497
 498   $dbh->begin_work;
 499
 500   do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
 501   do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
 502   do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
 503
 504   # TODO: SL::Auth::delete_user
 505   # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
 506
 507   $dbh->commit;
 508 }
 509
 510 # --------------------------------------
 511
 512 my $session_id;
 513
 514 sub restore_session {
 515   my $self = shift;
 516
 517   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
 518   $session_id        =~ s|[^0-9a-f]||g if $session_id;
 519
 520   $self->{SESSION}   = { };
 521
 522   if (!$session_id) {
 523     return $self->session_restore_result(SESSION_NONE());
 524   }
 525
 526   my ($dbh, $query, $sth, $cookie, $ref, $form);
 527
 528   $form   = $main::form;
 529
 530   # Don't fail if the auth DB doesn't exist yet.
 531   if (!( $dbh = $self->dbconnect(1) )) {
 532     return $self->session_restore_result(SESSION_NONE());
 533   }
 534
 535   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
 536   # admin is creating the session tables at the moment.
 537   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
 538
 539   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
 540     $sth->finish if $sth;
 541     return $self->session_restore_result(SESSION_NONE());
 542   }
 543
 544   $cookie = $sth->fetchrow_hashref;
 545   $sth->finish;
 546
 547   # The session ID provided is valid in the following cases:
 548   #  1. session ID exists in the database
 549   #  2. hasn't expired yet
 550   #  3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
 551   #  4. if cookie for the API token is NOT given then: the requestee's IP address must match the stored IP address
 552   $self->{api_token}   = $cookie->{api_token} if $cookie;
 553   my $api_token_cookie = $self->get_api_token_cookie;
 554   my $cookie_is_bad    = !$cookie || $cookie->{is_expired};
 555   $cookie_is_bad     ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if  $api_token_cookie;
 556   $cookie_is_bad     ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR}                       if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/;
 557   if ($cookie_is_bad) {
 558     $self->destroy_session();
 559     return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
 560   }
 561
 562   if ($self->{column_information}->has('auto_restore')) {
 563     $self->_load_with_auto_restore_column($dbh, $session_id);
 564   } else {
 565     $self->_load_without_auto_restore_column($dbh, $session_id);
 566   }
 567
 568   return $self->session_restore_result(SESSION_OK());
 569 }
 570
 571 sub session_restore_result {
 572   my $self = shift;
 573   if (@_) {
 574     $self->{session_restore_result} = $_[0];
 575   }
 576   return $self->{session_restore_result};
 577 }
 578
 579 sub _load_without_auto_restore_column {
 580   my ($self, $dbh, $session_id) = @_;
 581
 582   my $query = <<SQL;
 583     SELECT sess_key, sess_value
 584     FROM auth.session_content
 585     WHERE (session_id = ?)
 586 SQL
 587   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 588
 589   while (my $ref = $sth->fetchrow_hashref) {
 590     my $value = SL::Auth::SessionValue->new(auth  => $self,
 591                                             key   => $ref->{sess_key},
 592                                             value => $ref->{sess_value},
 593                                             raw   => 1);
 594     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 595
 596     next if defined $::form->{$ref->{sess_key}};
 597
 598     my $data                    = $value->get;
 599     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 600   }
 601 }
 602
 603 sub _load_with_auto_restore_column {
 604   my ($self, $dbh, $session_id) = @_;
 605
 606   my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
 607
 608   my $query = <<SQL;
 609     SELECT sess_key, sess_value, auto_restore
 610     FROM auth.session_content
 611     WHERE (session_id = ?)
 612 SQL
 613   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 614
 615   while (my $ref = $sth->fetchrow_hashref) {
 616     if ($ref->{auto_restore} || $auto_restore_keys{$ref->{sess_key}}) {
 617       my $value = SL::Auth::SessionValue->new(auth         => $self,
 618                                               key          => $ref->{sess_key},
 619                                               value        => $ref->{sess_value},
 620                                               auto_restore => $ref->{auto_restore},
 621                                               raw          => 1);
 622       $self->{SESSION}->{ $ref->{sess_key} } = $value;
 623
 624       next if defined $::form->{$ref->{sess_key}};
 625
 626       my $data                    = $value->get;
 627       $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 628     } else {
 629       my $value = SL::Auth::SessionValue->new(auth => $self,
 630                                               key  => $ref->{sess_key});
 631       $self->{SESSION}->{ $ref->{sess_key} } = $value;
 632     }
 633   }
 634
 635   $sth->finish;
 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     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 position");
 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