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