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 => $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 $dbh   = $self->dbconnect();
 441
 442   $dbh->begin_work;
 443
 444   my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
 445
 446   my ($id)  = selectrow_query($form, $dbh, $query, $login);
 447
 448   $dbh->rollback and return $main::lxdebug->leave_sub() if (!$id);
 449
 450   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
 451   do_query($form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
 452
 453   $dbh->commit();
 454
 455   $main::lxdebug->leave_sub();
 456 }
 457
 458 # --------------------------------------
 459
 460 my $session_id;
 461
 462 sub restore_session {
 463   $main::lxdebug->enter_sub();
 464
 465   my $self = shift;
 466
 467   my $cgi            =  $main::cgi;
 468   $cgi             ||=  CGI->new('');
 469
 470   $session_id        =  $cgi->cookie($self->get_session_cookie_name());
 471   $session_id        =~ s|[^0-9a-f]||g;
 472
 473   $self->{SESSION}   = { };
 474
 475   if (!$session_id) {
 476     $main::lxdebug->leave_sub();
 477     return SESSION_NONE;
 478   }
 479
 480   my ($dbh, $query, $sth, $cookie, $ref, $form);
 481
 482   $form   = $main::form;
 483
 484   $dbh    = $self->dbconnect();
 485   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
 486
 487   $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
 488
 489   if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
 490     $self->destroy_session();
 491     $main::lxdebug->leave_sub();
 492     return $cookie ? SESSION_EXPIRED : SESSION_NONE;
 493   }
 494
 495   $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
 496   $sth   = prepare_execute_query($form, $dbh, $query, $session_id);
 497
 498   while (my $ref = $sth->fetchrow_hashref()) {
 499     $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
 500     next if defined $form->{$ref->{sess_key}};
 501
 502     my $params                = $self->_load_value($ref->{sess_value});
 503     $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};
 504   }
 505
 506   $sth->finish();
 507
 508   $main::lxdebug->leave_sub();
 509
 510   return SESSION_OK;
 511 }
 512
 513 sub _load_value {
 514   my ($self, $value) = @_;
 515
 516   return { simple => 1, data => $value } if $value !~ m/^---/;
 517
 518   my %params = ( simple => 1 );
 519   eval {
 520     my $data = YAML::Load($value);
 521
 522     if (ref $data eq 'HASH') {
 523       map { $params{$_} = $data->{$_} } keys %{ $data };
 524       $params{simple} = 0;
 525
 526     } else {
 527       $params{data}   = $data;
 528     }
 529
 530     1;
 531   } or $params{data} = $value;
 532
 533   return \%params;
 534 }
 535
 536 sub destroy_session {
 537   $main::lxdebug->enter_sub();
 538
 539   my $self = shift;
 540
 541   if ($session_id) {
 542     my $dbh = $self->dbconnect();
 543
 544     $dbh->begin_work;
 545
 546     do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
 547     do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
 548
 549     $dbh->commit();
 550
 551     $session_id      = undef;
 552     $self->{SESSION} = { };
 553   }
 554
 555   $main::lxdebug->leave_sub();
 556 }
 557
 558 sub expire_sessions {
 559   $main::lxdebug->enter_sub();
 560
 561   my $self  = shift;
 562
 563   my $dbh   = $self->dbconnect();
 564
 565   $dbh->begin_work;
 566
 567   my $query =
 568     qq|DELETE FROM auth.session_content
 569        WHERE session_id IN
 570          (SELECT id
 571           FROM auth.session
 572           WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
 573
 574   do_query($main::form, $dbh, $query);
 575
 576   $query =
 577     qq|DELETE FROM auth.session
 578        WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
 579
 580   do_query($main::form, $dbh, $query);
 581
 582   $dbh->commit();
 583
 584   $main::lxdebug->leave_sub();
 585 }
 586
 587 sub _create_session_id {
 588   $main::lxdebug->enter_sub();
 589
 590   my @data;
 591   map { push @data, int(rand() * 255); } (1..32);
 592
 593   my $id = md5_hex(pack 'C*', @data);
 594
 595   $main::lxdebug->leave_sub();
 596
 597   return $id;
 598 }
 599
 600 sub create_or_refresh_session {
 601   $main::lxdebug->enter_sub();
 602
 603   my $self = shift;
 604
 605   $session_id ||= $self->_create_session_id();
 606
 607   my ($form, $dbh, $query, $sth, $id);
 608
 609   $form  = $main::form;
 610   $dbh   = $self->dbconnect();
 611
 612   $dbh->begin_work;
 613   do_query($::form, $dbh, qq|LOCK auth.session_content|);
 614
 615   $query = qq|SELECT id FROM auth.session WHERE id = ?|;
 616
 617   ($id)  = selectrow_query($form, $dbh, $query, $session_id);
 618
 619   if ($id) {
 620     do_query($form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
 621
 622   } else {
 623     do_query($form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
 624
 625   }
 626
 627   $self->save_session($dbh);
 628
 629   $dbh->commit();
 630
 631   $main::lxdebug->leave_sub();
 632 }
 633
 634 sub save_session {
 635   my $self         = shift;
 636   my $provided_dbh = shift;
 637
 638   my $dbh          = $provided_dbh || $self->dbconnect(1);
 639
 640   return unless $dbh;
 641
 642   $dbh->begin_work unless $provided_dbh;
 643
 644   do_query($::form, $dbh, qq|LOCK auth.session_content|);
 645   do_query($::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
 646
 647   if (%{ $self->{SESSION} }) {
 648     my $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
 649     my $sth   = prepare_query($::form, $dbh, $query);
 650
 651     foreach my $key (sort keys %{ $self->{SESSION} }) {
 652       do_statement($::form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
 653     }
 654
 655     $sth->finish();
 656   }
 657
 658   $dbh->commit() unless $provided_dbh;
 659 }
 660
 661 sub set_session_value {
 662   $main::lxdebug->enter_sub();
 663
 664   my $self   = shift;
 665   my %params = @_;
 666
 667   $self->{SESSION} ||= { };
 668
 669   while (my ($key, $value) = each %params) {
 670     $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);
 671   }
 672
 673   $main::lxdebug->leave_sub();
 674
 675   return $self;
 676 }
 677
 678 sub delete_session_value {
 679   $main::lxdebug->enter_sub();
 680
 681   my $self = shift;
 682
 683   $self->{SESSION} ||= { };
 684   delete @{ $self->{SESSION} }{ @_ };
 685
 686   $main::lxdebug->leave_sub();
 687
 688   return $self;
 689 }
 690
 691 sub get_session_value {
 692   $main::lxdebug->enter_sub();
 693
 694   my $self   = shift;
 695   my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};
 696
 697   $main::lxdebug->leave_sub();
 698
 699   return $params->{data};
 700 }
 701
 702 sub create_unique_sesion_value {
 703   my ($self, $value, %params) = @_;
 704
 705   $self->{SESSION} ||= { };
 706
 707   my @now                   = gettimeofday();
 708   my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
 709   $self->{unique_counter} ||= 0;
 710
 711   $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};
 712   $self->{unique_counter}++;
 713
 714   $value  = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,
 715               no_auto    => !$params{auto_restore},
 716               data       => $value,
 717             };
 718
 719   $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);
 720
 721   return $key . $self->{unique_counter};
 722 }
 723
 724 sub save_form_in_session {
 725   my ($self, %params) = @_;
 726
 727   my $form        = delete($params{form}) || $::form;
 728   my $non_scalars = delete $params{non_scalars};
 729   my $data        = {};
 730
 731   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
 732
 733   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
 734     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
 735   }
 736
 737   return $self->create_unique_sesion_value($data, %params);
 738 }
 739
 740 sub restore_form_from_session {
 741   my ($self, $key, %params) = @_;
 742
 743   my $data = $self->get_session_value($key);
 744   return $self unless $data;
 745
 746   my $form    = delete($params{form}) || $::form;
 747   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
 748
 749   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
 750
 751   return $self;
 752 }
 753
 754 sub expire_session_keys {
 755   my ($self) = @_;
 756
 757   $self->{SESSION} ||= { };
 758
 759   my @now = gettimeofday();
 760   my $now = $now[0] * 1000000 + $now[1];
 761
 762   $self->delete_session_value(map  { $_->[0]                                                 }
 763                               grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }
 764                               map  { [ $_, $self->_load_value($self->{SESSION}->{$_}) ]      }
 765                               keys %{ $self->{SESSION} });
 766
 767   return $self;
 768 }
 769
 770 sub _has_expiration {
 771   my ($value) = @_;
 772   return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};
 773 }
 774
 775 sub set_cookie_environment_variable {
 776   my $self = shift;
 777   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
 778 }
 779
 780 sub get_session_cookie_name {
 781   my $self = shift;
 782
 783   return $self->{cookie_name} || 'lx_office_erp_session_id';
 784 }
 785
 786 sub get_session_id {
 787   return $session_id;
 788 }
 789
 790 sub session_tables_present {
 791   $main::lxdebug->enter_sub();
 792
 793   my $self = shift;
 794   my $dbh  = $self->dbconnect(1);
 795
 796   if (!$dbh) {
 797     $main::lxdebug->leave_sub();
 798     return 0;
 799   }
 800
 801   my $query =
 802     qq|SELECT COUNT(*)
 803        FROM pg_tables
 804        WHERE (schemaname = 'auth')
 805          AND (tablename IN ('session', 'session_content'))|;
 806
 807   my ($count) = selectrow_query($main::form, $dbh, $query);
 808
 809   $main::lxdebug->leave_sub();
 810
 811   return 2 == $count;
 812 }
 813
 814 # --------------------------------------
 815
 816 sub all_rights_full {
 817   my $locale = $main::locale;
 818
 819   my @all_rights = (
 820     ["--crm",                          $locale->text("CRM optional software")],
 821     ["crm_search",                     $locale->text("CRM search")],
 822     ["crm_new",                        $locale->text("CRM create customers, vendors and contacts")],
 823     ["crm_service",                    $locale->text("CRM services")],
 824     ["crm_admin",                      $locale->text("CRM admin")],
 825     ["crm_adminuser",                  $locale->text("CRM user")],
 826     ["crm_adminstatus",                $locale->text("CRM status")],
 827     ["crm_email",                      $locale->text("CRM send email")],
 828     ["crm_termin",                     $locale->text("CRM termin")],
 829     ["crm_opportunity",                $locale->text("CRM opportunity")],
 830     ["crm_knowhow",                    $locale->text("CRM know how")],
 831     ["crm_follow",                     $locale->text("CRM follow up")],
 832     ["crm_notices",                    $locale->text("CRM notices")],
 833     ["crm_other",                      $locale->text("CRM other")],
 834     ["--master_data",                  $locale->text("Master Data")],
 835     ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
 836     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
 837     ["project_edit",                   $locale->text("Create and edit projects")],
 838     ["license_edit",                   $locale->text("Manage license keys")],
 839     ["--ar",                           $locale->text("AR")],
 840     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
 841     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
 842     ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
 843     ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
 844     ["dunning_edit",                   $locale->text("Create and edit dunnings")],
 845     ["sales_all_edit",                 $locale->text("View/edit all employees sales documents")],
 846     ["--ap",                           $locale->text("AP")],
 847     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
 848     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
 849     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
 850     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
 851     ["--warehouse_management",         $locale->text("Warehouse management")],
 852     ["warehouse_contents",             $locale->text("View warehouse content")],
 853     ["warehouse_management",           $locale->text("Warehouse management")],
 854     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
 855     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
 856     ["datev_export",                   $locale->text("DATEV Export")],
 857     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
 858     ["--reports",                      $locale->text('Reports')],
 859     ["report",                         $locale->text('All reports')],
 860     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
 861     ["--batch_printing",               $locale->text("Batch Printing")],
 862     ["batch_printing",                 $locale->text("Batch Printing")],
 863     ["--others",                       $locale->text("Others")],
 864     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
 865     ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
 866     );
 867
 868   return @all_rights;
 869 }
 870
 871 sub all_rights {
 872   return grep !/^--/, map { $_->[0] } all_rights_full();
 873 }
 874
 875 sub read_groups {
 876   $main::lxdebug->enter_sub();
 877
 878   my $self = shift;
 879
 880   my $form   = $main::form;
 881   my $groups = {};
 882   my $dbh    = $self->dbconnect();
 883
 884   my $query  = 'SELECT * FROM auth."group"';
 885   my $sth    = prepare_execute_query($form, $dbh, $query);
 886
 887   my ($row, $group);
 888
 889   while ($row = $sth->fetchrow_hashref()) {
 890     $groups->{$row->{id}} = $row;
 891   }
 892   $sth->finish();
 893
 894   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
 895   $sth   = prepare_query($form, $dbh, $query);
 896
 897   foreach $group (values %{$groups}) {
 898     my @members;
 899
 900     do_statement($form, $sth, $query, $group->{id});
 901
 902     while ($row = $sth->fetchrow_hashref()) {
 903       push @members, $row->{user_id};
 904     }
 905     $group->{members} = [ uniq @members ];
 906   }
 907   $sth->finish();
 908
 909   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
 910   $sth   = prepare_query($form, $dbh, $query);
 911
 912   foreach $group (values %{$groups}) {
 913     $group->{rights} = {};
 914
 915     do_statement($form, $sth, $query, $group->{id});
 916
 917     while ($row = $sth->fetchrow_hashref()) {
 918       $group->{rights}->{$row->{right}} |= $row->{granted};
 919     }
 920
 921     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
 922   }
 923   $sth->finish();
 924
 925   $main::lxdebug->leave_sub();
 926
 927   return $groups;
 928 }
 929
 930 sub save_group {
 931   $main::lxdebug->enter_sub();
 932
 933   my $self  = shift;
 934   my $group = shift;
 935
 936   my $form  = $main::form;
 937   my $dbh   = $self->dbconnect();
 938
 939   $dbh->begin_work;
 940
 941   my ($query, $sth, $row, $rights);
 942
 943   if (!$group->{id}) {
 944     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
 945
 946     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
 947     do_query($form, $dbh, $query, $group->{id});
 948   }
 949
 950   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
 951
 952   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
 953
 954   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
 955   $sth    = prepare_query($form, $dbh, $query);
 956
 957   foreach my $user_id (uniq @{ $group->{members} }) {
 958     do_statement($form, $sth, $query, $user_id, $group->{id});
 959   }
 960   $sth->finish();
 961
 962   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
 963
 964   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
 965   $sth   = prepare_query($form, $dbh, $query);
 966
 967   foreach my $right (keys %{ $group->{rights} }) {
 968     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
 969   }
 970   $sth->finish();
 971
 972   $dbh->commit();
 973
 974   $main::lxdebug->leave_sub();
 975 }
 976
 977 sub delete_group {
 978   $main::lxdebug->enter_sub();
 979
 980   my $self = shift;
 981   my $id   = shift;
 982
 983   my $form = $main::form;
 984
 985   my $dbh  = $self->dbconnect();
 986   $dbh->begin_work;
 987
 988   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
 989   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
 990   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
 991
 992   $dbh->commit();
 993
 994   $main::lxdebug->leave_sub();
 995 }
 996
 997 sub evaluate_rights_ary {
 998   $main::lxdebug->enter_sub(2);
 999
1000   my $ary    = shift;
1001
1002   my $value  = 0;
1003   my $action = '|';
1004
1005   foreach my $el (@{$ary}) {
1006     if (ref $el eq "ARRAY") {
1007       if ($action eq '|') {
1008         $value |= evaluate_rights_ary($el);
1009       } else {
1010         $value &= evaluate_rights_ary($el);
1011       }
1012
1013     } elsif (($el eq '&') || ($el eq '|')) {
1014       $action = $el;
1015
1016     } elsif ($action eq '|') {
1017       $value |= $el;
1018
1019     } else {
1020       $value &= $el;
1021
1022     }
1023   }
1024
1025   $main::lxdebug->leave_sub(2);
1026
1027   return $value;
1028 }
1029
1030 sub _parse_rights_string {
1031   $main::lxdebug->enter_sub(2);
1032
1033   my $self   = shift;
1034
1035   my $login  = shift;
1036   my $access = shift;
1037
1038   my @stack;
1039   my $cur_ary = [];
1040
1041   push @stack, $cur_ary;
1042
1043   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1044     my $token = $1;
1045     substr($access, 0, length $1) = "";
1046
1047     next if ($token =~ /\s/);
1048
1049     if ($token eq "(") {
1050       my $new_cur_ary = [];
1051       push @stack, $new_cur_ary;
1052       push @{$cur_ary}, $new_cur_ary;
1053       $cur_ary = $new_cur_ary;
1054
1055     } elsif ($token eq ")") {
1056       pop @stack;
1057
1058       if (!@stack) {
1059         $main::lxdebug->leave_sub(2);
1060         return 0;
1061       }
1062
1063       $cur_ary = $stack[-1];
1064
1065     } elsif (($token eq "|") || ($token eq "&")) {
1066       push @{$cur_ary}, $token;
1067
1068     } else {
1069       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1070     }
1071   }
1072
1073   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1074
1075   $main::lxdebug->leave_sub(2);
1076
1077   return $result;
1078 }
1079
1080 sub check_right {
1081   $main::lxdebug->enter_sub(2);
1082
1083   my $self    = shift;
1084   my $login   = shift;
1085   my $right   = shift;
1086   my $default = shift;
1087
1088   $self->{FULL_RIGHTS}           ||= { };
1089   $self->{FULL_RIGHTS}->{$login} ||= { };
1090
1091   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1092     $self->{RIGHTS}           ||= { };
1093     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1094
1095     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1096   }
1097
1098   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1099   $granted    = $default if (!defined $granted);
1100
1101   $main::lxdebug->leave_sub(2);
1102
1103   return $granted;
1104 }
1105
1106 sub assert {
1107   $main::lxdebug->enter_sub(2);
1108
1109   my $self       = shift;
1110   my $right      = shift;
1111   my $dont_abort = shift;
1112
1113   my $form       = $main::form;
1114
1115   if ($self->check_right($form->{login}, $right)) {
1116     $main::lxdebug->leave_sub(2);
1117     return 1;
1118   }
1119
1120   if (!$dont_abort) {
1121     delete $form->{title};
1122     $form->show_generic_error($main::locale->text("You do not have the permissions to access this function."));
1123   }
1124
1125   $main::lxdebug->leave_sub(2);
1126
1127   return 0;
1128 }
1129
1130 sub load_rights_for_user {
1131   $main::lxdebug->enter_sub();
1132
1133   my $self  = shift;
1134   my $login = shift;
1135
1136   my $form  = $main::form;
1137   my $dbh   = $self->dbconnect();
1138
1139   my ($query, $sth, $row, $rights);
1140
1141   $rights = {};
1142
1143   $query =
1144     qq|SELECT gr."right", gr.granted
1145        FROM auth.group_rights gr
1146        WHERE group_id IN
1147          (SELECT ug.group_id
1148           FROM auth.user_group ug
1149           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1150           WHERE u.login = ?)|;
1151
1152   $sth = prepare_execute_query($form, $dbh, $query, $login);
1153
1154   while ($row = $sth->fetchrow_hashref()) {
1155     $rights->{$row->{right}} |= $row->{granted};
1156   }
1157   $sth->finish();
1158
1159   map({ $rights->{$_} = 0 unless (defined $rights->{$_}); } SL::Auth::all_rights());
1160
1161   $main::lxdebug->leave_sub();
1162
1163   return $rights;
1164 }
1165
1166 1;
1167 __END__
1168
1169 =pod
1170
1171 =encoding utf8
1172
1173 =head1 NAME
1174
1175 SL::Auth - Authentication and session handling
1176
1177 =head1 FUNCTIONS
1178
1179 =over 4
1180
1181 =item C<set_session_value %values>
1182
1183 Store all key/value pairs in C<%values> in the session. All of these
1184 values are copied back into C<$::form> in the next request
1185 automatically.
1186
1187 The values can be any Perl structure. They are stored as YAML dumps.
1188
1189 =item C<get_session_value $key>
1190
1191 Retrieve a value from the session. Returns C<undef> if the value
1192 doesn't exist.
1193
1194 =item C<create_unique_sesion_value $value, %params>
1195
1196 Create a unique key in the session and store C<$value>
1197 there.
1198
1199 If C<$params{expiration}> is set then it is interpreted as a number of
1200 seconds after which the value is removed from the session. It will
1201 never expire if that parameter is falsish.
1202
1203 If C<$params{auto_restore}> is trueish then the value will be copied
1204 into C<$::form> upon the next request automatically. It defaults to
1205 C<false> and has therefore different behaviour than
1206 L</set_session_value>.
1207
1208 Returns the key created in the session.
1209
1210 =item C<expire_session_keys>
1211
1212 Removes all keys from the session that have an expiration time set and
1213 whose expiration time is in the past.
1214
1215 =item C<save_session>
1216
1217 Stores the session values in the database. This is the only function
1218 that actually stores stuff in the database. Neither the various
1219 setters nor the deleter access the database.
1220
1221 =item <save_form_in_session %params>
1222
1223 Stores the content of C<$params{form}> (default: C<$::form>) in the
1224 session using L</create_unique_sesion_value>.
1225
1226 If C<$params{non_scalars}> is trueish then non-scalar values will be
1227 stored as well. Default is to only store scalar values.
1228
1229 The following keys will never be saved: C<login>, C<password>,
1230 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1231 can be given as an array ref in C<$params{skip_keys}>.
1232
1233 Returns the unique key under which the form is stored.
1234
1235 =item <restore_form_from_session $key, %params>
1236
1237 Restores the form from the session into C<$params{form}> (default:
1238 C<$::form>).
1239
1240 If C<$params{clobber}> is falsish then existing values with the same
1241 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1242 is on by default.
1243
1244 Returns C<$self>.
1245
1246 =back
1247
1248 =head1 BUGS
1249
1250 Nothing here yet.
1251
1252 =head1 AUTHOR
1253
1254 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1255
1256 =cut