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