--- loncom/lonnet/perl/lonnet.pm 2012/08/17 22:43:58 1.1184 +++ loncom/lonnet/perl/lonnet.pm 2012/09/25 19:54:38 1.1191 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1184 2012/08/17 22:43:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.1191 2012/09/25 19:54:38 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -113,11 +113,11 @@ our @ISA = qw (Exporter); our @EXPORT = qw(%env); -# ---------------------------------------------------------------- Role Logging +# ------------------------------------ Logging (parameters, docs, slots, roles) { my $logid; - sub write_rolelog { - my ($context,$hash_name,$storehash,$delflag,$udom,$uname,$cdom,$cnum)=@_; + sub write_log { + my ($context,$hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_; if ($context eq 'course') { if (($cnum eq '') || ($cdom eq '')) { $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; @@ -1240,8 +1240,8 @@ sub get_lonbalancer_config { sub check_loadbalancing { my ($uname,$udom) = @_; - my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, - $offloadto,$otherserver); + my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom, + $rule_in_effect,$offloadto,$otherserver); my $lonhost = $perlvar{'lonHostID'}; my @hosts = ¤t_machine_ids(); my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); @@ -1266,14 +1266,8 @@ sub check_loadbalancing { } } if (ref($result) eq 'HASH') { - my $currbalancer = $result->{'lonhost'}; - my $currtargets = $result->{'targets'}; - my $currrules = $result->{'rules'}; - if ($currbalancer ne '') { - if (grep(/^\Q$currbalancer\E$/,@hosts)) { - $is_balancer = 1; - } - } + ($is_balancer,$currtargets,$currrules) = + &check_balancer_result($result,@hosts); if ($is_balancer) { if (ref($currrules) eq 'HASH') { if ($homeintdom) { @@ -1331,12 +1325,9 @@ sub check_loadbalancing { } } if (ref($result) eq 'HASH') { - my $currbalancer = $result->{'lonhost'}; - my $currtargets = $result->{'targets'}; - my $currrules = $result->{'rules'}; - - if ($currbalancer eq $lonhost) { - $is_balancer = 1; + ($is_balancer,$currtargets,$currrules) = + &check_balancer_result($result,@hosts); + if ($is_balancer) { if (ref($currrules) eq 'HASH') { if ($currrules->{'_LC_internetdom'} ne '') { $rule_in_effect = $currrules->{'_LC_internetdom'}; @@ -1400,6 +1391,32 @@ sub check_loadbalancing { return ($is_balancer,$otherserver); } +sub check_balancer_result { + my ($result,@hosts) = @_; + my ($is_balancer,$currtargets,$currrules); + if (ref($result) eq 'HASH') { + if ($result->{'lonhost'} ne '') { + my $currbalancer = $result->{'lonhost'}; + if (grep(/^\Q$currbalancer\E$/,@hosts)) { + $is_balancer = 1; + $currtargets = $result->{'targets'}; + $currrules = $result->{'rules'}; + } + } else { + foreach my $key (keys(%{$result})) { + if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) && + (ref($result->{$key}) eq 'HASH')) { + $is_balancer = 1; + $currrules = $result->{$key}{'rules'}; + $currtargets = $result->{$key}{'targets'}; + last; + } + } + } + } + return ($is_balancer,$currtargets,$currrules); +} + sub get_loadbalancer_targets { my ($rule_in_effect,$currtargets,$uname,$udom) = @_; my $offloadto; @@ -2406,7 +2423,7 @@ sub chatsend { sub getversion { my $fname=&clutter(shift); - unless ($fname=~/^\/res\//) { return -1; } + unless ($fname=~m{^(/adm/wrapper|)/res/}) { return -1; } return ¤tversion(&filelocation('',$fname)); } @@ -3555,8 +3572,8 @@ sub courserolelog { } else { $storehash{'section'} = $sec; } - &write_rolelog('course',$namespace,\%storehash,$delflag,$domain, - $username,$cdom,$cnum); + &write_log('course',$namespace,\%storehash,$delflag,$username, + $domain,$cnum,$cdom); if (($trole ne 'st') || ($sec ne '')) { &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum); } @@ -3576,8 +3593,8 @@ sub domainrolelog { end => $tend, context => $context, ); - &write_rolelog('domain',$namespace,\%storehash,$delflag,$domain, - $username,$cdom,$domconfiguser); + &write_log('domain',$namespace,\%storehash,$delflag,$username, + $domain,$domconfiguser,$cdom); } return; @@ -3595,8 +3612,8 @@ sub coauthorrolelog { end => $tend, context => $context, ); - &write_rolelog('author',$namespace,\%storehash,$delflag,$domain, - $username,$audom,$auname); + &write_log('author',$namespace,\%storehash,$delflag,$username, + $domain,$auname,$audom); } return; } @@ -3713,7 +3730,7 @@ sub get_my_roles { } my ($rolecode,$username,$domain,$section,$area); if ($context eq 'userroles') { - ($area,$rolecode) = split(/_/,$entry); + ($area,$rolecode) = ($entry =~ /^(.+)_([^_]+)$/); (undef,$domain,$username,$section) = split(/\//,$area); } else { ($role,$username,$domain,$section) = split(/\:/,$entry); @@ -5049,15 +5066,19 @@ sub delete_env_groupprivs { sub check_adhoc_privs { my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_; my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; + my $setprivs; if ($env{$cckey}) { my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); + $setprivs = 1; } } else { &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); + $setprivs = 1; } + return $setprivs; } sub set_adhoc_privileges { @@ -10014,7 +10035,7 @@ sub symblist { # --------------------------------------------------------------- Verify a symb sub symbverify { - my ($symb,$thisurl)=@_; + my ($symb,$thisurl,$encstate)=@_; my $thisfn=$thisurl; $thisfn=&declutter($thisfn); # direct jump to resource in page or to a sequence - will construct own symbs @@ -10050,11 +10071,14 @@ sub symbverify { } if ( &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) - eq $symb) { + eq $symb) { + if (ref($encstate)) { + $$encstate = $bighash{'encrypted_'.$id}; + } if (($env{'request.role.adv'}) || ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) || ($thisurl eq '/adm/navmaps')) { - $okay=1; + $okay=1; } } } @@ -12251,12 +12275,14 @@ returns the data handle =item * -symbverify($symb,$thisfn) : verifies that $symb actually exists and is -a possible symb for the URL in $thisfn, and if is an encryypted +symbverify($symb,$thisfn,$encstate) : verifies that $symb actually exists +and is a possible symb for the URL in $thisfn, and if is an encrypted resource that the user accessed using /enc/ returns a 1 on success, 0 -on failure, user must be in a course, as it assumes the existance of -the course initial hash, and uses $env('request.course.id'} - +on failure, user must be in a course, as it assumes the existence of +the course initial hash, and uses $env('request.course.id'}. The third +arg is an optional reference to a scalar. If this arg is passed in the +call to symbverify, it will be set to 1 if the symb has been set to be +encrypted; otherwise it will be null. =item *