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