Revert "Recht für Anzeige der Produktivität"
[kivitendo-erp.git] / 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 kivitendo 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   # The 'Win2000.css' stylesheet has been removed.
497   $user_data{stylesheet} = 'kivitendo.css' if ($user_data{stylesheet} || '') =~ m/win2000/i;
498
499   # Set default language if selected language does not exist (anymore).
500   $user_data{countrycode} = $::lx_office_conf{system}->{language} unless $user_data{countrycode} && -d "locale/$user_data{countrycode}";
501
502   $sth->finish();
503
504   $main::lxdebug->leave_sub();
505
506   return %user_data;
507 }
508
509 sub get_user_id {
510   $main::lxdebug->enter_sub();
511
512   my $self  = shift;
513   my $login = shift;
514
515   my $dbh   = $self->dbconnect();
516   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
517
518   $main::lxdebug->leave_sub();
519
520   return $id;
521 }
522
523 sub delete_user {
524   $::lxdebug->enter_sub;
525
526   my $self  = shift;
527   my $login = shift;
528
529   my $dbh   = $self->dbconnect;
530   my $id    = $self->get_user_id($login);
531   my $user_db_exists;
532
533   $dbh->rollback and return $::lxdebug->leave_sub if (!$id);
534
535   my $u_dbh = $self->get_user_dbh($login, may_fail => 1);
536   $user_db_exists = $self->check_tables($u_dbh) if $u_dbh;
537
538   $u_dbh->begin_work if $u_dbh && $user_db_exists;
539
540   $dbh->begin_work;
541
542   do_query($::form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
543   do_query($::form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
544   do_query($::form, $dbh, qq|DELETE FROM auth.user WHERE id = ?|, $id);
545   do_query($::form, $u_dbh, qq|UPDATE employee SET deleted = 't' WHERE login = ?|, $login) if $u_dbh && $user_db_exists;
546
547   $dbh->commit;
548   $u_dbh->commit if $u_dbh && $user_db_exists;
549
550   $::lxdebug->leave_sub;
551 }
552
553 # --------------------------------------
554
555 my $session_id;
556
557 sub restore_session {
558   $main::lxdebug->enter_sub();
559
560   my $self = shift;
561
562   $session_id        =  $::request->{cgi}->cookie($self->get_session_cookie_name());
563   $session_id        =~ s|[^0-9a-f]||g if $session_id;
564
565   $self->{SESSION}   = { };
566
567   if (!$session_id) {
568     $main::lxdebug->leave_sub();
569     return SESSION_NONE;
570   }
571
572   my ($dbh, $query, $sth, $cookie, $ref, $form);
573
574   $form   = $main::form;
575
576   # Don't fail if the auth DB doesn't yet.
577   if (!( $dbh = $self->dbconnect(1) )) {
578     $::lxdebug->leave_sub;
579     return SESSION_NONE;
580   }
581
582   # Don't fail if the "auth" schema doesn't exist yet, e.g. if the
583   # admin is creating the session tables at the moment.
584   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
585
586   if (!($sth = $dbh->prepare($query)) || !$sth->execute($session_id)) {
587     $sth->finish if $sth;
588     $::lxdebug->leave_sub;
589     return SESSION_NONE;
590   }
591
592   $cookie = $sth->fetchrow_hashref;
593   $sth->finish;
594
595   # The session ID provided is valid in the following cases:
596   #  1. session ID exists in the database
597   #  2. hasn't expired yet
598   #  3. if form field '{AUTH}api_token' is given: form field must equal database column 'auth.session.api_token' for the session ID
599   #  4. if form field '{AUTH}api_token' is NOT given then: the requestee's IP address must match the stored IP address
600   $self->{api_token}   = $cookie->{api_token} if $cookie;
601   my $api_token_cookie = $self->get_api_token_cookie;
602   my $cookie_is_bad    = !$cookie || $cookie->{is_expired};
603   $cookie_is_bad     ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if  $api_token_cookie;
604   $cookie_is_bad     ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR}                       if !$api_token_cookie;
605   if ($cookie_is_bad) {
606     $self->destroy_session();
607     $main::lxdebug->leave_sub();
608     return $cookie ? SESSION_EXPIRED : SESSION_NONE;
609   }
610
611   if ($self->{column_information}->has('auto_restore')) {
612     $self->_load_with_auto_restore_column($dbh, $session_id);
613   } else {
614     $self->_load_without_auto_restore_column($dbh, $session_id);
615   }
616
617   $main::lxdebug->leave_sub();
618
619   return SESSION_OK;
620 }
621
622 sub _load_without_auto_restore_column {
623   my ($self, $dbh, $session_id) = @_;
624
625   my $query = <<SQL;
626     SELECT sess_key, sess_value
627     FROM auth.session_content
628     WHERE (session_id = ?)
629 SQL
630   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
631
632   while (my $ref = $sth->fetchrow_hashref) {
633     my $value = SL::Auth::SessionValue->new(auth  => $self,
634                                             key   => $ref->{sess_key},
635                                             value => $ref->{sess_value},
636                                             raw   => 1);
637     $self->{SESSION}->{ $ref->{sess_key} } = $value;
638
639     next if defined $::form->{$ref->{sess_key}};
640
641     my $data                    = $value->get;
642     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
643   }
644 }
645
646 sub _load_with_auto_restore_column {
647   my ($self, $dbh, $session_id) = @_;
648
649   my $auto_restore_keys = join ', ', map { "'${_}'" } qw(login password rpw);
650
651   my $query = <<SQL;
652     SELECT sess_key, sess_value, auto_restore
653     FROM auth.session_content
654     WHERE (session_id = ?)
655       AND (   auto_restore
656            OR sess_key IN (${auto_restore_keys}))
657 SQL
658   my $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
659
660   while (my $ref = $sth->fetchrow_hashref) {
661     my $value = SL::Auth::SessionValue->new(auth         => $self,
662                                             key          => $ref->{sess_key},
663                                             value        => $ref->{sess_value},
664                                             auto_restore => $ref->{auto_restore},
665                                             raw          => 1);
666     $self->{SESSION}->{ $ref->{sess_key} } = $value;
667
668     next if defined $::form->{$ref->{sess_key}};
669
670     my $data                    = $value->get;
671     $::form->{$ref->{sess_key}} = $data if $value->{auto_restore} || !ref $data;
672   }
673
674   $sth->finish;
675
676   $query = <<SQL;
677     SELECT sess_key
678     FROM auth.session_content
679     WHERE (session_id = ?)
680       AND NOT COALESCE(auto_restore, FALSE)
681       AND (sess_key NOT IN (${auto_restore_keys}))
682 SQL
683   $sth = prepare_execute_query($::form, $dbh, $query, $session_id);
684
685   while (my $ref = $sth->fetchrow_hashref) {
686     my $value = SL::Auth::SessionValue->new(auth => $self,
687                                             key  => $ref->{sess_key});
688     $self->{SESSION}->{ $ref->{sess_key} } = $value;
689   }
690 }
691
692 sub destroy_session {
693   $main::lxdebug->enter_sub();
694
695   my $self = shift;
696
697   if ($session_id) {
698     my $dbh = $self->dbconnect();
699
700     $dbh->begin_work;
701
702     do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
703     do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
704
705     $dbh->commit();
706
707     SL::SessionFile->destroy_session($session_id);
708
709     $session_id      = undef;
710     $self->{SESSION} = { };
711   }
712
713   $main::lxdebug->leave_sub();
714 }
715
716 sub active_session_ids {
717   my $self  = shift;
718   my $dbh   = $self->dbconnect;
719
720   my $query = qq|SELECT id FROM auth.session|;
721
722   my @ids   = selectall_array_query($::form, $dbh, $query);
723
724   return @ids;
725 }
726
727 sub expire_sessions {
728   $main::lxdebug->enter_sub();
729
730   my $self  = shift;
731
732   $main::lxdebug->leave_sub and return if !$self->session_tables_present;
733
734   my $dbh   = $self->dbconnect();
735
736   my $query = qq|SELECT id
737                  FROM auth.session
738                  WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
739
740   my @ids   = selectall_array_query($::form, $dbh, $query);
741
742   if (@ids) {
743     $dbh->begin_work;
744
745     SL::SessionFile->destroy_session($_) for @ids;
746
747     $query = qq|DELETE FROM auth.session_content
748                 WHERE session_id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
749     do_query($main::form, $dbh, $query, @ids);
750
751     $query = qq|DELETE FROM auth.session
752                 WHERE id IN (| . join(', ', ('?') x scalar(@ids)) . qq|)|;
753     do_query($main::form, $dbh, $query, @ids);
754
755     $dbh->commit();
756   }
757
758   $main::lxdebug->leave_sub();
759 }
760
761 sub _create_session_id {
762   $main::lxdebug->enter_sub();
763
764   my @data;
765   map { push @data, int(rand() * 255); } (1..32);
766
767   my $id = md5_hex(pack 'C*', @data);
768
769   $main::lxdebug->leave_sub();
770
771   return $id;
772 }
773
774 sub create_or_refresh_session {
775   $session_id ||= shift->_create_session_id;
776 }
777
778 sub save_session {
779   $::lxdebug->enter_sub;
780   my $self         = shift;
781   my $provided_dbh = shift;
782
783   my $dbh          = $provided_dbh || $self->dbconnect(1);
784
785   $::lxdebug->leave_sub && return unless $dbh && $session_id;
786
787   $dbh->begin_work unless $provided_dbh;
788
789   # If this fails then the "auth" schema might not exist yet, e.g. if
790   # the admin is just trying to create the auth database.
791   if (!$dbh->do(qq|LOCK auth.session_content|)) {
792     $dbh->rollback unless $provided_dbh;
793     $::lxdebug->leave_sub;
794     return;
795   }
796
797   my @unfetched_keys = map     { $_->{key}        }
798                        grep    { ! $_->{fetched}  }
799                        values %{ $self->{SESSION} };
800   # $::lxdebug->dump(0, "unfetched_keys", [ sort @unfetched_keys ]);
801   # $::lxdebug->dump(0, "all keys", [ sort map { $_->{key} } values %{ $self->{SESSION} } ]);
802   my $query          = qq|DELETE FROM auth.session_content WHERE (session_id = ?)|;
803   $query            .= qq| AND (sess_key NOT IN (| . join(', ', ('?') x scalar @unfetched_keys) . qq|))| if @unfetched_keys;
804
805   do_query($::form, $dbh, $query, $session_id, @unfetched_keys);
806
807   my ($id) = selectrow_query($::form, $dbh, qq|SELECT id FROM auth.session WHERE id = ?|, $session_id);
808
809   if ($id) {
810     do_query($::form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
811   } else {
812     do_query($::form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
813   }
814
815   if ($self->{column_information}->has('api_token', 'session')) {
816     my ($stored_api_token) = $dbh->selectrow_array(qq|SELECT api_token FROM auth.session WHERE id = ?|, undef, $session_id);
817     do_query($::form, $dbh, qq|UPDATE auth.session SET api_token = ? WHERE id = ?|, $self->_create_session_id, $session_id) unless $stored_api_token;
818   }
819
820   my @values_to_save = grep    { $_->{fetched} }
821                        values %{ $self->{SESSION} };
822   if (@values_to_save) {
823     my ($columns, $placeholders) = ('', '');
824     my $auto_restore             = $self->{column_information}->has('auto_restore');
825
826     if ($auto_restore) {
827       $columns      .= ', auto_restore';
828       $placeholders .= ', ?';
829     }
830
831     $query  = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value ${columns}) VALUES (?, ?, ? ${placeholders})|;
832     my $sth = prepare_query($::form, $dbh, $query);
833
834     foreach my $value (@values_to_save) {
835       my @values = ($value->{key}, $value->get_dumped);
836       push @values, $value->{auto_restore} if $auto_restore;
837
838       do_statement($::form, $sth, $query, $session_id, @values);
839     }
840
841     $sth->finish();
842   }
843
844   $dbh->commit() unless $provided_dbh;
845   $::lxdebug->leave_sub;
846 }
847
848 sub set_session_value {
849   $main::lxdebug->enter_sub();
850
851   my $self   = shift;
852   my @params = @_;
853
854   $self->{SESSION} ||= { };
855
856   while (@params) {
857     my $key = shift @params;
858
859     if (ref $key eq 'HASH') {
860       $self->{SESSION}->{ $key->{key} } = SL::Auth::SessionValue->new(key          => $key->{key},
861                                                                       value        => $key->{value},
862                                                                       auto_restore => $key->{auto_restore});
863
864     } else {
865       my $value = shift @params;
866       $self->{SESSION}->{ $key } = SL::Auth::SessionValue->new(key   => $key,
867                                                                value => $value);
868     }
869   }
870
871   $main::lxdebug->leave_sub();
872
873   return $self;
874 }
875
876 sub delete_session_value {
877   $main::lxdebug->enter_sub();
878
879   my $self = shift;
880
881   $self->{SESSION} ||= { };
882   delete @{ $self->{SESSION} }{ @_ };
883
884   $main::lxdebug->leave_sub();
885
886   return $self;
887 }
888
889 sub get_session_value {
890   $main::lxdebug->enter_sub();
891
892   my $self = shift;
893   my $data = $self->{SESSION} && $self->{SESSION}->{ $_[0] } ? $self->{SESSION}->{ $_[0] }->get : undef;
894
895   $main::lxdebug->leave_sub();
896
897   return $data;
898 }
899
900 sub create_unique_sesion_value {
901   my ($self, $value, %params) = @_;
902
903   $self->{SESSION} ||= { };
904
905   my @now                   = gettimeofday();
906   my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";
907   $self->{unique_counter} ||= 0;
908
909   my $hashed_key;
910   do {
911     $self->{unique_counter}++;
912     $hashed_key = md5_hex($key . $self->{unique_counter});
913   } while (exists $self->{SESSION}->{$hashed_key});
914
915   $self->set_session_value($hashed_key => $value);
916
917   return $hashed_key;
918 }
919
920 sub save_form_in_session {
921   my ($self, %params) = @_;
922
923   my $form        = delete($params{form}) || $::form;
924   my $non_scalars = delete $params{non_scalars};
925   my $data        = {};
926
927   my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });
928
929   foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {
930     $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;
931   }
932
933   return $self->create_unique_sesion_value($data, %params);
934 }
935
936 sub restore_form_from_session {
937   my ($self, $key, %params) = @_;
938
939   my $data = $self->get_session_value($key);
940   return $self unless $data;
941
942   my $form    = delete($params{form}) || $::form;
943   my $clobber = exists $params{clobber} ? $params{clobber} : 1;
944
945   map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };
946
947   return $self;
948 }
949
950 sub set_cookie_environment_variable {
951   my $self = shift;
952   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
953 }
954
955 sub get_session_cookie_name {
956   my ($self, %params) = @_;
957
958   $params{type}     ||= 'id';
959   my $name            = $self->{cookie_name} || 'lx_office_erp_session_id';
960   $name              .= '_api_token' if $params{type} eq 'api_token';
961
962   return $name;
963 }
964
965 sub get_session_id {
966   return $session_id;
967 }
968
969 sub get_api_token_cookie {
970   my ($self) = @_;
971
972   $::request->{cgi}->cookie($self->get_session_cookie_name(type => 'api_token'));
973 }
974
975 sub session_tables_present {
976   $main::lxdebug->enter_sub();
977
978   my $self = shift;
979
980   # Only re-check for the presence of auth tables if either the check
981   # hasn't been done before of if they weren't present.
982   if ($self->{session_tables_present}) {
983     $main::lxdebug->leave_sub();
984     return $self->{session_tables_present};
985   }
986
987   my $dbh  = $self->dbconnect(1);
988
989   if (!$dbh) {
990     $main::lxdebug->leave_sub();
991     return 0;
992   }
993
994   my $query =
995     qq|SELECT COUNT(*)
996        FROM pg_tables
997        WHERE (schemaname = 'auth')
998          AND (tablename IN ('session', 'session_content'))|;
999
1000   my ($count) = selectrow_query($main::form, $dbh, $query);
1001
1002   $self->{session_tables_present} = 2 == $count;
1003
1004   $main::lxdebug->leave_sub();
1005
1006   return $self->{session_tables_present};
1007 }
1008
1009 # --------------------------------------
1010
1011 sub all_rights_full {
1012   my $locale = $main::locale;
1013
1014   my @all_rights = (
1015     ["--crm",                          $locale->text("CRM optional software")],
1016     ["crm_search",                     $locale->text("CRM search")],
1017     ["crm_new",                        $locale->text("CRM create customers, vendors and contacts")],
1018     ["crm_service",                    $locale->text("CRM services")],
1019     ["crm_admin",                      $locale->text("CRM admin")],
1020     ["crm_adminuser",                  $locale->text("CRM user")],
1021     ["crm_adminstatus",                $locale->text("CRM status")],
1022     ["crm_email",                      $locale->text("CRM send email")],
1023     ["crm_termin",                     $locale->text("CRM termin")],
1024     ["crm_opportunity",                $locale->text("CRM opportunity")],
1025     ["crm_knowhow",                    $locale->text("CRM know how")],
1026     ["crm_follow",                     $locale->text("CRM follow up")],
1027     ["crm_notices",                    $locale->text("CRM notices")],
1028     ["crm_other",                      $locale->text("CRM other")],
1029     ["--master_data",                  $locale->text("Master Data")],
1030     ["customer_vendor_edit",           $locale->text("Create customers and vendors. Edit all vendors. Edit only customers where salesman equals employee (login)")],
1031     ["customer_vendor_all_edit",       $locale->text("Create customers and vendors. Edit all vendors. Edit all customers")],
1032     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
1033     ["project_edit",                   $locale->text("Create and edit projects")],
1034     ["--ar",                           $locale->text("AR")],
1035     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
1036     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
1037     ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
1038     ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
1039     ["dunning_edit",                   $locale->text("Create and edit dunnings")],
1040     ["sales_all_edit",                 $locale->text("View/edit all employees sales documents")],
1041     ["edit_prices",                    $locale->text("Edit prices and discount (if not used, textfield is ONLY set readonly)")],
1042     ["--ap",                           $locale->text("AP")],
1043     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
1044     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
1045     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
1046     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
1047     ["--warehouse_management",         $locale->text("Warehouse management")],
1048     ["warehouse_contents",             $locale->text("View warehouse content")],
1049     ["warehouse_management",           $locale->text("Warehouse management")],
1050     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
1051     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
1052     ["datev_export",                   $locale->text("DATEV Export")],
1053     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
1054     ["--reports",                      $locale->text('Reports')],
1055     ["report",                         $locale->text('All reports')],
1056     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
1057     ["--batch_printing",               $locale->text("Batch Printing")],
1058     ["batch_printing",                 $locale->text("Batch Printing")],
1059     ["--others",                       $locale->text("Others")],
1060     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
1061     ["config",                         $locale->text("Change kivitendo installation settings (all menu entries beneath 'System')")],
1062     ["admin",                          $locale->text("Administration (Used to access instance administration from user logins)")],
1063     );
1064
1065   return @all_rights;
1066 }
1067
1068 sub all_rights {
1069   return grep !/^--/, map { $_->[0] } all_rights_full();
1070 }
1071
1072 sub read_groups {
1073   $main::lxdebug->enter_sub();
1074
1075   my $self = shift;
1076
1077   my $form   = $main::form;
1078   my $groups = {};
1079   my $dbh    = $self->dbconnect();
1080
1081   my $query  = 'SELECT * FROM auth."group"';
1082   my $sth    = prepare_execute_query($form, $dbh, $query);
1083
1084   my ($row, $group);
1085
1086   while ($row = $sth->fetchrow_hashref()) {
1087     $groups->{$row->{id}} = $row;
1088   }
1089   $sth->finish();
1090
1091   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
1092   $sth   = prepare_query($form, $dbh, $query);
1093
1094   foreach $group (values %{$groups}) {
1095     my @members;
1096
1097     do_statement($form, $sth, $query, $group->{id});
1098
1099     while ($row = $sth->fetchrow_hashref()) {
1100       push @members, $row->{user_id};
1101     }
1102     $group->{members} = [ uniq @members ];
1103   }
1104   $sth->finish();
1105
1106   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
1107   $sth   = prepare_query($form, $dbh, $query);
1108
1109   foreach $group (values %{$groups}) {
1110     $group->{rights} = {};
1111
1112     do_statement($form, $sth, $query, $group->{id});
1113
1114     while ($row = $sth->fetchrow_hashref()) {
1115       $group->{rights}->{$row->{right}} |= $row->{granted};
1116     }
1117
1118     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
1119   }
1120   $sth->finish();
1121
1122   $main::lxdebug->leave_sub();
1123
1124   return $groups;
1125 }
1126
1127 sub save_group {
1128   $main::lxdebug->enter_sub();
1129
1130   my $self  = shift;
1131   my $group = shift;
1132
1133   my $form  = $main::form;
1134   my $dbh   = $self->dbconnect();
1135
1136   $dbh->begin_work;
1137
1138   my ($query, $sth, $row, $rights);
1139
1140   if (!$group->{id}) {
1141     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
1142
1143     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
1144     do_query($form, $dbh, $query, $group->{id});
1145   }
1146
1147   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
1148
1149   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
1150
1151   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
1152   $sth    = prepare_query($form, $dbh, $query);
1153
1154   foreach my $user_id (uniq @{ $group->{members} }) {
1155     do_statement($form, $sth, $query, $user_id, $group->{id});
1156   }
1157   $sth->finish();
1158
1159   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
1160
1161   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
1162   $sth   = prepare_query($form, $dbh, $query);
1163
1164   foreach my $right (keys %{ $group->{rights} }) {
1165     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
1166   }
1167   $sth->finish();
1168
1169   $dbh->commit();
1170
1171   $main::lxdebug->leave_sub();
1172 }
1173
1174 sub delete_group {
1175   $main::lxdebug->enter_sub();
1176
1177   my $self = shift;
1178   my $id   = shift;
1179
1180   my $form = $main::form;
1181
1182   my $dbh  = $self->dbconnect();
1183   $dbh->begin_work;
1184
1185   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
1186   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
1187   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
1188
1189   $dbh->commit();
1190
1191   $main::lxdebug->leave_sub();
1192 }
1193
1194 sub evaluate_rights_ary {
1195   $main::lxdebug->enter_sub(2);
1196
1197   my $ary    = shift;
1198
1199   my $value  = 0;
1200   my $action = '|';
1201
1202   foreach my $el (@{$ary}) {
1203     if (ref $el eq "ARRAY") {
1204       if ($action eq '|') {
1205         $value |= evaluate_rights_ary($el);
1206       } else {
1207         $value &= evaluate_rights_ary($el);
1208       }
1209
1210     } elsif (($el eq '&') || ($el eq '|')) {
1211       $action = $el;
1212
1213     } elsif ($action eq '|') {
1214       $value |= $el;
1215
1216     } else {
1217       $value &= $el;
1218
1219     }
1220   }
1221
1222   $main::lxdebug->leave_sub(2);
1223
1224   return $value;
1225 }
1226
1227 sub _parse_rights_string {
1228   $main::lxdebug->enter_sub(2);
1229
1230   my $self   = shift;
1231
1232   my $login  = shift;
1233   my $access = shift;
1234
1235   my @stack;
1236   my $cur_ary = [];
1237
1238   push @stack, $cur_ary;
1239
1240   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
1241     my $token = $1;
1242     substr($access, 0, length $1) = "";
1243
1244     next if ($token =~ /\s/);
1245
1246     if ($token eq "(") {
1247       my $new_cur_ary = [];
1248       push @stack, $new_cur_ary;
1249       push @{$cur_ary}, $new_cur_ary;
1250       $cur_ary = $new_cur_ary;
1251
1252     } elsif ($token eq ")") {
1253       pop @stack;
1254
1255       if (!@stack) {
1256         $main::lxdebug->leave_sub(2);
1257         return 0;
1258       }
1259
1260       $cur_ary = $stack[-1];
1261
1262     } elsif (($token eq "|") || ($token eq "&")) {
1263       push @{$cur_ary}, $token;
1264
1265     } else {
1266       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
1267     }
1268   }
1269
1270   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
1271
1272   $main::lxdebug->leave_sub(2);
1273
1274   return $result;
1275 }
1276
1277 sub check_right {
1278   $main::lxdebug->enter_sub(2);
1279
1280   my $self    = shift;
1281   my $login   = shift;
1282   my $right   = shift;
1283   my $default = shift;
1284
1285   $self->{FULL_RIGHTS}           ||= { };
1286   $self->{FULL_RIGHTS}->{$login} ||= { };
1287
1288   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
1289     $self->{RIGHTS}           ||= { };
1290     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
1291
1292     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
1293   }
1294
1295   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
1296   $granted    = $default if (!defined $granted);
1297
1298   $main::lxdebug->leave_sub(2);
1299
1300   return $granted;
1301 }
1302
1303 sub assert {
1304   $::lxdebug->enter_sub(2);
1305   my ($self, $right, $dont_abort) = @_;
1306
1307   if ($self->check_right($::myconfig{login}, $right)) {
1308     $::lxdebug->leave_sub(2);
1309     return 1;
1310   }
1311
1312   if (!$dont_abort) {
1313     delete $::form->{title};
1314     $::form->show_generic_error($::locale->text("You do not have the permissions to access this function."));
1315   }
1316
1317   $::lxdebug->leave_sub(2);
1318
1319   return 0;
1320 }
1321
1322 sub load_rights_for_user {
1323   $::lxdebug->enter_sub;
1324
1325   my ($self, $login) = @_;
1326   my $dbh   = $self->dbconnect;
1327   my ($query, $sth, $row, $rights);
1328
1329   $rights = { map { $_ => 0 } all_rights() };
1330
1331   $query =
1332     qq|SELECT gr."right", gr.granted
1333        FROM auth.group_rights gr
1334        WHERE group_id IN
1335          (SELECT ug.group_id
1336           FROM auth.user_group ug
1337           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
1338           WHERE u.login = ?)|;
1339
1340   $sth = prepare_execute_query($::form, $dbh, $query, $login);
1341
1342   while ($row = $sth->fetchrow_hashref()) {
1343     $rights->{$row->{right}} |= $row->{granted};
1344   }
1345   $sth->finish();
1346
1347   $::lxdebug->leave_sub;
1348
1349   return $rights;
1350 }
1351
1352 1;
1353 __END__
1354
1355 =pod
1356
1357 =encoding utf8
1358
1359 =head1 NAME
1360
1361 SL::Auth - Authentication and session handling
1362
1363 =head1 FUNCTIONS
1364
1365 =over 4
1366
1367 =item C<set_session_value @values>
1368
1369 =item C<set_session_value %values>
1370
1371 Store all values of C<@values> or C<%values> in the session. Each
1372 member of C<@values> is tested if it is a hash reference. If it is
1373 then it must contain the keys C<key> and C<value> and can optionally
1374 contain the key C<auto_restore>. In this case C<value> is associated
1375 with C<key> and restored to C<$::form> upon the next request
1376 automatically if C<auto_restore> is trueish or if C<value> is a scalar
1377 value.
1378
1379 If the current member of C<@values> is not a hash reference then it
1380 will be used as the C<key> and the next entry of C<@values> is used as
1381 the C<value> to store. In this case setting C<auto_restore> is not
1382 possible.
1383
1384 Therefore the following two invocations are identical:
1385
1386   $::auth-E<gt>set_session_value(name =E<gt> "Charlie");
1387   $::auth-E<gt>set_session_value({ key =E<gt> "name", value =E<gt> "Charlie" });
1388
1389 All of these values are copied back into C<$::form> for the next
1390 request automatically if they're scalar values or if they have
1391 C<auto_restore> set to trueish.
1392
1393 The values can be any Perl structure. They are stored as YAML dumps.
1394
1395 =item C<get_session_value $key>
1396
1397 Retrieve a value from the session. Returns C<undef> if the value
1398 doesn't exist.
1399
1400 =item C<create_unique_sesion_value $value, %params>
1401
1402 Create a unique key in the session and store C<$value>
1403 there.
1404
1405 Returns the key created in the session.
1406
1407 =item C<save_session>
1408
1409 Stores the session values in the database. This is the only function
1410 that actually stores stuff in the database. Neither the various
1411 setters nor the deleter access the database.
1412
1413 =item <save_form_in_session %params>
1414
1415 Stores the content of C<$params{form}> (default: C<$::form>) in the
1416 session using L</create_unique_sesion_value>.
1417
1418 If C<$params{non_scalars}> is trueish then non-scalar values will be
1419 stored as well. Default is to only store scalar values.
1420
1421 The following keys will never be saved: C<login>, C<password>,
1422 C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save
1423 can be given as an array ref in C<$params{skip_keys}>.
1424
1425 Returns the unique key under which the form is stored.
1426
1427 =item <restore_form_from_session $key, %params>
1428
1429 Restores the form from the session into C<$params{form}> (default:
1430 C<$::form>).
1431
1432 If C<$params{clobber}> is falsish then existing values with the same
1433 key in C<$params{form}> will not be overwritten. C<$params{clobber}>
1434 is on by default.
1435
1436 Returns C<$self>.
1437
1438 =back
1439
1440 =head1 BUGS
1441
1442 Nothing here yet.
1443
1444 =head1 AUTHOR
1445
1446 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
1447
1448 =cut