--- loncom/lonnet/perl/lonnet.pm 2002/06/24 20:25:44 1.244 +++ loncom/lonnet/perl/lonnet.pm 2002/06/27 19:04:15 1.248 @@ -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.248 2002/06/27 19:04:15 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); + if (($symb) && ($ENV{'acc.randomout'}=~/\&$symb\&/)) { + return ''; + } + } if (&condval($statecond)) { return '2'; } else { @@ -2943,10 +2949,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; } } }