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     ["admin",                          $locale->text("Administration (Used to access instance administration from user logins)")],
 983     );
 984
 985   return @all_rights;
 986 }
 987
 988 sub all_rights {
 989   return grep !/^--/, map { $_->[0] } all_rights_full();
 990 }
 991
 992 sub read_groups {
 993   $main::lxdebug->enter_sub();
 994
 995   my $self = shift;
 996
 997   my $form   = $main::form;
 998   my $groups = {};
 999   my $dbh    = $self->dbconnect();
1000
1001   my $query  = 'SELECT * FROM auth."group"';
1002   my $sth    = prepare_execute_query($form, $dbh, $query);
1003
1004   my ($row, $group);
1005
1006   while ($row = $sth->fetchrow_hashref()) {
1007     $groups->{$row->{id}} = $row;
1008   }
1009   $sth->finish();
1010
1011   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1012   $sth   = prepare_query($form, $dbh, $query);
1013
1014   foreach $group (values %{$groups}) {
1015     my @members;
1016
1017     do_statement($form, $sth, $query, $group->{id});
1018
1019     while ($row = $sth->fetchrow_hashref()) {
1020       push @members, $row->{user_id};
1021     }
1022     $group->{members} = [ uniq @members ];
1023   }
1024   $sth->finish();
1025
1026   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1027   $sth   = prepare_query($form, $dbh, $query);
1028
1029   foreach $group (values %{$groups}) {
1030     $group->{rights} = {};
1031
1032     do_statement($form, $sth, $query, $group->{id});
1033
1034     while ($row = $sth->fetchrow_hashref()) {
1035       $group->{rights}->{$row->{right}} |= $row->{granted};
1036     }
1037
1038     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1039   }
1040   $sth->finish();
1041
1042   $main::lxdebug->leave_sub();
1043
1044   return $groups;
1045 }
1046
1047 sub save_group {
1048   $main::lxdebug->enter_sub();
1049
1050   my $self  = shift;
1051   my $group = shift;
1052
1053   my $form  = $main::form;
1054   my $dbh   = $self->dbconnect();
1055
1056   $dbh->begin_work;
1057
1058   my ($query, $sth, $row, $rights);
1059
1060   if (!$group->{id}) {
1061     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1062
1063     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1064     do_query($form, $dbh, $query, $group->{id});
1065   }
1066
1067   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1068
1069   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1070
1071   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1072   $sth    = prepare_query($form, $dbh, $query);
1073
1074   foreach my $user_id (uniq @{ $group->{members} }) {
1075     do_statement($form, $sth, $query, $user_id, $group->{id});
1076   }
1077   $sth->finish();
1078
1079   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1080
1081   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1082   $sth   = prepare_query($form, $dbh, $query);
1083
1084   foreach my $right (keys %{ $group->{rights} }) {
1085     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1086   }
1087   $sth->finish();
1088
1089   $dbh->commit();
1090
1091   $main::lxdebug->leave_sub();
1092 }
1093
1094 sub delete_group {
1095   $main::lxdebug->enter_sub();
1096
1097   my $self = shift;
1098   my $id   = shift;
1099
1100   my $form = $main::form;
1101
1102   my $dbh  = $self->dbconnect();
1103   $dbh->begin_work;
1104
1105   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1106   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1107   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1108
1109   $dbh->commit();
1110
1111   $main::lxdebug->leave_sub();
1112 }
1113
1114 sub evaluate_rights_ary {
1115   $main::lxdebug->enter_sub(2);
1116
1117   my $ary    = shift;
1118
1119   my $value  = 0;
1120   my $action = '|';
1121
1122   foreach my $el (@{$ary}) {
1123     if (ref $el eq "ARRAY") {
1124       if ($action eq '|') {
1125         $value |= evaluate_rights_ary($el);
1126       } else {
1127         $value &= evaluate_rights_ary($el);
1128       }
1129
1130     } elsif (($el eq '&') || ($el eq '|')) {
1131       $action = $el;
1132
1133     } elsif ($action eq '|') {
1134       $value |= $el;
1135
1136     } else {
1137       $value &= $el;
1138
1139     }
1140   }
1141
1142   $main::lxdebug->leave_sub(2);
1143
1144   return $value;
1145 }
1146
1147 sub _parse_rights_string {
1148   $main::lxdebug->enter_sub(2);
1149
1150   my $self   = shift;
1151
1152   my $login  = shift;
1153   my $access = shift;
1154
1155   my @stack;
1156   my $cur_ary = [];
1157
1158   push @stack, $cur_ary;
1159
1160   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1161     my $token = $1;
1162     substr($access, 0, length $1) = "";
1163
1164     next if ($token =~ /\s/);
1165
1166     if ($token eq "(") {
1167       my $new_cur_ary = [];
1168       push @stack, $new_cur_ary;
1169       push @{$cur_ary}, $new_cur_ary;
1170       $cur_ary = $new_cur_ary;
1171
1172     } elsif ($token eq ")") {
1173       pop @stack;
1174
1175       if (!@stack) {
1176         $main::lxdebug->leave_sub(2);
1177         return 0;
1178       }
1179
1180       $cur_ary = $stack[-1];
1181
1182     } elsif (($token eq "|") || ($token eq "&")) {
1183       push @{$cur_ary}, $token;
1184
1185     } else {
1186       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1187     }
1188   }
1189
1190   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1191
1192   $main::lxdebug->leave_sub(2);
1193
1194   return $result;
1195 }
1196
1197 sub check_right {
1198   $main::lxdebug->enter_sub(2);
1199
1200   my $self    = shift;
1201   my $login   = shift;
1202   my $right   = shift;
1203   my $default = shift;
1204
1205   $self->{FULL_RIGHTS}           ||= { };
1206   $self->{FULL_RIGHTS}->{$login} ||= { };
1207
1208   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1209     $self->{RIGHTS}           ||= { };
1210     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1211
1212     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1213   }
1214
1215   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1216   $granted    = $default if (!defined $granted);
1217
1218   $main::lxdebug->leave_sub(2);
1219
1220   return $granted;
1221 }
1222
1223 sub assert {
1224   $::lxdebug->enter_sub(2);
1225   my ($self, $right, $dont_abort) = @_;
1226
1227   if ($self->check_right($::myconfig{login}, $right)) {
1228     $::lxdebug->leave_sub(2);
1229     return 1;
1230   }
1231
1232   if (!$dont_abort) {
1233     delete $::form->{title};
1234     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1235   }
1236
1237   $::lxdebug->leave_sub(2);
1238
1239   return 0;
1240 }
1241
1242 sub load_rights_for_user {
1243   $::lxdebug->enter_sub;
1244
1245   my ($self, $login) = @_;
1246   my $dbh   = $self->dbconnect;
1247   my ($query, $sth, $row, $rights);
1248
1249   $rights = { map { $_ => 0 } all_rights() };
1250
1251   $query =
1252     qq|SELECT gr."right", gr.granted
1253        FROM auth.group_rights gr
1254        WHERE group_id IN
1255          (SELECT ug.group_id
1256           FROM auth.user_group ug
1257           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1258           WHERE u.login = ?)|;
1259
1260   $sth = prepare_execute_query($::form, $dbh, $query, $login);
1261
1262   while ($row = $sth->fetchrow_hashref()) {
1263     $rights->{$row->{right}} |= $row->{granted};
1264   }
1265   $sth->finish();
1266
1267   $::lxdebug->leave_sub;
1268
1269   return $rights;
1270 }
1271
1272 1;
1273 __END__
1274
1275 =pod
1276
1277 =encoding utf8
1278
1279 =head1 NAME
1280
1281 SL::Auth - Authentication and session handling
1282
1283 =head1 FUNCTIONS
1284
1285 =over 4
1286
1287 =item C<set_session_value @values>
1288 =item C<set_session_value %values>
1289
1290 Store all values of C<@values> or C<%values> in the session. Each
1291 member of C<@values> is tested if it is a hash reference. If it is
1292 then it must contain the keys C<key> and C<value> and can optionally
1293 contain the key C<auto_restore>. In this case C<value> is associated
1294 with C<key> and restored to C<$::form> upon the next request
1295 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1296 value.
1297
1298 If the current member of C<@values> is not a hash reference then it
1299 will be used as the C<key> and the next entry of C<@values> is used as
1300 the C<value> to store. In this case setting C<auto_restore> is not
1301 possible.
1302
1303 Therefore the following two invocations are identical:
1304
1305   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1306   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1307
1308 All of these values are copied back into C<$::form> for the next
1309 request automatically if they're scalar values or if they have
1310 C<auto_restore> set to trueish.
1311
1312 The values can be any Perl structure. They are stored as YAML dumps.
1313
1314 =item C<get_session_value $key>
1315
1316 Retrieve a value from the session. Returns C<undef> if the value
1317 doesn't exist.
1318
1319 =item C<create_unique_sesion_value $value, %params>
1320
1321 Create a unique key in the session and store C<$value>
1322 there.
1323
1324 Returns the key created in the session.
1325
1326 =item C<save_session>
1327
1328 Stores the session values in the database. This is the only function
1329 that actually stores stuff in the database. Neither the various
1330 setters nor the deleter access the database.
1331
1332 =item <save_form_in_session %params>
1333
1334 Stores the content of C<$params{form}> (default: C<$::form>) in the
1335 session using L</create_unique_sesion_value>.
1336
1337 If C<$params{non_scalars}> is trueish then non-scalar values will be
1338 stored as well. Default is to only store scalar values.
1339
1340 The following keys will never be saved: C<login>, C<password>,
1341 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1342 can be given as an array ref in C<$params{skip_keys}>.
1343
1344 Returns the unique key under which the form is stored.
1345
1346 =item <restore_form_from_session $key, %params>
1347
1348 Restores the form from the session into C<$params{form}> (default:
1349 C<$::form>).
1350
1351 If C<$params{clobber}> is falsish then existing values with the same
1352 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1353 is on by default.
1354
1355 Returns C<$self>.
1356
1357 =back
1358
1359 =head1 BUGS
1360
1361 Nothing here yet.
1362
1363 =head1 AUTHOR
1364
1365 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1366
1367 =cut