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