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