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