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_all_edit",                 $locale->text("View/edit all employees sales documents")],
 961     ["edit_prices",                    $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
 962     ["show_ar_transactions",           $locale->text("Show AR transactions as part of AR invoice report")],
 963     ["delivery_plan",                  $locale->text("Show delivery plan")],
 964     ["delivery_value_report",          $locale->text("Show delivery value report")],
 965     ["--ap",                           $locale->text("AP")],
 966     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
 967     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
 968     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
 969     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
 970     ["show_ap_transactions",           $locale->text("Show AP transactions as part of AP invoice report")],
 971     ["--warehouse_management",         $locale->text("Warehouse management")],
 972     ["warehouse_contents",             $locale->text("View warehouse content")],
 973     ["warehouse_management",           $locale->text("Warehouse management")],
 974     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
 975     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
 976     ["datev_export",                   $locale->text("DATEV Export")],
 977     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
 978     ["--reports",                      $locale->text('Reports')],
 979     ["report",                         $locale->text('All reports')],
 980     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
 981     ["--batch_printing",               $locale->text("Batch Printing")],
 982     ["batch_printing",                 $locale->text("Batch Printing")],
 983     ["--configuration",                $locale->text("Configuration")],
 984     ["config",                         $locale->text("Change kivitendo installation settings (most entries in the 'System' menu)")],
 985     ["admin",                          $locale->text("Client administration: configuration, editing templates, task server control, background jobs (remaining entries in the 'System' menu)")],
 986     ["--others",                       $locale->text("Others")],
 987     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
 988     ["productivity",                   $locale->text("Productivity")],
 989     ["display_admin_link",             $locale->text("Show administration link")],
 990     );
 991
 992   return @all_rights;
 993 }
 994
 995 sub all_rights {
 996   return grep !/^--/, map { $_->[0] } all_rights_full();
 997 }
 998
 999 sub read_groups {
1000   my $self = shift;
1001
1002   my $form   = $main::form;
1003   my $groups = {};
1004   my $dbh    = $self->dbconnect();
1005
1006   my $query  = 'SELECT * FROM auth."group"';
1007   my $sth    = prepare_execute_query($form, $dbh, $query);
1008
1009   my ($row, $group);
1010
1011   while ($row = $sth->fetchrow_hashref()) {
1012     $groups->{$row->{id}} = $row;
1013   }
1014   $sth->finish();
1015
1016   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1017   $sth   = prepare_query($form, $dbh, $query);
1018
1019   foreach $group (values %{$groups}) {
1020     my @members;
1021
1022     do_statement($form, $sth, $query, $group->{id});
1023
1024     while ($row = $sth->fetchrow_hashref()) {
1025       push @members, $row->{user_id};
1026     }
1027     $group->{members} = [ uniq @members ];
1028   }
1029   $sth->finish();
1030
1031   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1032   $sth   = prepare_query($form, $dbh, $query);
1033
1034   foreach $group (values %{$groups}) {
1035     $group->{rights} = {};
1036
1037     do_statement($form, $sth, $query, $group->{id});
1038
1039     while ($row = $sth->fetchrow_hashref()) {
1040       $group->{rights}->{$row->{right}} |= $row->{granted};
1041     }
1042
1043     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1044   }
1045   $sth->finish();
1046
1047   return $groups;
1048 }
1049
1050 sub save_group {
1051   my $self  = shift;
1052   my $group = shift;
1053
1054   my $form  = $main::form;
1055   my $dbh   = $self->dbconnect();
1056
1057   $dbh->begin_work;
1058
1059   my ($query, $sth, $row, $rights);
1060
1061   if (!$group->{id}) {
1062     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1063
1064     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1065     do_query($form, $dbh, $query, $group->{id});
1066   }
1067
1068   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1069
1070   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1071
1072   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1073   $sth    = prepare_query($form, $dbh, $query);
1074
1075   foreach my $user_id (uniq @{ $group->{members} }) {
1076     do_statement($form, $sth, $query, $user_id, $group->{id});
1077   }
1078   $sth->finish();
1079
1080   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1081
1082   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1083   $sth   = prepare_query($form, $dbh, $query);
1084
1085   foreach my $right (keys %{ $group->{rights} }) {
1086     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1087   }
1088   $sth->finish();
1089
1090   $dbh->commit();
1091 }
1092
1093 sub delete_group {
1094   my $self = shift;
1095   my $id   = shift;
1096
1097   my $form = $main::form;
1098
1099   my $dbh  = $self->dbconnect();
1100   $dbh->begin_work;
1101
1102   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1103   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1104   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1105
1106   $dbh->commit();
1107 }
1108
1109 sub evaluate_rights_ary {
1110   my $ary    = shift;
1111
1112   my $value  = 0;
1113   my $action = '|';
1114
1115   foreach my $el (@{$ary}) {
1116     if (ref $el eq "ARRAY") {
1117       if ($action eq '|') {
1118         $value |= evaluate_rights_ary($el);
1119       } else {
1120         $value &= evaluate_rights_ary($el);
1121       }
1122
1123     } elsif (($el eq '&') || ($el eq '|')) {
1124       $action = $el;
1125
1126     } elsif ($action eq '|') {
1127       $value |= $el;
1128
1129     } else {
1130       $value &= $el;
1131
1132     }
1133   }
1134
1135   return $value;
1136 }
1137
1138 sub _parse_rights_string {
1139   my $self   = shift;
1140
1141   my $login  = shift;
1142   my $access = shift;
1143
1144   my @stack;
1145   my $cur_ary = [];
1146
1147   push @stack, $cur_ary;
1148
1149   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1150     my $token = $1;
1151     substr($access, 0, length $1) = "";
1152
1153     next if ($token =~ /\s/);
1154
1155     if ($token eq "(") {
1156       my $new_cur_ary = [];
1157       push @stack, $new_cur_ary;
1158       push @{$cur_ary}, $new_cur_ary;
1159       $cur_ary = $new_cur_ary;
1160
1161     } elsif ($token eq ")") {
1162       pop @stack;
1163
1164       if (!@stack) {
1165         return 0;
1166       }
1167
1168       $cur_ary = $stack[-1];
1169
1170     } elsif (($token eq "|") || ($token eq "&")) {
1171       push @{$cur_ary}, $token;
1172
1173     } else {
1174       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1175     }
1176   }
1177
1178   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1179
1180   return $result;
1181 }
1182
1183 sub check_right {
1184   my $self    = shift;
1185   my $login   = shift;
1186   my $right   = shift;
1187   my $default = shift;
1188
1189   $self->{FULL_RIGHTS}           ||= { };
1190   $self->{FULL_RIGHTS}->{$login} ||= { };
1191
1192   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1193     $self->{RIGHTS}           ||= { };
1194     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1195
1196     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1197   }
1198
1199   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1200   $granted    = $default if (!defined $granted);
1201
1202   return $granted;
1203 }
1204
1205 sub assert {
1206   my ($self, $right, $dont_abort) = @_;
1207
1208   if ($self->check_right($::myconfig{login}, $right)) {
1209     return 1;
1210   }
1211
1212   if (!$dont_abort) {
1213     delete $::form->{title};
1214     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1215   }
1216
1217   return 0;
1218 }
1219
1220 sub load_rights_for_user {
1221   my ($self, $login) = @_;
1222   my $dbh   = $self->dbconnect;
1223   my ($query, $sth, $row, $rights);
1224
1225   $rights = { map { $_ => 0 } all_rights() };
1226
1227   return $rights if !$self->client || !$login;
1228
1229   $query =
1230     qq|SELECT gr."right", gr.granted
1231        FROM auth.group_rights gr
1232        WHERE group_id IN
1233          (SELECT ug.group_id
1234           FROM auth.user_group ug
1235           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1236           WHERE u.login = ?)
1237        AND group_id IN
1238          (SELECT cg.group_id
1239           FROM auth.clients_groups cg
1240           WHERE cg.client_id = ?)|;
1241
1242   $sth = prepare_execute_query($::form, $dbh, $query, $login, $self->client->{id});
1243
1244   while ($row = $sth->fetchrow_hashref()) {
1245     $rights->{$row->{right}} |= $row->{granted};
1246   }
1247   $sth->finish();
1248
1249   return $rights;
1250 }
1251
1252 1;
1253 __END__
1254
1255 =pod
1256
1257 =encoding utf8
1258
1259 =head1 NAME
1260
1261 SL::Auth - Authentication and session handling
1262
1263 =head1 METHODS
1264
1265 =over 4
1266
1267 =item C<set_session_value @values>
1268
1269 =item C<set_session_value %values>
1270
1271 Store all values of C<@values> or C<%values> in the session. Each
1272 member of C<@values> is tested if it is a hash reference. If it is
1273 then it must contain the keys C<key> and C<value> and can optionally
1274 contain the key C<auto_restore>. In this case C<value> is associated
1275 with C<key> and restored to C<$::form> upon the next request
1276 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1277 value.
1278
1279 If the current member of C<@values> is not a hash reference then it
1280 will be used as the C<key> and the next entry of C<@values> is used as
1281 the C<value> to store. In this case setting C<auto_restore> is not
1282 possible.
1283
1284 Therefore the following two invocations are identical:
1285
1286   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1287   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1288
1289 All of these values are copied back into C<$::form> for the next
1290 request automatically if they're scalar values or if they have
1291 C<auto_restore> set to trueish.
1292
1293 The values can be any Perl structure. They are stored as YAML dumps.
1294
1295 =item C<get_session_value $key>
1296
1297 Retrieve a value from the session. Returns C<undef> if the value
1298 doesn't exist.
1299
1300 =item C<create_unique_sesion_value $value, %params>
1301
1302 Create a unique key in the session and store C<$value>
1303 there.
1304
1305 Returns the key created in the session.
1306
1307 =item C<save_session>
1308
1309 Stores the session values in the database. This is the only function
1310 that actually stores stuff in the database. Neither the various
1311 setters nor the deleter access the database.
1312
1313 =item C<save_form_in_session %params>
1314
1315 Stores the content of C<$params{form}> (default: C<$::form>) in the
1316 session using L</create_unique_sesion_value>.
1317
1318 If C<$params{non_scalars}> is trueish then non-scalar values will be
1319 stored as well. Default is to only store scalar values.
1320
1321 The following keys will never be saved: C<login>, C<password>,
1322 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1323 can be given as an array ref in C<$params{skip_keys}>.
1324
1325 Returns the unique key under which the form is stored.
1326
1327 =item C<restore_form_from_session $key, %params>
1328
1329 Restores the form from the session into C<$params{form}> (default:
1330 C<$::form>).
1331
1332 If C<$params{clobber}> is falsish then existing values with the same
1333 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1334 is on by default.
1335
1336 Returns C<$self>.
1337
1338 =item C<reset>
1339
1340 C<reset> deletes every state information from previous requests, but does not
1341 close the database connection.
1342
1343 Creating a new database handle on each request can take up to 30% of the
1344 pre-request startup time, so we want to avoid that for fast ajax calls.
1345
1346 =back
1347
1348 =head1 BUGS
1349
1350 Nothing here yet.
1351
1352 =head1 AUTHOR
1353
1354 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1355
1356 =cut