--- loncom/lonnet/perl/lonnet.pm 2002/09/07 17:53:05 1.279 +++ loncom/lonnet/perl/lonnet.pm 2002/09/16 20:09:47 1.283 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.279 2002/09/07 17:53:05 www Exp $ +# $Id: lonnet.pm,v 1.283 2002/09/16 20:09:47 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -348,6 +348,28 @@ sub delenv { return 'ok'; } +# ------------------------------------------ Fight off request when overloaded + +sub overloaderror { + my ($r,$checkserver)=@_; + unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; } + my $loadavg; + if ($checkserver eq $perlvar{'lonHostID'}) { + my $loadfile=Apache::File->new('/proc/loadavg'); + $loadavg=<$loadfile>; + $loadavg =~ s/\s.*//g; + } else { + $loadavg=&reply('load',$checkserver); + } + my $overload=$loadavg-$perlvar{'lonLoadLim'}; + if ($overload>0) { + $r->err_headers_out->{'Retry-After'}=$overload*30; + $r->log_error('Overload of '.$overload.' on '.$checkserver); + return 413; + } + return ''; +} + # ------------------------------ Find server with least workload from spare.tab sub spareserver { @@ -871,7 +893,7 @@ sub countacc { my $url=&declutter(shift); unless ($ENV{'request.course.id'}) { return ''; } $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1; - my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count'; + my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count'; if (defined($accesshash{$key})) { $accesshash{$key}++; } else { @@ -2574,7 +2596,7 @@ sub courseresdata { # --------------------------------------------------------- Value of a Variable sub EXT { - my ($varname,$symbparm,$udom,$uname)=@_; + my ($varname,$symbparm,$udom,$uname,)=@_; unless ($varname) { return ''; } @@ -2731,10 +2753,16 @@ sub EXT { # --------------------------------------------- last, look in resource metadata $spacequalifierrest=~s/\./\_/; - my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); + my $filename; + if (!$symbparm) { $symbparm=&symbread(); } + if ($symbparm) { + $filename=(split(/\_\_\_/,$symbparm))[2]; + } else { + $filename=$ENV{'request.filename'}; + } + my $metadata=&metadata($filename,$spacequalifierrest); if ($metadata) { return $metadata; } - $metadata=&metadata($ENV{'request.filename'}, - 'parameter_'.$spacequalifierrest); + $metadata=&metadata($filename,'parameter_'.$spacequalifierrest); if ($metadata) { return $metadata; } # ------------------------------------------------------------------ Cascade up @@ -2970,7 +2998,7 @@ sub symbverify { my $okay=0; if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', &GDBM_READER(),0640)) { - my $ids=$bighash{'ids_/res/'.$thisfn}; + my $ids=$bighash{'ids_'.&clutter($thisfn)}; unless ($ids) { $ids=$bighash{'ids_/'.$thisfn}; } @@ -3041,7 +3069,7 @@ sub symbread { if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', &GDBM_READER(),0640)) { # ---------------------------------------------- Get ID(s) for current resource - my $ids=$bighash{'ids_/res/'.$thisfn}; + my $ids=$bighash{'ids_'.&clutter($thisfn)}; unless ($ids) { $ids=$bighash{'ids_/'.$thisfn}; } @@ -3349,7 +3377,7 @@ BEGIN { %metacache=(); -$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; +$processmarker='_'.time.'_'.$perlvar{'lonHostID'}; $dumpcount=0; &logtouch();