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