--- loncom/lonnet/perl/lonnet.pm 2002/06/24 20:25:44 1.244 +++ loncom/lonnet/perl/lonnet.pm 2002/06/27 21:11:44 1.249 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.244 2002/06/24 20:25:44 matthew Exp $ +# $Id: lonnet.pm,v 1.249 2002/06/27 21:11:44 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -80,7 +80,7 @@ use vars qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom %libserv %pr %prp %metacache %packagetab %courselogs %accesshash $processmarker $dumpcount - %coursedombuf %coursehombuf %courseresdatacache); + %coursedombuf %coursehombuf %courseresdatacache %domaindescription); use IO::Socket; use GDBM_File; use Apache::Constants qw(:common :http); @@ -1737,9 +1737,15 @@ sub allowed { } } -# Restricted by state? +# Restricted by state or randomout? if ($thisallowed=~/X/) { + if ($ENV{'acc.randomout'}) { + my $symb=&symbread($uri,1); + if (($symb) && ($ENV{'acc.randomout'}=~/\&$symb\&/)) { + return ''; + } + } if (&condval($statecond)) { return '2'; } else { @@ -2695,7 +2701,7 @@ sub symbclean { # ------------------------------------------------------ Return symb list entry sub symbread { - my $thisfn=shift; + my ($thisfn,$donotrecurse)=@_; # no filename provided? try from environment unless ($thisfn) { if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } @@ -2744,7 +2750,7 @@ sub symbread { # ----------------------------------------------- There is only one possibility my ($mapid,$resid)=split(/\./,$ids); $syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid; - } else { + } elsif (!$donotrecurse) { # ------------------------------------------ There is more than one possibility my $realpossible=0; foreach (@possibilities) { @@ -2759,6 +2765,8 @@ sub symbread { } } if ($realpossible!=1) { $syval=''; } + } else { + $syval=''; } } untie(%bighash) @@ -2943,10 +2951,13 @@ BEGIN { while (my $configline=<$config>) { chomp($configline); - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); + my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); $hostname{$id}=$name; $hostdom{$id}=$domain; $hostip{$id}=$ip; + if ($domdescr) { + $domaindescription{$domain}=$domdescr; + } if ($role eq 'library') { $libserv{$id}=$name; } } }