Revision 8c7e4493
Von Moritz Bunkus vor fast 17 Jahren hinzugefügt
| SL/Menu.pm | ||
|---|---|---|
| 34 | 34 |
|
| 35 | 35 |
package Menu; |
| 36 | 36 |
|
| 37 |
use SL::Auth; |
|
| 37 | 38 |
use SL::Inifile; |
| 38 | 39 |
|
| 39 | 40 |
sub new {
|
| ... | ... | |
| 46 | 47 |
|
| 47 | 48 |
map { $self->{$_} = $inifile->{$_} } keys %{ $inifile };
|
| 48 | 49 |
|
| 50 |
bless $self, $type; |
|
| 51 |
|
|
| 52 |
$self->set_access(); |
|
| 53 |
|
|
| 49 | 54 |
$main::lxdebug->leave_sub(); |
| 50 | 55 |
|
| 51 |
bless $self, $type;
|
|
| 56 |
return $self;
|
|
| 52 | 57 |
} |
| 53 | 58 |
|
| 54 | 59 |
sub menuitem {
|
| ... | ... | |
| 72 | 77 |
|
| 73 | 78 |
my $level = $form->escape($item); |
| 74 | 79 |
|
| 75 |
my $str = |
|
| 76 |
qq|<a style="vertical-align:top" href=$module?action=$action&level=$level&login=$form->{login}&password=$form->{password}|;
|
|
| 80 |
my $str = qq|<a style="vertical-align:top" href=$module?action=$action&level=$level|; |
|
| 77 | 81 |
|
| 78 | 82 |
my @vars = qw(module action target href); |
| 79 | 83 |
|
| ... | ... | |
| 124 | 128 |
|
| 125 | 129 |
my $level = $form->escape($item); |
| 126 | 130 |
|
| 127 |
my $str = qq|<a href="$module?action=| . $form->escape($action) . |
|
| 128 |
qq|&level=| . $form->escape($level); |
|
| 129 |
map({ $str .= "&${_}=" . $form->escape($form->{$_}); } qw(login password));
|
|
| 131 |
my $str = qq|<a href="$module?action=| . $form->escape($action) . qq|&level=| . $form->escape($level); |
|
| 130 | 132 |
|
| 131 | 133 |
my @vars = qw(module action target href); |
| 132 | 134 |
|
| ... | ... | |
| 237 | 239 |
} |
| 238 | 240 |
|
| 239 | 241 |
my $level = $form->escape($item); |
| 240 |
my $str = |
|
| 241 |
qq|$module?action=$action&level=$level&login=$form->{login}&password=$form->{password}|;
|
|
| 242 |
my $str = qq|$module?action=$action&level=$level|; |
|
| 242 | 243 |
my @vars = qw(module action target href); |
| 243 | 244 |
|
| 244 | 245 |
if ($self->{$item}{href}) {
|
| ... | ... | |
| 302 | 303 |
} |
| 303 | 304 |
} |
| 304 | 305 |
|
| 306 |
sub parse_access_string {
|
|
| 307 |
my $self = shift; |
|
| 308 |
my $key = shift; |
|
| 309 |
my $access = shift; |
|
| 310 |
|
|
| 311 |
my @stack; |
|
| 312 |
my $cur_ary = []; |
|
| 313 |
|
|
| 314 |
push @stack, $cur_ary; |
|
| 315 |
|
|
| 316 |
while ($access =~ m/^([a-z_]+|\||\&|\(|\)|\s+)/) {
|
|
| 317 |
my $token = $1; |
|
| 318 |
substr($access, 0, length($1)) = ""; |
|
| 319 |
|
|
| 320 |
next if ($token =~ /\s/); |
|
| 321 |
|
|
| 322 |
if ($token eq "(") {
|
|
| 323 |
my $new_cur_ary = []; |
|
| 324 |
push @stack, $new_cur_ary; |
|
| 325 |
push @{$cur_ary}, $new_cur_ary;
|
|
| 326 |
$cur_ary = $new_cur_ary; |
|
| 327 |
|
|
| 328 |
} elsif ($token eq ")") {
|
|
| 329 |
pop @stack; |
|
| 330 |
if (!@stack) {
|
|
| 331 |
$main::form->error("Error in menu.ini for entry ${key}: missing '('");
|
|
| 332 |
} |
|
| 333 |
$cur_ary = $stack[-1]; |
|
| 334 |
|
|
| 335 |
} elsif (($token eq "|") || ($token eq "&")) {
|
|
| 336 |
push @{$cur_ary}, $token;
|
|
| 337 |
|
|
| 338 |
} else {
|
|
| 339 |
push @{$cur_ary}, $main::auth->check_right($main::form->{login}, $token, 1);
|
|
| 340 |
} |
|
| 341 |
} |
|
| 342 |
|
|
| 343 |
if ($access) {
|
|
| 344 |
$main::form->error("Error in menu.ini for entry ${name}: unrecognized token at the start of '$access'\n");
|
|
| 345 |
} |
|
| 346 |
|
|
| 347 |
if (1 < scalar @stack) {
|
|
| 348 |
$main::form->error("Error in menu.ini for entry ${name}: Missing ')'\n");
|
|
| 349 |
} |
|
| 350 |
|
|
| 351 |
return SL::Auth::evaluate_rights_ary($stack[0]); |
|
| 352 |
} |
|
| 353 |
|
|
| 354 |
sub set_access {
|
|
| 355 |
my $self = shift; |
|
| 356 |
|
|
| 357 |
my $key; |
|
| 358 |
|
|
| 359 |
foreach $key (@{ $self->{ORDER} }) {
|
|
| 360 |
my $entry = $self->{$key};
|
|
| 361 |
|
|
| 362 |
$entry->{GRANTED} = $entry->{ACCESS} ? $self->parse_access_string($key, $entry->{ACCESS}) : 1;
|
|
| 363 |
$entry->{IS_MENU} = $entry->{submenu} || ($key !~ m/--/);
|
|
| 364 |
$entry->{NUM_VISIBLE_CHILDREN} = 0;
|
|
| 365 |
|
|
| 366 |
if ($key =~ m/--/) {
|
|
| 367 |
my $parent = $key; |
|
| 368 |
substr($parent, rindex($parent, '--')) = ''; |
|
| 369 |
$entry->{GRANTED} &&= $self->{$parent}->{GRANTED};
|
|
| 370 |
} |
|
| 371 |
|
|
| 372 |
$entry->{VISIBLE} = $entry->{GRANTED};
|
|
| 373 |
} |
|
| 374 |
|
|
| 375 |
foreach $key (reverse @{ $self->{ORDER} }) {
|
|
| 376 |
my $entry = $self->{$key};
|
|
| 377 |
|
|
| 378 |
if ($entry->{IS_MENU}) {
|
|
| 379 |
$entry->{VISIBLE} &&= $entry->{NUM_VISIBLE_CHILDREN} > 0;
|
|
| 380 |
} |
|
| 381 |
|
|
| 382 |
next if (($key !~ m/--/) || !$entry->{VISIBLE});
|
|
| 383 |
|
|
| 384 |
my $parent = $key; |
|
| 385 |
substr($parent, rindex($parent, '--')) = ''; |
|
| 386 |
$self->{$parent}->{NUM_VISIBLE_CHILDREN}++;
|
|
| 387 |
} |
|
| 388 |
|
|
| 389 |
# $self->dump_visible(); |
|
| 390 |
|
|
| 391 |
$self->{ORDER} = [ grep { $self->{$_}->{VISIBLE} } @{ $self->{ORDER} } ];
|
|
| 392 |
|
|
| 393 |
map { delete @{$self->{$_}}{qw(GRANTED IS_MENU NUM_VISIBLE_CHILDREN VISIBLE ACCESS)} if ($_ ne 'ORDER') } keys %{ $self };
|
|
| 394 |
} |
|
| 395 |
|
|
| 396 |
sub dump_visible {
|
|
| 397 |
my $self = shift; |
|
| 398 |
foreach my $key (@{ $self->{ORDER} }) {
|
|
| 399 |
my $entry = $self->{$key};
|
|
| 400 |
$main::lxdebug->message(0, "$entry->{GRANTED} $entry->{VISIBLE} $entry->{NUM_VISIBLE_CHILDREN} $key");
|
|
| 401 |
} |
|
| 402 |
} |
|
| 403 |
|
|
| 305 | 404 |
1; |
| 306 | 405 |
|
Auch abrufbar als: Unified diff
Umstellung der Benutzerverwaltung von Dateien im Verzeichnis "users" auf die Verwendung einer Authentifizierungsdatenbank.
Es ist erforderlich, die Dateien doc/UPGRADE und doc/INSTALL/index.html zu lesen und die angesprochenen Punkte auszuführen, um nach einem Upgrade weiter arbeiten zu können.