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