SL/Auth.pm

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