--- loncom/lonnet/perl/lonnet.pm 2011/01/11 22:36:11 1.1056.4.19 +++ loncom/lonnet/perl/lonnet.pm 2011/03/04 02:06:36 1.1056.4.23 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1056.4.19 2011/01/11 22:36:11 raeburn Exp $ +# $Id: lonnet.pm,v 1.1056.4.23 2011/03/04 02:06:36 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -752,22 +752,22 @@ sub overloaderror { # ------------------------------ Find server with least workload from spare.tab sub spareserver { - my ($loadpercent,$userloadpercent,$want_server_name) = @_; + my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_; my $spare_server; if ($userloadpercent !~ /\d/) { $userloadpercent=0; } my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent : $userloadpercent; my ($uint_dom,$remotesessions); - if ($env{'user.domain'}) { - my $uprimary_id = &Apache::lonnet::domain($env{'user.domain'},'primary'); + if (($udom ne '') && (&domain($udom) ne '')) { + my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); $uint_dom = &Apache::lonnet::internet_dom($uprimary_id); - my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'}); + my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom); $remotesessions = $udomdefaults{'remotesessions'}; } foreach my $try_server (@{ $spareid{'primary'} }) { if ($uint_dom) { - next unless (&spare_can_host($env{'user.domain'},$uint_dom, - $remotesessions,$try_server)); + next unless (&spare_can_host($udom,$uint_dom,$remotesessions, + $try_server)); } ($spare_server, $lowest_load) = &compare_server_load($try_server, $spare_server, $lowest_load); @@ -778,8 +778,8 @@ sub spareserver { if (!$found_server) { foreach my $try_server (@{ $spareid{'default'} }) { if ($uint_dom) { - next unless (&spare_can_host($env{'user.domain'},$uint_dom, - $remotesessions,$try_server)); + next unless (&spare_can_host($udom,$uint_dom,$remotesessions, + $try_server)); } ($spare_server, $lowest_load) = &compare_server_load($try_server, $spare_server, $lowest_load); @@ -5754,7 +5754,7 @@ sub allowed { my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} =~/\Q$rolecode\E/) { - if ($priv ne 'pch') { + if (($priv ne 'pch') && ($priv ne 'plc')) { &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. 'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. $env{'request.course.id'}); @@ -5764,7 +5764,7 @@ sub allowed { if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} =~/\Q$unamedom\E/) { - if ($priv ne 'pch') { + if (($priv ne 'pch') && ($priv ne 'plc')) { &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. 'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. $env{'request.course.id'}); @@ -5778,7 +5778,7 @@ sub allowed { if ($thisallowed=~/R/) { my $rolecode=(split(/\./,$env{'request.role'}))[0]; if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) { - if ($priv ne 'pch') { + if (($priv ne 'pch') && ($priv ne 'plc')) { &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. 'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); } @@ -8578,7 +8578,7 @@ sub metadata { if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || - ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^\*uploaded\/.+\.sequence$/) || ($uri =~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) { + ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$}) || ($uri =~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) { return undef; } if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) @@ -8968,7 +8968,8 @@ sub symbverify { } my $ids=$bighash{'ids_'.&clutter($thisurl)}; unless ($ids) { - $ids=$bighash{'ids_/'.$thisurl}; + my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl; + $ids=$bighash{$idkey}; } if ($ids) { # ------------------------------------------------------------------- Has ID(s) @@ -8981,7 +8982,8 @@ sub symbverify { &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) eq $symb) { if (($env{'request.role.adv'}) || - $bighash{'encrypted_'.$id} eq $env{'request.enc'}) { + ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) || + ($thisurl eq '/adm/navmaps')) { $okay=1; } }