--- loncom/lonnet/perl/lonnet.pm	2010/03/26 00:47:25	1.1060
+++ loncom/lonnet/perl/lonnet.pm	2010/05/21 12:11:17	1.1064
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1060 2010/03/26 00:47:25 raeburn Exp $
+# $Id: lonnet.pm,v 1.1064 2010/05/21 12:11:17 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -665,30 +665,6 @@ sub userload {
     return $userloadpercent;
 }
 
-# ------------------------------------------ Fight off request when overloaded
-
-sub overloaderror {
-    my ($r,$checkserver)=@_;
-    unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
-    my $loadavg;
-    if ($checkserver eq $perlvar{'lonHostID'}) {
-       open(my $loadfile,'/proc/loadavg');
-       $loadavg=<$loadfile>;
-       $loadavg =~ s/\s.*//g;
-       $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
-       close($loadfile);
-    } else {
-       $loadavg=&reply('load',$checkserver);
-    }
-    my $overload=$loadavg-100;
-    if ($overload>0) {
-	$r->err_headers_out->{'Retry-After'}=$overload;
-        $r->log_error('Overload of '.$overload.' on '.$checkserver);
-        return 413;
-    }    
-    return '';
-}
-
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
@@ -3943,23 +3919,36 @@ sub standard_roleprivs {
 }
 
 sub set_userprivs {
-    my ($userroles,$allroles,$allgroups) = @_; 
+    my ($userroles,$allroles,$allgroups,$groups_roles) = @_; 
     my $author=0;
     my $adv=0;
     my %grouproles = ();
     if (keys(%{$allgroups}) > 0) {
+        my @groupkeys; 
         foreach my $role (keys(%{$allroles})) {
-            my ($trole,$area,$sec,$extendedarea);
-            if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
-                $trole = $1;
-                $area = $2;
-                $sec = $3;
-                $extendedarea = $area.$sec;
-                if (exists($$allgroups{$area})) {
-                    foreach my $group (keys(%{$$allgroups{$area}})) {
-                        my $spec = $trole.'.'.$extendedarea;
-                        $grouproles{$spec.'.'.$area.'/'.$group} = 
+            push(@groupkeys,$role);
+        }
+        if (ref($groups_roles) eq 'HASH') {
+            foreach my $key (keys(%{$groups_roles})) {
+                unless (grep(/^\Q$key\E$/,@groupkeys)) {
+                    push(@groupkeys,$key);
+                }
+            }
+        }
+        if (@groupkeys > 0) {
+            foreach my $role (@groupkeys) {
+                my ($trole,$area,$sec,$extendedarea);
+                if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
+                    $trole = $1;
+                    $area = $2;
+                    $sec = $3;
+                    $extendedarea = $area.$sec;
+                    if (exists($$allgroups{$area})) {
+                        foreach my $group (keys(%{$$allgroups{$area}})) {
+                            my $spec = $trole.'.'.$extendedarea;
+                            $grouproles{$spec.'.'.$area.'/'.$group} = 
                                                 $$allgroups{$area}{$group};
+                        }
                     }
                 }
             }
@@ -4006,26 +3995,58 @@ sub role_status {
                 if ($$tstart<$now) {
                     if ($$tstart && $$tstart>$refresh) {
                         if (($$where ne '') && ($$role ne '')) {
-                            my (%allroles,%allgroups,$group_privs);
+                            my (%allroles,%allgroups,$group_privs,
+                                %groups_roles,@rolecodes);
                             my %userroles = (
                                 'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
                             );
+                            @rolecodes = ('cm'); 
                             my $spec=$$role.'.'.$$where;
                             my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
                             if ($$role =~ /^cr\//) {
                                 &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
+                                push(@rolecodes,'cr');
                             } elsif ($$role eq 'gr') {
+                                push(@rolecodes,$$role);
                                 my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
                                                     $env{'user.name'});
-                                my $trole = split('_',$rolehash{$$where.'_'.$$role},1);
+                                my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);
                                 (undef,my $group_privs) = split(/\//,$trole);
                                 $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);
+                                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);
                             }
-                            my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
-                            &appenv(\%userroles,[$$role,'cm']);
+                            my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
+                            &appenv(\%userroles,\@rolecodes);
                             &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
                         }
                     }
@@ -5476,6 +5497,8 @@ sub metadata_query {
     my @server_list = (defined($server_array) ? @$server_array
                                               : keys(%libserv) );
     for my $server (@server_list) {
+#SD remove this
+&logthis("Querying server:$server");
 	unless ($custom or $customshow) {
 	    my $reply=&reply("querysend:".&escape($query),$server);
 	    $rhash{$server}=$reply;
@@ -9683,6 +9706,12 @@ sub get_dns {
 	return %libserv;
     }
 
+    sub unique_library {
+	#2x reverse removes all hostnames that appear more than once
+        my %unique = reverse &all_library();
+        return reverse %unique;
+    }
+
     sub get_servers {
 	&load_hosts_tab() if (!$loaded);
 
@@ -9706,6 +9735,11 @@ sub get_dns {
 	return %result;
     }
 
+    sub get_unique_servers {
+        my %unique = reverse &get_servers(@_);
+	return reverse %unique;
+    }
+
     sub host_domain {
 	&load_hosts_tab() if (!$loaded);