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