--- loncom/lonnet/perl/lonnet.pm 2010/03/21 21:05:51 1.1058 +++ loncom/lonnet/perl/lonnet.pm 2010/05/04 15:21:29 1.1062 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1058 2010/03/21 21:05:51 raeburn Exp $ +# $Id: lonnet.pm,v 1.1062 2010/05/04 15:21:29 droeschl 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 { @@ -4539,7 +4515,7 @@ sub get_portfolio_access { my (%allgroups,%allroles); my ($start,$end,$role,$sec,$group); foreach my $envkey (%env) { - if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) { + if ($envkey =~ m-^user\.role\.(gr|cc|co|in|ta|ep|ad|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) { my $cid = $2.'_'.$3; if ($1 eq 'gr') { $group = $4; @@ -5476,6 +5452,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; @@ -6234,7 +6212,6 @@ sub assignrole { if ($role eq 'cc' || $role eq 'co') { %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner')); if (($role eq 'cc') && ($cnum !~ /^$match_community$/)) { - if ($env{'request.role'} eq 'cc./'.$cdom.'/'.$cnum) { if ($crsenv{'internal.courseowner'} eq $env{'user.name'}.':'.$env{'user.domain'}) { @@ -6443,9 +6420,15 @@ sub modifyuser { $forceid, $desiredhome, $email, $inststatus, $candelete)=@_; $udom= &LONCAPA::clean_domain($udom); $uname=&LONCAPA::clean_username($uname); + my $showcandelete = 'none'; + if (ref($candelete) eq 'ARRAY') { + if (@{$candelete} > 0) { + $showcandelete = join(', ',@{$candelete}); + } + } &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. $umode.', '.$first.', '.$middle.', '. - $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$candelete.')'. + $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'. (defined($desiredhome) ? ' desiredhome = '.$desiredhome : ' desiredhome not specified'). ' by '.$env{'user.name'}.' at '.$env{'user.domain'}. @@ -9678,6 +9661,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); @@ -9701,6 +9690,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);