SL/Auth.pm

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