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