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(any uniq);
   9 use YAML;
  10 use Regexp::IPv6 qw($IPv6_re);
  11
  12 use SL::Auth::ColumnInformation;
  13 use SL::Auth::Constants qw(:all);
  14 use SL::Auth::DB;
  15 use SL::Auth::LDAP;
  16 use SL::Auth::Password;
  17 use SL::Auth::SessionValue;
  18
  19 use SL::SessionFile;
  20 use SL::User;
  21 use SL::DBConnect;
  22 use SL::DBUpgrade2;
  23 use SL::DBUtils qw(do_query do_statement prepare_execute_query prepare_query selectall_array_query selectrow_query selectall_ids);
  24
  25 use strict;
  26
  27 use constant SESSION_KEY_ROOT_AUTH => 'session_auth_status_root';
  28 use constant SESSION_KEY_USER_AUTH => 'session_auth_status_user';
  29
  30 use Rose::Object::MakeMethods::Generic (
  31   scalar => [ qw(client) ],
  32 );
  33
  34
  35 sub new {
  36   my ($type, %params) = @_;
  37   my $self            = bless {}, $type;
  38
  39   $self->_read_auth_config(%params);
  40   $self->init;
  41
  42   return $self;
  43 }
  44
  45 sub init {
  46   my ($self, %params) = @_;
  47
  48   $self->{SESSION}            = { };
  49   $self->{FULL_RIGHTS}        = { };
  50   $self->{RIGHTS}             = { };
  51   $self->{unique_counter}     = 0;
  52   $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
  53 }
  54
  55 sub reset {
  56   my ($self, %params) = @_;
  57
  58   $self->{SESSION}        = { };
  59   $self->{FULL_RIGHTS}    = { };
  60   $self->{RIGHTS}         = { };
  61   $self->{unique_counter} = 0;
  62
  63   if ($self->is_db_connected) {
  64     # reset is called during request shutdown already. In case of a
  65     # completely new auth DB this would fail and generate an error
  66     # message even if the user is currently trying to create said auth
  67     # DB. Therefore only fetch the column information if a connection
  68     # has been established.
  69     $self->{column_information} = SL::Auth::ColumnInformation->new(auth => $self);
  70     $self->{column_information}->_fetch;
  71   } else {
  72     delete $self->{column_information};
  73   }
  74
  75   $_->reset for @{ $self->{authenticators} };
  76
  77   $self->client(undef);
  78 }
  79
  80 sub set_client {
  81   my ($self, $id_or_name) = @_;
  82
  83   $self->client(undef);
  84
  85   return undef unless $id_or_name;
  86
  87   my $column = $id_or_name =~ m/^\d+$/ ? 'id' : 'name';
  88   my $dbh    = $self->dbconnect;
  89
  90   return undef unless $dbh;
  91
  92   $self->client($dbh->selectrow_hashref(qq|SELECT * FROM auth.clients WHERE ${column} = ?|, undef, $id_or_name));
  93
  94   return $self->client;
  95 }
  96
  97 sub get_default_client_id {
  98   my ($self) = @_;
  99
 100   my $dbh    = $self->dbconnect;
 101
 102   return unless $dbh;
 103
 104   my $row = $dbh->selectrow_hashref(qq|SELECT id FROM auth.clients WHERE is_default = TRUE LIMIT 1|);
 105
 106   return $row->{id} if $row;
 107 }
 108
 109 sub DESTROY {
 110   my $self = shift;
 111
 112   $self->{dbh}->disconnect() if ($self->{dbh});
 113 }
 114
 115 # form isn't loaded yet, so auth needs it's own error.
 116 sub mini_error {
 117   $::lxdebug->show_backtrace();
 118
 119   my ($self, @msg) = @_;
 120   if ($ENV{HTTP_USER_AGENT}) {
 121     # $::form might not be initialized yet at this point — therefore
 122     # we cannot use "create_http_response" yet.
 123     my $cgi = CGI->new('');
 124     print $cgi->header('-type' => 'text/html', '-charset' => 'UTF-8');
 125     print "<pre>", join ('<br>', @msg), "</pre>";
 126   } else {
 127     print STDERR "Error: @msg\n";
 128   }
 129   $::dispatcher->end_request;
 130 }
 131
 132 sub _read_auth_config {
 133   my ($self, %params) = @_;
 134
 135   map { $self->{$_} = $::lx_office_conf{authentication}->{$_} } keys %{ $::lx_office_conf{authentication} };
 136
 137   # Prevent password leakage to log files when dumping Auth instances.
 138   $self->{admin_password} = sub { $::lx_office_conf{authentication}->{admin_password} };
 139
 140   if ($params{unit_tests_database}) {
 141     $self->{DB_config}   = $::lx_office_conf{'testing/database'};
 142     $self->{module}      = 'DB';
 143
 144   } else {
 145     $self->{DB_config}   = $::lx_office_conf{'authentication/database'};
 146   }
 147
 148   $self->{authenticators} =  [];
 149   $self->{module}       ||=  'DB';
 150   $self->{module}         =~ s{^ +| +$}{}g;
 151
 152   foreach my $module (split m{ +}, $self->{module}) {
 153     my $config_name;
 154     ($module, $config_name) = split m{:}, $module, 2;
 155     $config_name          ||= $module eq 'DB' ? 'database' : lc($module);
 156     my $config              = $::lx_office_conf{'authentication/' . $config_name};
 157
 158     if (!$config) {
 159       my $locale = Locale->new('en');
 160       $self->mini_error($locale->text('Missing configuration section "authentication/#1" in "config/kivitendo.conf".', $config_name));
 161     }
 162
 163     if ($module eq 'DB') {
 164       push @{ $self->{authenticators} }, SL::Auth::DB->new($self);
 165
 166     } elsif ($module eq 'LDAP') {
 167       push @{ $self->{authenticators} }, SL::Auth::LDAP->new($config);
 168
 169     } else {
 170       my $locale = Locale->new('en');
 171       $self->mini_error($locale->text('Unknown authenticantion module #1 specified in "config/kivitendo.conf".', $module));
 172     }
 173   }
 174
 175   my $cfg = $self->{DB_config};
 176
 177   if (!$cfg) {
 178     my $locale = Locale->new('en');
 179     $self->mini_error($locale->text('config/kivitendo.conf: Key "DB_config" is missing.'));
 180   }
 181
 182   if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
 183     my $locale = Locale->new('en');
 184     $self->mini_error($locale->text('config/kivitendo.conf: Missing parameters in "authentication/database". Required parameters are "host", "db" and "user".'));
 185   }
 186
 187   $_->verify_config for @{ $self->{authenticators} };
 188
 189   $self->{session_timeout} *= 1;
 190   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
 191 }
 192
 193 sub has_access_to_client {
 194   my ($self, $login) = @_;
 195
 196   return 0 if !$self->client || !$self->client->{id};
 197
 198   my $sql = <<SQL;
 199     SELECT cu.client_id
 200     FROM auth.clients_users cu
 201     LEFT JOIN auth."user" u ON (cu.user_id = u.id)
 202     WHERE (u.login      = ?)
 203       AND (cu.client_id = ?)
 204 SQL
 205
 206   my ($has_access) = $self->dbconnect->selectrow_array($sql, undef, $login, $self->client->{id});
 207   return $has_access;
 208 }
 209
 210 sub authenticate_root {
 211   my ($self, $password) = @_;
 212
 213   my $session_root_auth = $self->get_session_value(SESSION_KEY_ROOT_AUTH());
 214   if (defined $session_root_auth && $session_root_auth == OK) {
 215     return OK;
 216   }
 217
 218   if (!defined $password) {
 219     return ERR_PASSWORD;
 220   }
 221
 222   my $admin_password    = SL::Auth::Password->hash_if_unhashed(login => 'root', password => $self->{admin_password}->());
 223   $password             = SL::Auth::Password->hash(login => 'root', password => $password, stored_password => $admin_password);
 224
 225   my $result = $password eq $admin_password ? OK : ERR_PASSWORD;
 226   $self->set_session_value(SESSION_KEY_ROOT_AUTH() => $result);
 227
 228   return $result;
 229 }
 230
 231 sub authenticate {
 232   my ($self, $login, $password) = @_;
 233
 234   if (!$self->client || !$self->has_access_to_client($login)) {
 235     return ERR_PASSWORD;
 236   }
 237
 238   my $session_auth = $self->get_session_value(SESSION_KEY_USER_AUTH());
 239   if (defined $session_auth && $session_auth == OK) {
 240     return OK;
 241   }
 242
 243   if (!defined $password) {
 244     return ERR_PASSWORD;
 245   }
 246
 247   my $result = ERR_USER;
 248   if ($login) {
 249     foreach my $authenticator (@{ $self->{authenticators} }) {
 250       $result = $authenticator->authenticate($login, $password);
 251       last if $result == OK;
 252     }
 253   }
 254
 255   $self->set_session_value(SESSION_KEY_USER_AUTH() => $result, login => $login, client_id => $self->client->{id});
 256   return $result;
 257 }
 258
 259 sub punish_wrong_login {
 260   my $failed_login_penalty = ($::lx_office_conf{authentication} || {})->{failed_login_penalty};
 261   sleep $failed_login_penalty if $failed_login_penalty;
 262 }
 263
 264 sub get_stored_password {
 265   my ($self, $login) = @_;
 266
 267   my $dbh            = $self->dbconnect;
 268
 269   return undef unless $dbh;
 270
 271   my $query             = qq|SELECT password FROM auth."user" WHERE login = ?|;
 272   my ($stored_password) = $dbh->selectrow_array($query, undef, $login);
 273
 274   return $stored_password;
 275 }
 276
 277 sub dbconnect {
 278   my $self     = shift;
 279   my $may_fail = shift;
 280
 281   if ($self->{dbh}) {
 282     return $self->{dbh};
 283   }
 284
 285   my $cfg = $self->{DB_config};
 286   my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
 287
 288   if ($cfg->{port}) {
 289     $dsn .= ';port=' . $cfg->{port};
 290   }
 291
 292   $main::lxdebug->message(LXDebug->DEBUG1, "Auth::dbconnect DSN: $dsn");
 293
 294   $self->{dbh} = SL::DBConnect->connect($dsn, $cfg->{user}, $cfg->{password}, { pg_enable_utf8 => 1, AutoCommit => 1 });
 295
 296   if (!$may_fail && !$self->{dbh}) {
 297     delete $self->{dbh};
 298     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
 299   }
 300
 301   return $self->{dbh};
 302 }
 303
 304 sub dbdisconnect {
 305   my $self = shift;
 306
 307   if ($self->{dbh}) {
 308     $self->{dbh}->disconnect();
 309     delete $self->{dbh};
 310   }
 311 }
 312
 313 sub is_db_connected {
 314   my ($self) = @_;
 315   return !!$self->{dbh};
 316 }
 317
 318 sub check_tables {
 319   my ($self, $dbh)    = @_;
 320
 321   $dbh   ||= $self->dbconnect();
 322   my $query   = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
 323
 324   my ($count) = $dbh->selectrow_array($query);
 325
 326   return $count > 0;
 327 }
 328
 329 sub check_database {
 330   my $self = shift;
 331
 332   my $dbh  = $self->dbconnect(1);
 333
 334   return $dbh ? 1 : 0;
 335 }
 336
 337 sub create_database {
 338   my $self   = shift;
 339   my %params = @_;
 340
 341   my $cfg    = $self->{DB_config};
 342
 343   if (!$params{superuser}) {
 344     $params{superuser}          = $cfg->{user};
 345     $params{superuser_password} = $cfg->{password};
 346   }
 347
 348   $params{template} ||= 'template0';
 349   $params{template}   =~ s|[^a-zA-Z0-9_\-]||g;
 350
 351   my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
 352
 353   if ($cfg->{port}) {
 354     $dsn .= ';port=' . $cfg->{port};
 355   }
 356
 357   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database DSN: $dsn");
 358
 359   my $dbh = SL::DBConnect->connect($dsn, $params{superuser}, $params{superuser_password}, { pg_enable_utf8 => 1 });
 360
 361   if (!$dbh) {
 362     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
 363   }
 364
 365   my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING 'UNICODE'|;
 366
 367   $main::lxdebug->message(LXDebug->DEBUG1(), "Auth::create_database query: $query");
 368
 369   $dbh->do($query);
 370
 371   if ($dbh->err) {
 372     my $error = $dbh->errstr();
 373
 374     $query                 = qq|SELECT pg_encoding_to_char(encoding) FROM pg_database WHERE datname = 'template0'|;
 375     my ($cluster_encoding) = $dbh->selectrow_array($query);
 376
 377     if ($cluster_encoding && ($cluster_encoding !~ m/^(?:UTF-?8|UNICODE)$/i)) {
 378       $error = $::locale->text('Your PostgreSQL installationen does not use Unicode as its encoding. This is not supported anymore.');
 379     }
 380
 381     $dbh->disconnect();
 382
 383     $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $error);
 384   }
 385
 386   $dbh->disconnect();
 387 }
 388
 389 sub create_tables {
 390   my $self = shift;
 391   my $dbh  = $self->dbconnect();
 392
 393   $dbh->rollback();
 394   SL::DBUpgrade2->new(form => $::form)->process_query($dbh, 'sql/auth_db.sql');
 395 }
 396
 397 sub save_user {
 398   my $self   = shift;
 399   my $login  = shift;
 400   my %params = @_;
 401
 402   my $form   = $main::form;
 403
 404   my $dbh    = $self->dbconnect();
 405
 406   my ($sth, $query, $user_id);
 407
 408   $dbh->begin_work;
 409
 410   $query     = qq|SELECT id FROM auth."user" WHERE login = ?|;
 411   ($user_id) = selectrow_query($form, $dbh, $query, $login);
 412
 413   if (!$user_id) {
 414     $query     = qq|SELECT nextval('auth.user_id_seq')|;
 415     ($user_id) = selectrow_query($form, $dbh, $query);
 416
 417     $query     = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
 418     do_query($form, $dbh, $query, $user_id, $login);
 419   }
 420
 421   $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
 422   do_query($form, $dbh, $query, $user_id);
 423
 424   $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
 425   $sth   = prepare_query($form, $dbh, $query);
 426
 427   while (my ($cfg_key, $cfg_value) = each %params) {
 428     next if ($cfg_key eq 'password');
 429
 430     do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
 431   }
 432
 433   $dbh->commit();
 434 }
 435
 436 sub can_change_password {
 437   my $self = shift;
 438
 439   return any { $_->can_change_password } @{ $self->{authenticators} };
 440 }
 441
 442 sub change_password {
 443   my ($self, $login, $new_password) = @_;
 444
 445   my $overall_result = OK;
 446
 447   foreach my $authenticator (@{ $self->{authenticators} }) {
 448     next unless $authenticator->can_change_password;
 449
 450     my $result = $authenticator->change_password($login, $new_password);
 451     $overall_result = $result if $result != OK;
 452   }
 453
 454   return $overall_result;
 455 }
 456
 457 sub read_all_users {
 458   my $self  = shift;
 459
 460   my $dbh   = $self->dbconnect();
 461   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value, s.mtime AS last_action
 462
 463                  FROM auth."user" AS  u
 464
 465                  LEFT JOIN auth.user_config AS cfg
 466                    ON (cfg.user_id = u.id)
 467
 468                  LEFT JOIN auth.session_content AS sc_login
 469                    ON (sc_login.sess_key = 'login' AND sc_login.sess_value = ('--- ' \|\| u.login \|\| '\n'))
 470
 471                  LEFT JOIN auth.session AS s
 472                    ON (s.id = sc_login.session_id)
 473               |;
 474   my $sth   = prepare_execute_query($main::form, $dbh, $query);
 475
 476   my %users;
 477
 478   while (my $ref = $sth->fetchrow_hashref()) {
 479
 480     $users{$ref->{login}}                    ||= {
 481                                                 'login' => $ref->{login},
 482                                                 'id' => $ref->{id},
 483                                                 'last_action' => $ref->{last_action},
 484                                              };
 485     $users{$ref->{login}}->{$ref->{cfg_key}}   = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
 486   }
 487
 488   $sth->finish();
 489
 490   return %users;
 491 }
 492
 493 sub read_user {
 494   my ($self, %params) = @_;
 495
 496   my $dbh   = $self->dbconnect();
 497
 498   my (@where, @values);
 499   if ($params{login}) {
 500     push @where,  'u.login = ?';
 501     push @values, $params{login};
 502   }
 503   if ($params{id}) {
 504     push @where,  'u.id = ?';
 505     push @values, $params{id};
 506   }
 507   my $where = join ' AND ', '1 = 1', @where;
 508   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
 509                  FROM auth.user_config cfg
 510                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
 511                  WHERE $where|;
 512   my $sth   = prepare_execute_query($main::form, $dbh, $query, @values);
 513
 514   my %user_data;
 515
 516   while (my $ref = $sth->fetchrow_hashref()) {
 517     $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
 518     @user_data{qw(id login)}    = @{$ref}{qw(id login)};
 519   }
 520
 521   # The XUL/XML & 'CSS new' backed menus have been removed.
 522   my %menustyle_map = ( xml => 'new', v4 => 'v3' );
 523   $user_data{menustyle} = $menustyle_map{lc($user_data{menustyle} || '')} || $user_data{menustyle};
 524
 525   # The 'Win2000.css' stylesheet has been removed.
 526   $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
 527
 528   # Set default language if selected language does not exist (anymore).
 529   $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
 530
 531   $sth->finish();
 532
 533   return %user_data;
 534 }
 535
 536 sub get_user_id {
 537   my $self  = shift;
 538   my $login = shift;
 539
 540   my $dbh   = $self->dbconnect();
 541   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
 542
 543   return $id;
 544 }
 545
 546 sub delete_user {
 547   my $self  = shift;
 548   my $login = shift;
 549
 550   my $dbh   = $self->dbconnect;
 551   my $id    = $self->get_user_id($login);
 552
 553   if (!$id) {
 554     $dbh->rollback;
 555     return;
 556   }
 557
 558   $dbh->begin_work;
 559
 560   do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
 561   do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
 562   do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
 563
 564   # TODO: SL::Auth::delete_user
 565   # do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
 566
 567   $dbh->commit;
 568 }
 569
 570 # --------------------------------------
 571
 572 my $session_id;
 573
 574 sub restore_session {
 575   my $self = shift;
 576
 577   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
 578   $session_id        =~ s|[^0-9a-f]||g if $session_id;
 579
 580   $self->{SESSION}   = { };
 581
 582   if (!$session_id) {
 583     return $self->session_restore_result(SESSION_NONE());
 584   }
 585
 586   my ($dbh, $query, $sth, $cookie, $ref, $form);
 587
 588   $form   = $main::form;
 589
 590   # Don't fail if the auth DB doesn't exist yet.
 591   if (!( $dbh = $self->dbconnect(1) )) {
 592     return $self->session_restore_result(SESSION_NONE());
 593   }
 594
 595   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
 596   # admin is creating the session tables at the moment.
 597   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
 598
 599   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
 600     $sth->finish if $sth;
 601     return $self->session_restore_result(SESSION_NONE());
 602   }
 603
 604   $cookie = $sth->fetchrow_hashref;
 605   $sth->finish;
 606
 607   # The session ID provided is valid in the following cases:
 608   #  1. session ID exists in the database
 609   #  2. hasn't expired yet
 610   #  3. if cookie for the API token is given: the cookie's value equal database column 'auth.session.api_token' for the session ID
 611   $self->{api_token}   = $cookie->{api_token} if $cookie;
 612   my $api_token_cookie = $self->get_api_token_cookie;
 613   my $cookie_is_bad    = !$cookie || $cookie->{is_expired};
 614   $cookie_is_bad     ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if  $api_token_cookie;
 615   if ($cookie_is_bad) {
 616     $self->destroy_session();
 617     return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
 618   }
 619
 620   if ($self->{column_information}->has('auto_restore')) {
 621     $self->_load_with_auto_restore_column($dbh, $session_id);
 622   } else {
 623     $self->_load_without_auto_restore_column($dbh, $session_id);
 624   }
 625
 626   return $self->session_restore_result(SESSION_OK());
 627 }
 628
 629 sub session_restore_result {
 630   my $self = shift;
 631   if (@_) {
 632     $self->{session_restore_result} = $_[0];
 633   }
 634   return $self->{session_restore_result};
 635 }
 636
 637 sub _load_without_auto_restore_column {
 638   my ($self, $dbh, $session_id) = @_;
 639
 640   my $query = <<SQL;
 641     SELECT sess_key, sess_value
 642     FROM auth.session_content
 643     WHERE (session_id = ?)
 644 SQL
 645   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
 646
 647   while (my $ref = $sth->fetchrow_hashref) {
 648     my $value = SL::Auth::SessionValue->new(auth  => $self,
 649                                             key   => $ref->{sess_key},
 650                                             value => $ref->{sess_value},
 651                                             raw   => 1);
 652     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 653
 654     next if defined $::form->{$ref->{sess_key}};
 655
 656     my $data                    = $value->get;
 657     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 658   }
 659 }
 660
 661 sub _load_with_auto_restore_column {
 662   my ($self, $dbh, $session_id) = @_;
 663
 664   my %auto_restore_keys = map { $_ => 1 } qw(login password rpw client_id), SESSION_KEY_ROOT_AUTH, SESSION_KEY_USER_AUTH;
 665
 666   my $query = <<SQL;
 667     SELECT sess_key, sess_value, auto_restore
 668     FROM auth.session_content
 669     WHERE (session_id = ?) AND (auto_restore OR sess_key IN (@{[ join ',', ("?") x keys %auto_restore_keys ]}))
 670 SQL
 671   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id, keys %auto_restore_keys);
 672
 673   my $need_delete;
 674   while (my $ref = $sth->fetchrow_hashref) {
 675     $need_delete = 1 if $ref->{auto_restore};
 676     my $value = SL::Auth::SessionValue->new(auth         => $self,
 677                                             key          => $ref->{sess_key},
 678                                             value        => $ref->{sess_value},
 679                                             auto_restore => $ref->{auto_restore},
 680                                             raw          => 1);
 681     $self->{SESSION}->{ $ref->{sess_key} } = $value;
 682
 683     next if defined $::form->{$ref->{sess_key}};
 684
 685     my $data                    = $value->get;
 686     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
 687   }
 688
 689   $sth->finish;
 690
 691   if ($need_delete) {
 692     do_query($::form, $dbh, 'DELETE FROM auth.session_content WHERE auto_restore AND session_id = ?', $session_id);
 693   }
 694 }
 695
 696 sub destroy_session {
 697   my $self = shift;
 698
 699   if ($session_id) {
 700     my $dbh = $self->dbconnect();
 701
 702     $dbh->begin_work;
 703
 704     do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
 705     do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
 706
 707     $dbh->commit();
 708
 709     SL::SessionFile->destroy_session($session_id);
 710
 711     $session_id      = undef;
 712     $self->{SESSION} = { };
 713   }
 714 }
 715
 716 sub active_session_ids {
 717   my $self  = shift;
 718   my $dbh   = $self->dbconnect;
 719
 720   my $query = qq|SELECT id FROM auth.session|;
 721
 722   my @ids   = selectall_array_query($::form, $dbh, $query);
 723
 724   return @ids;
 725 }
 726
 727 sub expire_sessions {
 728   my $self  = shift;
 729
 730   return if !$self->session_tables_present;
 731
 732   my $dbh   = $self->dbconnect();
 733
 734   my $query = qq|SELECT id
 735                  FROM auth.session
 736                  WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
 737
 738   my @ids   = selectall_array_query($::form, $dbh, $query);
 739
 740   if (@ids) {
 741     $dbh->begin_work;
 742
 743     SL::SessionFile->destroy_session($_) for @ids;
 744
 745     $query = qq|DELETE FROM auth.session_content
 746                 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 747     do_query($main::form, $dbh, $query, @ids);
 748
 749     $query = qq|DELETE FROM auth.session
 750                 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
 751     do_query($main::form, $dbh, $query, @ids);
 752
 753     $dbh->commit();
 754   }
 755 }
 756
 757 sub _create_session_id {
 758   my @data;
 759   map { push @data, int(rand() * 255); } (1..32);
 760
 761   my $id = md5_hex(pack 'C*', @data);
 762
 763   return $id;
 764 }
 765
 766 sub create_or_refresh_session {
 767   $session_id ||= shift->_create_session_id;
 768 }
 769
 770 sub save_session {
 771   my $self         = shift;
 772   my $provided_dbh = shift;
 773
 774   my $dbh          = $provided_dbh || $self->dbconnect(1);
 775
 776   return unless $dbh && $session_id;
 777
 778   $dbh->begin_work unless $provided_dbh;
 779
 780   # If this fails then the "auth" schema might not exist yet, e.g. if
 781   # the admin is just trying to create the auth database.
 782   if (!$dbh->do(qq|LOCK auth.session_content|)) {
 783     $dbh->rollback unless $provided_dbh;
 784     return;
 785   }
 786
 787   my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
 788
 789   if ($id) {
 790     do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
 791   } else {
 792     do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
 793   }
 794
 795   if ($self->{column_information}->has('api_token', 'session')) {
 796     my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
 797     do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
 798   }
 799
 800   my @values_to_save = grep    { $_->{modified} }
 801                        values %{ $self->{SESSION} };
 802   if (@values_to_save) {
 803     my %known_keys = map { $_ => 1 }
 804       selectall_ids($::form, $dbh, qq|SELECT sess_key FROM auth.session_content WHERE session_id = ?|, 'sess_key', $session_id);
 805     my $auto_restore             = $self->{column_information}->has('auto_restore');
 806
 807     my $insert_query  = $auto_restore
 808       ? "INSERT INTO auth.session_content (session_id, sess_key, sess_value, auto_restore) VALUES (?, ?, ?, ?)"
 809       : "INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)";
 810     my $insert_sth = prepare_query($::form, $dbh, $insert_query);
 811
 812     my $update_query  = $auto_restore
 813       ? "UPDATE auth.session_content SET sess_value = ?, auto_restore = ? WHERE session_id = ? AND sess_key = ?"
 814       : "UPDATE auth.session_content SET sess_value = ? WHERE session_id = ? AND sess_key = ?";
 815     my $update_sth = prepare_query($::form, $dbh, $update_query);
 816
 817     foreach my $value (@values_to_save) {
 818       my @values = ($value->{key}, $value->get_dumped);
 819       push @values, $value->{auto_restore} if $auto_restore;
 820
 821       if ($known_keys{$value->{key}}) {
 822         do_statement($::form, $update_sth, $update_query,
 823           $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore, $session_id, $value->{key}
 824         );
 825       } else {
 826         do_statement($::form, $insert_sth, $insert_query,
 827           $session_id, $value->{key}, $value->get_dumped, ( $value->{auto_restore} )x!!$auto_restore
 828         );
 829       }
 830     }
 831
 832     $insert_sth->finish;
 833     $update_sth->finish;
 834   }
 835
 836   $dbh->commit() unless $provided_dbh;
 837 }
 838
 839 sub set_session_value {
 840   my $self   = shift;
 841   my @params = @_;
 842
 843   $self->{SESSION} ||= { };
 844
 845   while (@params) {
 846     my $key = shift @params;
 847
 848     if (ref $key eq 'HASH') {
 849       $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key          => $key->{key},
 850                                                                       value        => $key->{value},
 851                                                                       modified     => 1,
 852                                                                       auto_restore => $key->{auto_restore});
 853
 854     } else {
 855       my $value = shift @params;
 856       $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key   => $key,
 857                                                                value => $value,
 858                                                                modified => 1);
 859     }
 860   }
 861
 862   return $self;
 863 }
 864
 865 sub delete_session_value {
 866   my $self = shift;
 867
 868   $self->{SESSION} ||= { };
 869   delete @{ $self->{SESSION} }{ @_ };
 870
 871   return $self;
 872 }
 873
 874 sub get_session_value {
 875   my ($self, $key) = @_;
 876
 877   return if !$self->{SESSION};
 878
 879   ($self->{SESSION}{$key} //= SL::Auth::SessionValue->new(auth => $self, key => $key))->get
 880 }
 881
 882 sub create_unique_sesion_value {
 883   my ($self, $value, %params) = @_;
 884
 885   $self->{SESSION} ||= { };
 886
 887   my @now                   = gettimeofday();
 888   my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
 889   $self->{unique_counter} ||= 0;
 890
 891   my $hashed_key;
 892   do {
 893     $self->{unique_counter}++;
 894     $hashed_key = md5_hex($key . $self->{unique_counter});
 895   } while (exists $self->{SESSION}->{$hashed_key});
 896
 897   $self->set_session_value($hashed_key => $value);
 898
 899   return $hashed_key;
 900 }
 901
 902 sub save_form_in_session {
 903   my ($self, %params) = @_;
 904
 905   my $form        = delete($params{form}) || $::form;
 906   my $non_scalars = delete $params{non_scalars};
 907   my $data        = {};
 908
 909   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
 910
 911   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
 912     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
 913   }
 914
 915   return $self->create_unique_sesion_value($data, %params);
 916 }
 917
 918 sub restore_form_from_session {
 919   my ($self, $key, %params) = @_;
 920
 921   my $data = $self->get_session_value($key);
 922   return $self unless $data;
 923
 924   my $form    = delete($params{form}) || $::form;
 925   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
 926
 927   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
 928
 929   return $self;
 930 }
 931
 932 sub set_cookie_environment_variable {
 933   my $self = shift;
 934   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
 935 }
 936
 937 sub get_session_cookie_name {
 938   my ($self, %params) = @_;
 939
 940   $params{type}     ||= 'id';
 941   my $name            = $self->{cookie_name} || 'lx_office_erp_session_id';
 942   $name              .= '_api_token' if $params{type} eq 'api_token';
 943
 944   return $name;
 945 }
 946
 947 sub get_session_id {
 948   return $session_id;
 949 }
 950
 951 sub get_api_token_cookie {
 952   my ($self) = @_;
 953
 954   $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
 955 }
 956
 957 sub is_api_token_cookie_valid {
 958   my ($self)             = @_;
 959   my $provided_api_token = $self->get_api_token_cookie;
 960   return $self->{api_token} && $provided_api_token && ($self->{api_token} eq $provided_api_token);
 961 }
 962
 963 sub _tables_present {
 964   my ($self, @tables) = @_;
 965   my $cache_key = join '_', @tables;
 966
 967   # Only re-check for the presence of auth tables if either the check
 968   # hasn't been done before of if they weren't present.
 969   return $self->{"$cache_key\_tables_present"} ||= do {
 970     my $dbh  = $self->dbconnect(1);
 971
 972     if (!$dbh) {
 973       return 0;
 974     }
 975
 976     my $query =
 977       qq|SELECT COUNT(*)
 978          FROM pg_tables
 979          WHERE (schemaname = 'auth')
 980            AND (tablename IN (@{[ join ', ', ('?') x @tables ]}))|;
 981
 982     my ($count) = selectrow_query($main::form, $dbh, $query, @tables);
 983
 984     scalar @tables == $count;
 985   }
 986 }
 987
 988 sub session_tables_present {
 989   $_[0]->_tables_present('session', 'session_content');
 990 }
 991
 992 sub master_rights_present {
 993   $_[0]->_tables_present('master_rights');
 994 }
 995
 996 # --------------------------------------
 997
 998 sub all_rights_full {
 999   my ($self) = @_;
1000
1001   @{ $self->{master_rights} ||= do {
1002       $self->dbconnect->selectall_arrayref("SELECT name, description, category FROM auth.master_rights ORDER BY position");
1003     }
1004   }
1005 }
1006
1007 sub all_rights {
1008   return map { $_->[0] } grep { !$_->[2] } $_[0]->all_rights_full;
1009 }
1010
1011 sub read_groups {
1012   my $self = shift;
1013
1014   my $form   = $main::form;
1015   my $groups = {};
1016   my $dbh    = $self->dbconnect();
1017
1018   my $query  = 'SELECT * FROM auth."group"';
1019   my $sth    = prepare_execute_query($form, $dbh, $query);
1020
1021   my ($row, $group);
1022
1023   while ($row = $sth->fetchrow_hashref()) {
1024     $groups->{$row->{id}} = $row;
1025   }
1026   $sth->finish();
1027
1028   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1029   $sth   = prepare_query($form, $dbh, $query);
1030
1031   foreach $group (values %{$groups}) {
1032     my @members;
1033
1034     do_statement($form, $sth, $query, $group->{id});
1035
1036     while ($row = $sth->fetchrow_hashref()) {
1037       push @members, $row->{user_id};
1038     }
1039     $group->{members} = [ uniq @members ];
1040   }
1041   $sth->finish();
1042
1043   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1044   $sth   = prepare_query($form, $dbh, $query);
1045
1046   foreach $group (values %{$groups}) {
1047     $group->{rights} = {};
1048
1049     do_statement($form, $sth, $query, $group->{id});
1050
1051     while ($row = $sth->fetchrow_hashref()) {
1052       $group->{rights}->{$row->{right}} |= $row->{granted};
1053     }
1054
1055     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } $self->all_rights;
1056   }
1057   $sth->finish();
1058
1059   return $groups;
1060 }
1061
1062 sub save_group {
1063   my $self  = shift;
1064   my $group = shift;
1065
1066   my $form  = $main::form;
1067   my $dbh   = $self->dbconnect();
1068
1069   $dbh->begin_work;
1070
1071   my ($query, $sth, $row, $rights);
1072
1073   if (!$group->{id}) {
1074     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1075
1076     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1077     do_query($form, $dbh, $query, $group->{id});
1078   }
1079
1080   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1081
1082   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1083
1084   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1085   $sth    = prepare_query($form, $dbh, $query);
1086
1087   foreach my $user_id (uniq @{ $group->{members} }) {
1088     do_statement($form, $sth, $query, $user_id, $group->{id});
1089   }
1090   $sth->finish();
1091
1092   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1093
1094   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1095   $sth   = prepare_query($form, $dbh, $query);
1096
1097   foreach my $right (keys %{ $group->{rights} }) {
1098     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1099   }
1100   $sth->finish();
1101
1102   $dbh->commit();
1103 }
1104
1105 sub delete_group {
1106   my $self = shift;
1107   my $id   = shift;
1108
1109   my $form = $main::form;
1110
1111   my $dbh  = $self->dbconnect();
1112   $dbh->begin_work;
1113
1114   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1115   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1116   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1117
1118   $dbh->commit();
1119 }
1120
1121 sub evaluate_rights_ary {
1122   my $ary    = shift;
1123
1124   my $value  = 0;
1125   my $action = '|';
1126   my $negate = 0;
1127
1128   foreach my $el (@{$ary}) {
1129     next unless defined $el;
1130
1131     if (ref $el eq "ARRAY") {
1132       my $val = evaluate_rights_ary($el);
1133       $val    = !$val if $negate;
1134       $negate = 0;
1135       if ($action eq '|') {
1136         $value |= $val;
1137       } else {
1138         $value &= $val;
1139       }
1140
1141     } elsif (($el eq '&') || ($el eq '|')) {
1142       $action = $el;
1143
1144     } elsif ($el eq '!') {
1145       $negate = !$negate;
1146
1147     } elsif ($action eq '|') {
1148       my $val = $el;
1149       $val    = !$val if $negate;
1150       $negate = 0;
1151       $value |= $val;
1152
1153     } else {
1154       my $val = $el;
1155       $val    = !$val if $negate;
1156       $negate = 0;
1157       $value &= $val;
1158
1159     }
1160   }
1161
1162   return $value;
1163 }
1164
1165 sub _parse_rights_string {
1166   my $self   = shift;
1167
1168   my $login  = shift;
1169   my $access = shift;
1170
1171   my @stack;
1172   my $cur_ary = [];
1173
1174   push @stack, $cur_ary;
1175
1176   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1177     my $token = $1;
1178     substr($access, 0, length $1) = "";
1179
1180     next if ($token =~ /\s/);
1181
1182     if ($token eq "(") {
1183       my $new_cur_ary = [];
1184       push @stack, $new_cur_ary;
1185       push @{$cur_ary}, $new_cur_ary;
1186       $cur_ary = $new_cur_ary;
1187
1188     } elsif ($token eq ")") {
1189       pop @stack;
1190
1191       if (!@stack) {
1192         return 0;
1193       }
1194
1195       $cur_ary = $stack[-1];
1196
1197     } elsif (($token eq "|") || ($token eq "&")) {
1198       push @{$cur_ary}, $token;
1199
1200     } else {
1201       push @{$cur_ary}, ($self->{RIGHTS}->{$login}->{$token} // 0) * 1;
1202     }
1203   }
1204
1205   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1206
1207   return $result;
1208 }
1209
1210 sub check_right {
1211   my $self    = shift;
1212   my $login   = shift;
1213   my $right   = shift;
1214   my $default = shift;
1215
1216   $self->{FULL_RIGHTS}           ||= { };
1217   $self->{FULL_RIGHTS}->{$login} ||= { };
1218
1219   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1220     $self->{RIGHTS}           ||= { };
1221     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1222
1223     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1224   }
1225
1226   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1227   $granted    = $default if (!defined $granted);
1228
1229   return $granted;
1230 }
1231
1232 sub assert {
1233   my ($self, $right, $dont_abort) = @_;
1234
1235   if ($self->check_right($::myconfig{login}, $right)) {
1236     return 1;
1237   }
1238
1239   if (!$dont_abort) {
1240     $::dispatcher->reply_with_json_error(error => 'access') if $::request->type eq 'json';
1241
1242     delete $::form->{title};
1243     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1244   }
1245
1246   return 0;
1247 }
1248
1249 sub load_rights_for_user {
1250   my ($self, $login) = @_;
1251   my $dbh   = $self->dbconnect;
1252   my ($query, $sth, $row, $rights);
1253
1254   $rights = { map { $_ => 0 } $self->all_rights };
1255
1256   return $rights if !$self->client || !$login;
1257
1258   $query =
1259     qq|SELECT gr."right", gr.granted
1260        FROM auth.group_rights gr
1261        WHERE group_id IN
1262          (SELECT ug.group_id
1263           FROM auth.user_group ug
1264           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1265           WHERE u.login = ?)
1266        AND group_id IN
1267          (SELECT cg.group_id
1268           FROM auth.clients_groups cg
1269           WHERE cg.client_id = ?)|;
1270
1271   $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1272
1273   while ($row = $sth->fetchrow_hashref()) {
1274     $rights->{$row->{right}} |= $row->{granted};
1275   }
1276   $sth->finish();
1277
1278   return $rights;
1279 }
1280
1281 1;
1282 __END__
1283
1284 =pod
1285
1286 =encoding utf8
1287
1288 =head1 NAME
1289
1290 SL::Auth - Authentication and session handling
1291
1292 =head1 METHODS
1293
1294 =over 4
1295
1296 =item C<set_session_value @values>
1297
1298 =item C<set_session_value %values>
1299
1300 Store all values of C<@values> or C<%values> in the session. Each
1301 member of C<@values> is tested if it is a hash reference. If it is
1302 then it must contain the keys C<key> and C<value> and can optionally
1303 contain the key C<auto_restore>. In this case C<value> is associated
1304 with C<key> and restored to C<$::form> upon the next request
1305 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1306 value.
1307
1308 If the current member of C<@values> is not a hash reference then it
1309 will be used as the C<key> and the next entry of C<@values> is used as
1310 the C<value> to store. In this case setting C<auto_restore> is not
1311 possible.
1312
1313 Therefore the following two invocations are identical:
1314
1315   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1316   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1317
1318 All of these values are copied back into C<$::form> for the next
1319 request automatically if they're scalar values or if they have
1320 C<auto_restore> set to trueish.
1321
1322 The values can be any Perl structure. They are stored as YAML dumps.
1323
1324 =item C<get_session_value $key>
1325
1326 Retrieve a value from the session. Returns C<undef> if the value
1327 doesn't exist.
1328
1329 =item C<create_unique_sesion_value $value, %params>
1330
1331 Create a unique key in the session and store C<$value>
1332 there.
1333
1334 Returns the key created in the session.
1335
1336 =item C<save_session>
1337
1338 Stores the session values in the database. This is the only function
1339 that actually stores stuff in the database. Neither the various
1340 setters nor the deleter access the database.
1341
1342 =item C<save_form_in_session %params>
1343
1344 Stores the content of C<$params{form}> (default: C<$::form>) in the
1345 session using L</create_unique_sesion_value>.
1346
1347 If C<$params{non_scalars}> is trueish then non-scalar values will be
1348 stored as well. Default is to only store scalar values.
1349
1350 The following keys will never be saved: C<login>, C<password>,
1351 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1352 can be given as an array ref in C<$params{skip_keys}>.
1353
1354 Returns the unique key under which the form is stored.
1355
1356 =item C<restore_form_from_session $key, %params>
1357
1358 Restores the form from the session into C<$params{form}> (default:
1359 C<$::form>).
1360
1361 If C<$params{clobber}> is falsish then existing values with the same
1362 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1363 is on by default.
1364
1365 Returns C<$self>.
1366
1367 =item C<reset>
1368
1369 C<reset> deletes every state information from previous requests, but does not
1370 close the database connection.
1371
1372 Creating a new database handle on each request can take up to 30% of the
1373 pre-request startup time, so we want to avoid that for fast ajax calls.
1374
1375 =item C<assert, $right, $dont_abort>
1376
1377 Checks if current user has the C<$right>. If C<$dont_abort> is falsish
1378 the request dies with a access denied error, otherwise returns true or false.
1379
1380 =back
1381
1382 =head1 BUGS
1383
1384 Nothing here yet.
1385
1386 =head1 AUTHOR
1387
1388 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1389
1390 =cut