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