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