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