--- loncom/lonnet/perl/lonnet.pm 2003/04/30 21:09:55 1.366 +++ loncom/lonnet/perl/lonnet.pm 2003/05/08 21:50:54 1.370 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.366 2003/04/30 21:09:55 albertel Exp $ +# $Id: lonnet.pm,v 1.370 2003/05/08 21:50:54 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -347,6 +347,29 @@ sub delenv { return 'ok'; } +# ------------------------------------------ Find out current server userload +# there is a copy in lond +sub userload { + my $numusers=0; + { + opendir(LONIDS,$perlvar{'lonIDsDir'}); + my $filename; + my $curtime=time; + while ($filename=readdir(LONIDS)) { + if ($filename eq '.' || $filename eq '..') {next;} + my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8]; + if ($curtime-$atime < 3600) { $num_users++; } + } + closedir(LONIDS); + } + my $userloadpercent=0; + my $maxuserload=$perlvar{'lonUserLoadLim'}; + if ($maxuserload) { + $userloadpercent=100*$num_users/$maxuserload; + } + return $userloadpercent; +} + # ------------------------------------------ Fight off request when overloaded sub overloaderror { @@ -373,17 +396,23 @@ sub overloaderror { # ------------------------------ Find server with least workload from spare.tab sub spareserver { - my $loadpercent = shift; + my ($loadpercent,$userloadpercent) = @_; my $tryserver; my $spareserver=''; - my $lowestserver=$loadpercent; + if ($userloadpercent !~ /\d/) { $userloadpercent=0; } + my $lowestserver=$loadpercent > $userloadpercent? + $loadpercent : $userloadpercent; foreach $tryserver (keys %spareid) { - my $answer=reply('load',$tryserver); + my $loadans=reply('load',$tryserver); + my $userloadans=reply('userload',$tryserver); + if ($userloadans !~ /\d/) { $userloadans=0; } + my $answer=$loadans > $userloadans? + $loadans : $userloadans; if (($answer =~ /\d/) && ($answer<$lowestserver)) { $spareserver="http://$hostname{$tryserver}"; $lowestserver=$answer; } - } + } return $spareserver; } @@ -650,8 +679,7 @@ sub comment_access_key { if ($existing{$ckey}) { $existing{$ckey}.='; '.$logentry; # ready to assign - $logentry=$1.'; '.$logentry; - if (&put('accesskey',{$ckey=>$existing{$ckey}}, + if (&put('accesskeys',{$ckey=>$existing{$ckey}}, $cdom,$cnum) eq 'ok') { return 'ok'; } else { @@ -3764,6 +3792,10 @@ sub numval { return int($txt); } +sub latest_rnd_algorithm_id { + return '64bit'; +} + sub rndseed { my ($symb,$courseid,$domain,$username)=@_;