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