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