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