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