--- loncom/lonnet/perl/lonnet.pm 2003/05/02 15:26:36 1.367 +++ 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.367 2003/05/02 15:26:36 www 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; } @@ -3763,6 +3792,10 @@ sub numval { return int($txt); } +sub latest_rnd_algorithm_id { + return '64bit'; +} + sub rndseed { my ($symb,$courseid,$domain,$username)=@_;