--- loncom/lonnet/perl/lonnet.pm 2002/06/24 19:41:41 1.243 +++ loncom/lonnet/perl/lonnet.pm 2002/06/27 16:03:55 1.247 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.243 2002/06/24 19:41:41 albertel Exp $ +# $Id: lonnet.pm,v 1.247 2002/06/27 16:03:55 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,13 @@ sub allowed { } } -# Restricted by state? +# Restricted by state or randomout? if ($thisallowed=~/X/) { + if ($ENV{'acc.randomout'}) { + my $symb=&symbread(); + if ($ENV{'acc.randomout'}=~/\&$symb\&/) { return ''; } + } if (&condval($statecond)) { return '2'; } else { @@ -1812,9 +1816,11 @@ sub definerole { # ---------------- Make a metadata query against the network of library servers sub metadata_query { - my ($query,$custom,$customshow)=@_; + my ($query,$custom,$customshow,$server_array)=@_; my %rhash; - for my $server (keys %libserv) { + my @server_list = (defined($server_array) ? @$server_array + : keys(%libserv) ); + for my $server (@server_list) { unless ($custom or $customshow) { my $reply=&reply("querysend:".&escape($query),$server); $rhash{$server}=$reply; @@ -2941,10 +2947,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; } } }