98f1994f91679e85efac1ff4bb3291b5eaaf4138
[kivitendo-erp.git] / SL / Auth.pm
1 package SL::Auth;
2
3 use constant OK              =>   0;
4 use constant ERR_PASSWORD    =>   1;
5 use constant ERR_BACKEND     => 100;
6
7 use constant SESSION_OK      =>   0;
8 use constant SESSION_NONE    =>   1;
9 use constant SESSION_EXPIRED =>   2;
10
11 use Digest::MD5 qw(md5_hex);
12 use IO::File;
13 use Time::HiRes qw(gettimeofday);
14
15 use SL::Auth::DB;
16 use SL::Auth::LDAP;
17
18 use SL::User;
19 use SL::DBUtils;
20
21 sub new {
22   $main::lxdebug->enter_sub();
23
24   my $type = shift;
25   my $self = {};
26
27   bless $self, $type;
28
29   $self->{SESSION} = { };
30
31   $self->_read_auth_config();
32
33   $main::lxdebug->leave_sub();
34
35   return $self;
36 }
37
38 sub DESTROY {
39   my $self = shift;
40
41   $self->{dbh}->disconnect() if ($self->{dbh});
42 }
43
44 sub _read_auth_config {
45   $main::lxdebug->enter_sub();
46
47   my $self   = shift;
48
49   my $form   = $main::form;
50   my $locale = $main::locale;
51
52   my $code;
53   my $in = IO::File->new('config/authentication.pl', 'r');
54
55   if (!$in) {
56     $form->error($locale->text('The config file "config/authentication.pl" was not found.'));
57   }
58
59   while (<$in>) {
60     $code .= $_;
61   }
62   $in->close();
63
64   eval $code;
65
66   if ($@) {
67     $form->error($locale->text('The config file "config/authentication.pl" contained invalid Perl code:') . "\n" . $@);
68   }
69
70   if ($self->{module} eq 'DB') {
71     $self->{authenticator} = SL::Auth::DB->new($self);
72
73   } elsif ($self->{module} eq 'LDAP') {
74     $self->{authenticator} = SL::Auth::LDAP->new($self);
75   }
76
77   if (!$self->{authenticator}) {
78     $form->error($locale->text('No or an unknown authenticantion module specified in "config/authentication.pl".'));
79   }
80
81   my $cfg = $self->{DB_config};
82
83   if (!$cfg) {
84     $form->error($locale->text('config/authentication.pl: Key "DB_config" is missing.'));
85   }
86
87   if (!$cfg->{host} || !$cfg->{db} || !$cfg->{user}) {
88     $form->error($locale->text('config/authentication.pl: Missing parameters in "DB_config". Required parameters are "host", "db" and "user".'));
89   }
90
91   $self->{authenticator}->verify_config();
92
93   $self->{session_timeout} *= 1;
94   $self->{session_timeout}  = 8 * 60 if (!$self->{session_timeout});
95
96   $main::lxdebug->leave_sub();
97 }
98
99 sub authenticate_root {
100   $main::lxdebug->enter_sub();
101
102   my $self           = shift;
103   my $password       = shift;
104   my $is_crypted     = shift;
105
106   $password          = crypt $password, 'ro' if (!$password || !$is_crypted);
107   my $admin_password = crypt "$self->{admin_password}", 'ro';
108
109   $main::lxdebug->leave_sub();
110
111   return $password eq $admin_password ? OK : ERR_PASSWORD;
112 }
113
114 sub authenticate {
115   $main::lxdebug->enter_sub();
116
117   my $self = shift;
118
119   $main::lxdebug->leave_sub();
120
121   return $self->{authenticator}->authenticate(@_);
122 }
123
124 sub dbconnect {
125   $main::lxdebug->enter_sub();
126
127   my $self     = shift;
128   my $may_fail = shift;
129
130   if ($self->{dbh}) {
131     $main::lxdebug->leave_sub();
132     return $self->{dbh};
133   }
134
135   my $cfg = $self->{DB_config};
136   my $dsn = 'dbi:Pg:dbname=' . $cfg->{db} . ';host=' . $cfg->{host};
137
138   if ($cfg->{port}) {
139     $dsn .= ';port=' . $cfg->{port};
140   }
141
142   $main::lxdebug->message(LXDebug::DEBUG1, "Auth::dbconnect DSN: $dsn");
143
144   $self->{dbh} = DBI->connect($dsn, $cfg->{user}, $cfg->{password}, { 'AutoCommit' => 0 });
145
146   if (!$may_fail && !$self->{dbh}) {
147     $main::form->error($main::locale->text('The connection to the authentication database failed:') . "\n" . $DBI::errstr);
148   }
149
150   $main::lxdebug->leave_sub();
151
152   return $self->{dbh};
153 }
154
155 sub dbdisconnect {
156   $main::lxdebug->enter_sub();
157
158   my $self = shift;
159
160   if ($self->{dbh}) {
161     $self->{dbh}->disconnect();
162     delete $self->{dbh};
163   }
164
165   $main::lxdebug->leave_sub();
166 }
167
168 sub check_tables {
169   $main::lxdebug->enter_sub();
170
171   my $self    = shift;
172
173   my $dbh     = $self->dbconnect();
174   my $query   = qq|SELECT COUNT(*) FROM pg_tables WHERE (schemaname = 'auth') AND (tablename = 'user')|;
175
176   my ($count) = $dbh->selectrow_array($query);
177
178   $main::lxdebug->leave_sub();
179
180   return $count > 0;
181 }
182
183 sub check_database {
184   $main::lxdebug->enter_sub();
185
186   my $self = shift;
187
188   my $dbh  = $self->dbconnect(1);
189
190   $main::lxdebug->leave_sub();
191
192   return $dbh ? 1 : 0;
193 }
194
195 sub create_database {
196   $main::lxdebug->enter_sub();
197
198   my $self   = shift;
199   my %params = @_;
200
201   my $cfg    = $self->{DB_config};
202
203   if (!$params{superuser}) {
204     $params{superuser}          = $cfg->{user};
205     $params{superuser_password} = $cfg->{password};
206   }
207
208   $params{template} ||= 'template0';
209   $params{template}   =~ s|[^a-zA-Z0-9_\-]||g;
210
211   my $dsn = 'dbi:Pg:dbname=template1;host=' . $cfg->{host};
212
213   if ($cfg->{port}) {
214     $dsn .= ';port=' . $cfg->{port};
215   }
216
217   $main::lxdebug->message(LXDebug::DEBUG1, "Auth::create_database DSN: $dsn");
218
219   my $dbh = DBI->connect($dsn, $params{superuser}, $params{superuser_password});
220
221   if (!$dbh) {
222     $main::form->error($main::locale->text('The connection to the template database failed:') . "\n" . $DBI::errstr);
223   }
224
225   my $charset    = $main::charset;
226   $charset     ||= Common::DEFAULT_CHARSET;
227   my $encoding   = $Common::charset_to_db_encoding{$charset};
228   $encoding    ||= 'UNICODE';
229
230   my $query = qq|CREATE DATABASE "$cfg->{db}" OWNER "$cfg->{user}" TEMPLATE "$params{template}" ENCODING '$encoding'|;
231
232   $main::lxdebug->message(LXDebug::DEBUG1, "Auth::create_database query: $query");
233
234   $dbh->do($query);
235
236   if ($dbh->err) {
237     $dbh->disconnect();
238
239     $main::form->error($main::locale->text('The creation of the authentication database failed:') . "\n" . $DBI::errstr);
240   }
241
242   $dbh->disconnect();
243
244   $main::lxdebug->leave_sub();
245 }
246
247 sub create_tables {
248   $main::lxdebug->enter_sub();
249
250   my $self = shift;
251   my $dbh  = $self->dbconnect();
252
253   my $charset    = $main::charset;
254   $charset     ||= Common::DEFAULT_CHARSET;
255
256   $dbh->rollback();
257   User->process_query($main::form, $dbh, 'sql/auth_db.sql', undef, $charset);
258
259   $main::lxdebug->leave_sub();
260 }
261
262 sub save_user {
263   $main::lxdebug->enter_sub();
264
265   my $self   = shift;
266   my $login  = shift;
267   my %params = @_;
268
269   my $form   = $main::form;
270
271   my $dbh    = $self->dbconnect();
272
273   my ($sth, $query, $user_id);
274
275   $query     = qq|SELECT id FROM auth."user" WHERE login = ?|;
276   ($user_id) = selectrow_query($form, $dbh, $query, $login);
277
278   if (!$user_id) {
279     $query     = qq|SELECT nextval('auth.user_id_seq')|;
280     ($user_id) = selectrow_query($form, $dbh, $query);
281
282     $query     = qq|INSERT INTO auth."user" (id, login) VALUES (?, ?)|;
283     do_query($form, $dbh, $query, $user_id, $login);
284   }
285
286   $query = qq|DELETE FROM auth.user_config WHERE (user_id = ?)|;
287   do_query($form, $dbh, $query, $user_id);
288
289   $query = qq|INSERT INTO auth.user_config (user_id, cfg_key, cfg_value) VALUES (?, ?, ?)|;
290   $sth   = prepare_query($form, $dbh, $query);
291
292   while (my ($cfg_key, $cfg_value) = each %params) {
293     next if ($cfg_key eq 'password');
294
295     do_statement($form, $sth, $query, $user_id, $cfg_key, $cfg_value);
296   }
297
298   $dbh->commit();
299
300   $main::lxdebug->leave_sub();
301 }
302
303 sub can_change_password {
304   my $self = shift;
305
306   return $self->{authenticator}->can_change_password();
307 }
308
309 sub change_password {
310   $main::lxdebug->enter_sub();
311
312   my $self   = shift;
313   my $result = $self->{authenticator}->change_password(@_);
314
315   $main::lxdebug->leave_sub();
316
317   return $result;
318 }
319
320 sub read_all_users {
321   $main::lxdebug->enter_sub();
322
323   my $self  = shift;
324
325   my $dbh   = $self->dbconnect();
326   my $query = qq|SELECT u.id, u.login, cfg.cfg_key, cfg.cfg_value
327                  FROM auth.user_config cfg
328                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)|;
329   my $sth   = prepare_execute_query($main::form, $dbh, $query);
330
331   my %users;
332
333   while (my $ref = $sth->fetchrow_hashref()) {
334     $users{$ref->{login}}                    ||= { 'login' => $ref->{login}, 'id' => $ref->{id} };
335     $users{$ref->{login}}->{$ref->{cfg_key}}   = $ref->{cfg_value} if (($ref->{cfg_key} ne 'login') && ($ref->{cfg_key} ne 'id'));
336   }
337
338   $sth->finish();
339
340   $main::lxdebug->leave_sub();
341
342   return %users;
343 }
344
345 sub read_user {
346   $main::lxdebug->enter_sub();
347
348   my $self  = shift;
349   my $login = shift;
350
351   my $dbh   = $self->dbconnect();
352   my $query = qq|SELECT cfg.cfg_key, cfg.cfg_value
353                  FROM auth.user_config cfg
354                  LEFT JOIN auth."user" u ON (cfg.user_id = u.id)
355                  WHERE (u.login = ?)|;
356   my $sth   = prepare_execute_query($main::form, $dbh, $query, $login);
357
358   my %user_data;
359
360   while (my $ref = $sth->fetchrow_hashref()) {
361     $user_data{$ref->{cfg_key}} = $ref->{cfg_value};
362     $user_data{login}           = $login;
363   }
364
365   $sth->finish();
366
367   $main::lxdebug->leave_sub();
368
369   return %user_data;
370 }
371
372 sub get_user_id {
373   $main::lxdebug->enter_sub();
374
375   my $self  = shift;
376   my $login = shift;
377
378   my $dbh   = $self->dbconnect();
379   my ($id)  = selectrow_query($main::form, $dbh, qq|SELECT id FROM auth."user" WHERE login = ?|, $login);
380
381   $main::lxdebug->leave_sub();
382
383   return $id;
384 }
385
386 sub delete_user {
387   $main::lxdebug->enter_sub();
388
389   my $self  = shift;
390   my $login = shift;
391
392   my $form  = $main::form;
393
394   my $dbh   = $self->dbconnect();
395   my $query = qq|SELECT id FROM auth."user" WHERE login = ?|;
396
397   my ($id)  = selectrow_query($form, $dbh, $query, $login);
398
399   return $main::lxdebug->leave_sub() if (!$id);
400
401   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE user_id = ?|, $id);
402   do_query($form, $dbh, qq|DELETE FROM auth.user_config WHERE user_id = ?|, $id);
403
404   $dbh->commit();
405
406   $main::lxdebug->leave_sub();
407 }
408
409 # --------------------------------------
410
411 my $session_id;
412
413 sub restore_session {
414   $main::lxdebug->enter_sub();
415
416   my $self = shift;
417
418   my $cgi            =  $main::cgi;
419   $cgi             ||=  CGI->new('');
420
421   $session_id        =  $cgi->cookie($self->get_session_cookie_name());
422   $session_id        =~ s|[^0-9a-f]||g;
423
424   $self->{SESSION}   = { };
425
426   if (!$session_id) {
427     $main::lxdebug->leave_sub();
428     return SESSION_NONE;
429   }
430
431   my ($dbh, $query, $sth, $cookie, $ref, $form);
432
433   $form   = $main::form;
434
435   $dbh    = $self->dbconnect();
436   $query  = qq|SELECT *, (mtime < (now() - '$self->{session_timeout}m'::interval)) AS is_expired FROM auth.session WHERE id = ?|;
437
438   $cookie = selectfirst_hashref_query($form, $dbh, $query, $session_id);
439
440   if (!$cookie || $cookie->{is_expired} || ($cookie->{ip_address} ne $ENV{REMOTE_ADDR})) {
441     $self->destroy_session();
442     $main::lxdebug->leave_sub();
443     return SESSION_EXPIRED;
444   }
445
446   $query = qq|SELECT sess_key, sess_value FROM auth.session_content WHERE session_id = ?|;
447   $sth   = prepare_execute_query($form, $dbh, $query, $session_id);
448
449   while (my $ref = $sth->fetchrow_hashref()) {
450     $self->{SESSION}->{$ref->{sess_key}} = $ref->{sess_value};
451     $form->{$ref->{sess_key}}            = $ref->{sess_value} if (!defined $form->{$ref->{sess_key}});
452   }
453
454   $sth->finish();
455
456   $main::lxdebug->leave_sub();
457
458   return SESSION_OK;
459 }
460
461 sub destroy_session {
462   $main::lxdebug->enter_sub();
463
464   my $self = shift;
465
466   if ($session_id) {
467     my $dbh = $self->dbconnect();
468
469     do_query($main::form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
470     do_query($main::form, $dbh, qq|DELETE FROM auth.session WHERE id = ?|, $session_id);
471
472     $dbh->commit();
473
474     $session_id      = undef;
475     $self->{SESSION} = { };
476   }
477
478   $main::lxdebug->leave_sub();
479 }
480
481 sub expire_sessions {
482   $main::lxdebug->enter_sub();
483
484   my $self  = shift;
485
486   my $dbh   = $self->dbconnect();
487   my $query =
488     qq|DELETE FROM auth.session_content
489        WHERE session_id IN
490          (SELECT id
491           FROM auth.session
492           WHERE (mtime < (now() - '$self->{session_timeout}m'::interval)))|;
493
494   do_query($main::form, $dbh, $query);
495
496   $query =
497     qq|DELETE FROM auth.session
498        WHERE (mtime < (now() - '$self->{session_timeout}m'::interval))|;
499
500   do_query($main::form, $dbh, $query);
501
502   $dbh->commit();
503
504   $main::lxdebug->leave_sub();
505 }
506
507 sub _create_session_id {
508   $main::lxdebug->enter_sub();
509
510   my @secs = gettimeofday();
511   srand $secs[1] + $$;
512
513   my @data;
514   map { push @data, int(rand() * 255); } (1..32);
515
516   my $id = md5_hex(pack 'C*', @data);
517
518   $main::lxdebug->leave_sub();
519
520   return $id;
521 }
522
523 sub create_or_refresh_session {
524   $main::lxdebug->enter_sub();
525
526   my $self = shift;
527
528   $session_id ||= $self->_create_session_id();
529
530   my ($form, $dbh, $query, $sth, $id);
531
532   $form  = $main::form;
533   $dbh   = $self->dbconnect();
534
535   $query = qq|SELECT id FROM auth.session WHERE id = ?|;
536
537   ($id)  = selectrow_query($form, $dbh, $query, $session_id);
538
539   if ($id) {
540     do_query($form, $dbh, qq|UPDATE auth.session SET mtime = now() WHERE id = ?|, $session_id);
541     do_query($form, $dbh, qq|DELETE FROM auth.session_content WHERE session_id = ?|, $session_id);
542
543   } else {
544     do_query($form, $dbh, qq|INSERT INTO auth.session (id, ip_address, mtime) VALUES (?, ?, now())|, $session_id, $ENV{REMOTE_ADDR});
545
546   }
547
548   $query = qq|INSERT INTO auth.session_content (session_id, sess_key, sess_value) VALUES (?, ?, ?)|;
549   $sth   = prepare_query($form, $dbh, $query);
550
551   foreach my $key (sort keys %{ $self->{SESSION} }) {
552     do_statement($form, $sth, $query, $session_id, $key, $self->{SESSION}->{$key});
553   }
554
555   $sth->finish();
556   $dbh->commit();
557
558   $main::lxdebug->leave_sub();
559 }
560
561 sub set_session_value {
562   $main::lxdebug->enter_sub();
563
564   my $self  = shift;
565
566   $self->{SESSION} ||= { };
567
568   while (2 <= scalar @_) {
569     my $key   = shift;
570     my $value = shift;
571
572     $self->{SESSION}->{$key} = $value;
573   }
574
575   $main::lxdebug->leave_sub();
576 }
577
578 sub set_cookie_environment_variable {
579   my $self = shift;
580   $ENV{HTTP_COOKIE} = $self->get_session_cookie_name() . "=${session_id}";
581 }
582
583 sub get_session_cookie_name {
584   my $self = shift;
585
586   return $self->{cookie_name} || 'lx_office_erp_session_id';
587 }
588
589 sub get_session_id {
590   return $session_id;
591 }
592
593 sub session_tables_present {
594   $main::lxdebug->enter_sub();
595
596   my $self = shift;
597   my $dbh  = $self->dbconnect(1);
598
599   if (!$dbh) {
600     $main::lxdebug->leave_sub();
601     return 0;
602   }
603
604   my $query =
605     qq|SELECT COUNT(*)
606        FROM pg_tables
607        WHERE (schemaname = 'auth')
608          AND (tablename IN ('session', 'session_content'))|;
609
610   my ($count) = selectrow_query($main::form, $dbh, $query);
611
612   $main::lxdebug->leave_sub();
613
614   return 2 == $count;
615 }
616
617 # --------------------------------------
618
619 sub all_rights_full {
620   my $locale = $main::locale;
621
622   my @all_rights = (
623     ["--master_data",                  $locale->text("Master Data")],
624     ["customer_vendor_edit",           $locale->text("Create and edit customers and vendors")],
625     ["part_service_assembly_edit",     $locale->text("Create and edit parts, services, assemblies")],
626     ["project_edit",                   $locale->text("Create and edit projects")],
627     ["license_edit",                   $locale->text("Manage license keys")],
628     ["--ar",                           $locale->text("AR")],
629     ["sales_quotation_edit",           $locale->text("Create and edit sales quotations")],
630     ["sales_order_edit",               $locale->text("Create and edit sales orders")],
631     ["sales_delivery_order_edit",      $locale->text("Create and edit sales delivery orders")],
632     ["invoice_edit",                   $locale->text("Create and edit invoices and credit notes")],
633     ["dunning_edit",                   $locale->text("Create and edit dunnings")],
634     ["--ap",                           $locale->text("AP")],
635     ["request_quotation_edit",         $locale->text("Create and edit RFQs")],
636     ["purchase_order_edit",            $locale->text("Create and edit purchase orders")],
637     ["purchase_delivery_order_edit",   $locale->text("Create and edit purchase delivery orders")],
638     ["vendor_invoice_edit",            $locale->text("Create and edit vendor invoices")],
639     ["--general_ledger_cash",          $locale->text("General ledger and cash")],
640     ["general_ledger",                 $locale->text("Transactions, AR transactions, AP transactions")],
641     ["datev_export",                   $locale->text("DATEV Export")],
642     ["cash",                           $locale->text("Receipt, payment, reconciliation")],
643     ["--reports",                      $locale->text('Reports')],
644     ["report",                         $locale->text('All reports')],
645     ["advance_turnover_tax_return",    $locale->text('Advance turnover tax return')],
646     ["--others",                       $locale->text("Others")],
647     ["email_bcc",                      $locale->text("May set the BCC field when sending emails")],
648     ["config",                         $locale->text("Change Lx-Office installation settings (all menu entries beneath 'System')")],
649     );
650
651   return @all_rights;
652 }
653
654 sub all_rights {
655   return grep !/^--/, map { $_->[0] } all_rights_full();
656 }
657
658 sub read_groups {
659   $main::lxdebug->enter_sub();
660
661   my $self = shift;
662
663   my $form   = $main::form;
664   my $groups = {};
665   my $dbh    = $self->dbconnect();
666
667   my $query  = 'SELECT * FROM auth."group"';
668   my $sth    = prepare_execute_query($form, $dbh, $query);
669
670   my ($row, $group);
671
672   while ($row = $sth->fetchrow_hashref()) {
673     $groups->{$row->{id}} = $row;
674   }
675   $sth->finish();
676
677   $query = 'SELECT * FROM auth.user_group WHERE group_id = ?';
678   $sth   = prepare_query($form, $dbh, $query);
679
680   foreach $group (values %{$groups}) {
681     $group->{members} = [];
682
683     do_statement($form, $sth, $query, $group->{id});
684
685     while ($row = $sth->fetchrow_hashref()) {
686       push @{$group->{members}}, $row->{user_id};
687     }
688   }
689   $sth->finish();
690
691   $query = 'SELECT * FROM auth.group_rights WHERE group_id = ?';
692   $sth   = prepare_query($form, $dbh, $query);
693
694   foreach $group (values %{$groups}) {
695     $group->{rights} = {};
696
697     do_statement($form, $sth, $query, $group->{id});
698
699     while ($row = $sth->fetchrow_hashref()) {
700       $group->{rights}->{$row->{right}} |= $row->{granted};
701     }
702
703     map { $group->{rights}->{$_} = 0 if (!defined $group->{rights}->{$_}); } all_rights();
704   }
705   $sth->finish();
706
707   $main::lxdebug->leave_sub();
708
709   return $groups;
710 }
711
712 sub save_group {
713   $main::lxdebug->enter_sub();
714
715   my $self  = shift;
716   my $group = shift;
717
718   my $form  = $main::form;
719   my $dbh   = $self->dbconnect();
720
721   my ($query, $sth, $row, $rights);
722
723   if (!$group->{id}) {
724     ($group->{id}) = selectrow_query($form, $dbh, qq|SELECT nextval('auth.group_id_seq')|);
725
726     $query = qq|INSERT INTO auth."group" (id, name, description) VALUES (?, '', '')|;
727     do_query($form, $dbh, $query, $group->{id});
728   }
729
730   do_query($form, $dbh, qq|UPDATE auth."group" SET name = ?, description = ? WHERE id = ?|, map { $group->{$_} } qw(name description id));
731
732   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $group->{id});
733
734   $query  = qq|INSERT INTO auth.user_group (user_id, group_id) VALUES (?, ?)|;
735   $sth    = prepare_query($form, $dbh, $query);
736
737   foreach my $user_id (@{ $group->{members} }) {
738     do_statement($form, $sth, $query, $user_id, $group->{id});
739   }
740   $sth->finish();
741
742   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $group->{id});
743
744   $query = qq|INSERT INTO auth.group_rights (group_id, "right", granted) VALUES (?, ?, ?)|;
745   $sth   = prepare_query($form, $dbh, $query);
746
747   foreach my $right (keys %{ $group->{rights} }) {
748     do_statement($form, $sth, $query, $group->{id}, $right, $group->{rights}->{$right} ? 't' : 'f');
749   }
750   $sth->finish();
751
752   $dbh->commit();
753
754   $main::lxdebug->leave_sub();
755 }
756
757 sub delete_group {
758   $main::lxdebug->enter_sub();
759
760   my $self = shift;
761   my $id   = shift;
762
763   my $form = $main::from;
764
765   my $dbh  = $self->dbconnect();
766
767   do_query($form, $dbh, qq|DELETE FROM auth.user_group WHERE group_id = ?|, $id);
768   do_query($form, $dbh, qq|DELETE FROM auth.group_rights WHERE group_id = ?|, $id);
769   do_query($form, $dbh, qq|DELETE FROM auth."group" WHERE id = ?|, $id);
770
771   $dbh->commit();
772
773   $main::lxdebug->leave_sub();
774 }
775
776 sub evaluate_rights_ary {
777   $main::lxdebug->enter_sub(2);
778
779   my $ary    = shift;
780
781   my $value  = 0;
782   my $action = '|';
783
784   foreach my $el (@{$ary}) {
785     if (ref $el eq "ARRAY") {
786       if ($action eq '|') {
787         $value |= evaluate_rights_ary($el);
788       } else {
789         $value &= evaluate_rights_ary($el);
790       }
791
792     } elsif (($el eq '&') || ($el eq '|')) {
793       $action = $el;
794
795     } elsif ($action eq '|') {
796       $value |= $el;
797
798     } else {
799       $value &= $el;
800
801     }
802   }
803
804   $main::lxdebug->enter_sub(2);
805
806   return $value;
807 }
808
809 sub _parse_rights_string {
810   $main::lxdebug->enter_sub(2);
811
812   my $self   = shift;
813
814   my $login  = shift;
815   my $access = shift;
816
817   my @stack;
818   my $cur_ary = [];
819
820   push @stack, $cur_ary;
821
822   while ($access =~ m/^([a-z_0-9]+|\||\&|\(|\)|\s+)/) {
823     my $token = $1;
824     substr($access, 0, length $1) = "";
825
826     next if ($token =~ /\s/);
827
828     if ($token eq "(") {
829       my $new_cur_ary = [];
830       push @stack, $new_cur_ary;
831       push @{$cur_ary}, $new_cur_ary;
832       $cur_ary = $new_cur_ary;
833
834     } elsif ($token eq ")") {
835       pop @stack;
836
837       if (!@stack) {
838         $main::lxdebug->enter_sub(2);
839         return 0;
840       }
841
842       $cur_ary = $stack[-1];
843
844     } elsif (($token eq "|") || ($token eq "&")) {
845       push @{$cur_ary}, $token;
846
847     } else {
848       push @{$cur_ary}, $self->{RIGHTS}->{$login}->{$token} * 1;
849     }
850   }
851
852   my $result = ($access || (1 < scalar @stack)) ? 0 : evaluate_rights_ary($stack[0]);
853
854   $main::lxdebug->enter_sub(2);
855
856   return $result;
857 }
858
859 sub check_right {
860   $main::lxdebug->enter_sub(2);
861
862   my $self    = shift;
863   my $login   = shift;
864   my $right   = shift;
865   my $default = shift;
866
867   $self->{FULL_RIGHTS}           ||= { };
868   $self->{FULL_RIGHTS}->{$login} ||= { };
869
870   if (!defined $self->{FULL_RIGHTS}->{$login}->{$right}) {
871     $self->{RIGHTS}           ||= { };
872     $self->{RIGHTS}->{$login} ||= $self->load_rights_for_user($login);
873
874     $self->{FULL_RIGHTS}->{$login}->{$right} = $self->_parse_rights_string($login, $right);
875   }
876
877   my $granted = $self->{FULL_RIGHTS}->{$login}->{$right};
878   $granted    = $default if (!defined $granted);
879
880   $main::lxdebug->leave_sub(2);
881
882   return $granted;
883 }
884
885 sub assert {
886   $main::lxdebug->enter_sub(2);
887
888   my $self       = shift;
889   my $right      = shift;
890   my $dont_abort = shift;
891
892   my $form       = $main::form;
893
894   if ($self->check_right($form->{login}, $right)) {
895     $main::lxdebug->leave_sub(2);
896     return 1;
897   }
898
899   if (!$dont_abort) {
900     delete $form->{title};
901     $form->show_generic_error($main::locale->text("You do not have the permissions to access this function."));
902   }
903
904   $main::lxdebug->leave_sub(2);
905
906   return 0;
907 }
908
909 sub load_rights_for_user {
910   $main::lxdebug->enter_sub();
911
912   my $self  = shift;
913   my $login = shift;
914
915   my $form  = $main::form;
916   my $dbh   = $self->dbconnect();
917
918   my ($query, $sth, $row, $rights);
919
920   $rights = {};
921
922   $query =
923     qq|SELECT gr."right", gr.granted
924        FROM auth.group_rights gr
925        WHERE group_id IN
926          (SELECT ug.group_id
927           FROM auth.user_group ug
928           LEFT JOIN auth."user" u ON (ug.user_id = u.id)
929           WHERE u.login = ?)|;
930
931   $sth = prepare_execute_query($form, $dbh, $query, $login);
932
933   while ($row = $sth->fetchrow_hashref()) {
934     $rights->{$row->{right}} |= $row->{granted};
935   }
936   $sth->finish();
937
938   map({ $rights->{$_} = 0 unless (defined $rights->{$_}); } SL::Auth::all_rights());
939
940   $main::lxdebug->leave_sub();
941
942   return $rights;
943 }
944
945 1;