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