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