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