SL/Auth.pm

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