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