--- loncom/lonnet/perl/lonnet.pm 2007/03/03 02:10:59 1.843 +++ loncom/lonnet/perl/lonnet.pm 2007/03/03 02:16:10 1.844 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.843 2007/03/03 02:10:59 albertel Exp $ +# $Id: lonnet.pm,v 1.844 2007/03/03 02:16:10 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,7 +35,7 @@ use HTTP::Headers; use HTTP::Date; # use Date::Parse; use vars -qw(%perlvar %badServerCache %iphost %spareid %hostdom +qw(%perlvar %badServerCache %iphost %spareid %libserv %pr %prp $memcache %packagetab %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf @@ -1842,7 +1842,7 @@ sub flushcourselogs { # Is used in pickcourse # foreach my $crs_home (keys(%courseidbuffer)) { - &courseidput($hostdom{$crs_home},$courseidbuffer{$crs_home}, + &courseidput(&host_domain($crs_home),$courseidbuffer{$crs_home}, $crs_home); } # @@ -2097,7 +2097,7 @@ sub get_my_roles { sub postannounce { my ($server,$text)=@_; - unless (&allowed('psa',$hostdom{$server})) { return 'refused'; } + unless (&allowed('psa',&host_domain($server))) { return 'refused'; } unless ($text=~/\w/) { $text=''; } return &reply('setannounce:'.&escape($text),$server); } @@ -2135,9 +2135,9 @@ sub courseiddump { unless ($domfilter) { $domfilter=''; } foreach my $tryserver (keys %libserv) { if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) { - if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { + if ((!$domfilter) || (&host_domain($tryserver) eq $domfilter)) { foreach my $line ( - split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. + split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'. $sincefilter.':'.&escape($descfilter).':'. &escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok), $tryserver))) { @@ -4811,7 +4811,7 @@ sub modifyuser { if (($uhome eq 'no_host') && (($umode && $upass) || ($umode eq 'localauth'))) { my $unhome=''; - if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { + if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { $unhome = $desiredhome; } elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) { $unhome=$env{'course.'.$env{'request.course.id'}.'.home'}; @@ -7404,7 +7404,7 @@ sub current_machine_domains { while( my($id, $name) = each(%hostname)) { # &logthis("-$id-$name-$hostname-"); if ($hostname eq $name) { - push(@domains,$hostdom{$id}); + push(@domains,&host_domain($id)); } } return @domains; @@ -7592,6 +7592,7 @@ BEGIN { # ------------------------------------------------------------- Read hosts file { my %hostname; + my %hostdom; open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); while (my $configline=<$config>) { @@ -7636,6 +7637,11 @@ BEGIN { } return %result; } + sub host_domain { + my ($lonid) = @_; + return $hostdom{$lonid}; + } + sub all_domains { my %seen; my @uniq = grep(!$seen{$_}++, values(%hostdom));