--- loncom/lonnet/perl/lonnet.pm	2012/02/08 01:05:20	1.1056.4.33.2.2
+++ loncom/lonnet/perl/lonnet.pm	2014/05/05 11:37:07	1.1056.4.39
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.4.33.2.2 2012/02/08 01:05:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.39 2014/05/05 11:37:07 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -636,20 +636,11 @@ sub appenv {
 # ----------------------------------------------------- Delete from Environment
 
 sub delenv {
-    my ($delthis,$regexp,$roles) = @_;
-    if (($delthis=~/^user\.role/) || ($delthis=~/^user\.priv/)) {
-        my $refused = 1;
-        if (ref($roles) eq 'ARRAY') {
-            my ($type,$role) = ($delthis =~ /^user\.(role|priv)\.([^.]+)\./);
-            if (grep(/^\Q$role\E$/,@{$roles})) {
-                $refused = 0;
-            }
-        }
-        if ($refused) {
-            &logthis("<font color=\"blue\">WARNING: ".
-                     "Attempt to delete from environment ".$delthis);
-            return 'error';
-        }
+    my ($delthis,$regexp) = @_;
+    if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
+        &logthis("<font color=\"blue\">WARNING: ".
+                "Attempt to delete from environment ".$delthis);
+        return 'error';
     }
     my $opened = open(my $env_file,'+<',$env{'user.environment'});
     if ($opened
@@ -835,7 +826,17 @@ sub spareserver {
 }
 
 sub compare_server_load {
-    my ($try_server, $spare_server, $lowest_load) = @_;
+    my ($try_server, $spare_server, $lowest_load, $required) = @_;
+
+    if ($required) {
+        my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
+        my $remoterev = &get_server_loncaparev(undef,$try_server);
+        my ($major,$minor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+        if (($major eq '' && $minor eq '') ||
+            (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
+            return ($spare_server,$lowest_load);
+        }
+    }
 
     my $loadans     = &reply('load',    $try_server);
     my $userloadans = &reply('userload',$try_server);
@@ -887,26 +888,43 @@ sub has_user_session {
 # --------- determine least loaded server in a user's domain which allows login
 
 sub choose_server {
-    my ($udom,$checkloginvia) = @_;
+    my ($udom,$checkloginvia,$required,$notloadbal) = @_;
     my %domconfhash = &Apache::loncommon::get_domainconf($udom);
     my %servers = &get_servers($udom);
     my $lowest_load = 30000;
-    my ($login_host,$hostname,$portal_path,$isredirect);
+    my ($login_host,$hostname,$portal_path,$isredirect,$balancers);
+    if ($notloadbal) {
+        ($balancers,my $cached)=&is_cached_new('loadbalancing',$udom);
+        unless (defined($cached)) {
+            my $cachetime = 60*60*24;
+            my %domconfig =
+                &Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);
+            if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
+                $balancers = &do_cache_new('loadbalancing',$udom,$domconfig{'loadbalancing'},
+                                           $cachetime);
+            }
+        }
+    }
     foreach my $lonhost (keys(%servers)) {
+        if ($notloadbal) {
+            if (ref($balancers) eq 'HASH') {
+                next if (exists($balancers->{$lonhost}));
+            }
+        }
         my $loginvia;
         if ($checkloginvia) {
             $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
             if ($loginvia) {
                 my ($server,$path) = split(/:/,$loginvia);
                 ($login_host, $lowest_load) =
-                    &compare_server_load($lonhost, $login_host, $lowest_load);
+                    &compare_server_load($lonhost, $login_host, $lowest_load, $required);
                 if ($login_host eq $server) {
                     $portal_path = $path;
                     $isredirect = 1;
                 }
             } else {
                 ($login_host, $lowest_load) =
-                    &compare_server_load($lonhost, $login_host, $lowest_load);
+                    &compare_server_load($lonhost, $login_host, $lowest_load, $required);
                 if ($login_host eq $lonhost) {
                     $portal_path = '';
                     $isredirect = '';
@@ -914,7 +932,7 @@ sub choose_server {
             }
         } else {
             ($login_host, $lowest_load) =
-                &compare_server_load($lonhost, $login_host, $lowest_load);
+                &compare_server_load($lonhost, $login_host, $lowest_load, $required);
         }
     }
     if ($login_host ne '') {
@@ -3234,10 +3252,6 @@ sub get_my_roles {
                     if (!grep(/^cr$/,@{$roles})) {
                         next;
                     }
-                } elsif ($role =~ /^gr\//) {
-                    if (!grep(/^gr$/,@{$roles})) {
-                        next;
-                    }
                 } else {
                     next;
                 }
@@ -4076,9 +4090,12 @@ sub restore {
     if ($stuname) { $home=&homeserver($stuname,$domain); }
 
     if (!$symb) {
-      unless ($symb=escape(&symbread())) { return ''; }
+        return if ($namespace eq 'courserequests');
+        unless ($symb=escape(&symbread())) { return ''; }
     } else {
-      $symb=&escape(&symbclean($symb));
+        unless ($namespace eq 'courserequests') {
+            $symb=&escape(&symbclean($symb));
+        }
     }
     if (!$namespace) { 
        unless ($namespace=$env{'request.course.id'}) { 
@@ -4250,6 +4267,7 @@ sub rolesinit {
     }
     my %allroles=();
     my %allgroups=();   
+    my $group_privs;
 
     if ($rolesdump ne '') {
         foreach my $entry (split(/&/,$rolesdump)) {
@@ -4266,7 +4284,6 @@ sub rolesinit {
 		}
             } elsif ($role =~ m|^gr/|) {
                 ($trole,$tend,$tstart) = split(/_/,$role);
-                next if ($tstart eq '-1');
                 ($trole,$group_privs) = split(/\//,$trole);
                 $group_privs = &unescape($group_privs);
 	    } else {
@@ -4419,7 +4436,7 @@ sub set_userprivs {
             }
         }
         my $thesestr='';
-        foreach my $priv (sort(keys(%thesepriv))) {
+        foreach my $priv (keys(%thesepriv)) {
 	    $thesestr.=':'.$priv.'&'.$thesepriv{$priv};
 	}
         $userroles->{'user.priv.'.$role} = $thesestr;
@@ -4428,7 +4445,7 @@ sub set_userprivs {
 }
 
 sub role_status {
-    my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+    my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
     my @pwhere = ();
     if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
         (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
@@ -4437,7 +4454,7 @@ sub role_status {
             $$trolecode=$$role.'.'.$$where;
             ($$tstart,$$tend)=split(/\./,$env{$rolekey});
             $$tstatus='is';
-            if ($$tstart && $$tstart>$update) {
+            if ($$tstart && $$tstart>$then) {
                 $$tstatus='future';
                 if ($$tstart<$now) {
                     if ($$tstart && $$tstart>$refresh) {
@@ -4462,9 +4479,32 @@ sub role_status {
                                 $group_privs = &unescape($group_privs);
                                 &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
                                 my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);
-                                &get_groups_roles($tdomain,$trest,
-                                                  \%course_roles,\@rolecodes,
-                                                  \%groups_roles);
+                                if (keys(%course_roles) > 0) {
+                                    my ($tnum) = ($trest =~ /^($match_courseid)/);
+                                    if ($tdomain ne '' && $tnum ne '') {
+                                        foreach my $key (keys(%course_roles)) {
+                                            if ($key =~ /^\Q$tnum\E:\Q$tdomain\E:([^:]+):?([^:]*)/) {
+                                                my $crsrole = $1;
+                                                my $crssec = $2;
+                                                if ($crsrole =~ /^cr/) {
+                                                    unless (grep(/^cr$/,@rolecodes)) {
+                                                        push(@rolecodes,'cr');
+                                                    }
+                                                } else {
+                                                    unless(grep(/^\Q$crsrole\E$/,@rolecodes)) {
+                                                        push(@rolecodes,$crsrole);
+                                                    }
+                                                }
+                                                my $rolekey = $crsrole.'./'.$tdomain.'/'.$tnum;
+                                                if ($crssec ne '') {
+                                                    $rolekey .= '/'.$crssec;
+                                                }
+                                                $rolekey .= './';
+                                                $groups_roles{$rolekey} = \@rolecodes;
+                                            }
+                                        }
+                                    }
+                                }
                             } else {
                                 push(@rolecodes,$$role);
                                 &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
@@ -4478,7 +4518,7 @@ sub role_status {
                 }
             }
             if ($$tend) {
-                if ($$tend<$update) {
+                if ($$tend<$then) {
                     $$tstatus='expired';
                 } elsif ($$tend<$now) {
                     $$tstatus='will_not';
@@ -4488,70 +4528,12 @@ sub role_status {
     }
 }
 
-sub get_groups_roles {
-    my ($cdom,$rest,$cdom_courseroles,$rolecodes,$groups_roles) = @_;
-    return unless((ref($cdom_courseroles) eq 'HASH') &&
-                  (ref($rolecodes) eq 'ARRAY') &&
-                  (ref($groups_roles) eq 'HASH'));
-    if (keys(%{$cdom_courseroles}) > 0) {
-        my ($cnum) = ($rest =~ /^($match_courseid)/);
-        if ($cdom ne '' && $cnum ne '') {
-            foreach my $key (keys(%{$cdom_courseroles})) {
-                if ($key =~ /^\Q$cnum\E:\Q$cdom\E:([^:]+):?([^:]*)/) {
-                    my $crsrole = $1;
-                    my $crssec = $2;
-                    if ($crsrole =~ /^cr/) {
-                        unless (grep(/^cr$/,@{$rolecodes})) {
-                            push(@{$rolecodes},'cr');
-                        }
-                    } else {
-                        unless(grep(/^\Q$crsrole\E$/,@{$rolecodes})) {
-                            push(@{$rolecodes},$crsrole);
-                        }
-                    }
-                    my $rolekey = "$crsrole./$cdom/$cnum";
-                    if ($crssec ne '') {
-                        $rolekey .= "/$crssec";
-                    }
-                    $rolekey .= './';
-                    $groups_roles->{$rolekey} = $rolecodes;
-                }
-            }
-        }
-    }
-    return;
-}
-
-sub delete_env_groupprivs {
-    my ($where,$courseroles,$possroles) = @_;
-    return unless((ref($courseroles) eq 'HASH') && (ref($possroles) eq 'ARRAY'));
-    my ($dummy,$udom,$uname,$group) = split(/\//,$where);
-    unless (ref($courseroles->{$udom}) eq 'HASH') {
-        %{$courseroles->{$udom}} =
-            &get_my_roles('','','userroles',['active'],
-                          $possroles,[$udom],1);
-    }
-    if (ref($courseroles->{$udom}) eq 'HASH') {
-        foreach my $item (keys(%{$courseroles->{$udom}})) {
-            my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
-            my $area = '/'.$cdom.'/'.$cnum;
-            my $privkey = "user.priv.$crsrole.$area";
-            if ($crssec ne '') {
-                $privkey .= '/'.$crssec;
-            }
-            $privkey .= ".$area/$group";
-            &Apache::lonnet::delenv($privkey,undef,[$crsrole]);
-        }
-    }
-    return;
-}
-
 sub check_adhoc_privs {
-    my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
+    my ($cdom,$cnum,$then,$refresh,$now,$checkrole,$caller) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
     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);
+        &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
             &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
         }
@@ -7452,6 +7434,9 @@ sub store_userdata {
                     $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
                 }
                 $namevalue=~s/\&$//;
+                unless ($namespace eq 'courserequests') {
+                    $datakey = &escape($datakey);
+                }
                 $result =  &reply("store:$udom:$uname:$namespace:$datakey:".
                                   $namevalue,$uhome);
             }