--- loncom/lonnet/perl/lonnet.pm 2007/03/03 01:54:13 1.842 +++ loncom/lonnet/perl/lonnet.pm 2007/03/08 01:54:50 1.845 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.842 2007/03/03 01:54:13 albertel Exp $ +# $Id: lonnet.pm,v 1.845 2007/03/08 01:54:50 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,8 +35,8 @@ use HTTP::Headers; use HTTP::Date; # use Date::Parse; use vars -qw(%perlvar %badServerCache %iphost %spareid %hostdom - %libserv %pr %prp $memcache %packagetab +qw(%perlvar %badServerCache %iphost %spareid + %pr %prp $memcache %packagetab %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf %domaindescription %domain_auth_def %domain_auth_arg_def @@ -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); } @@ -2133,11 +2133,16 @@ sub courseiddump { my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; my %returnhash=(); unless ($domfilter) { $domfilter=''; } - foreach my $tryserver (keys %libserv) { - if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) { - if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { + my %libserv = &all_library(); + foreach my $tryserver (keys(%libserv)) { + if ( ( $hostidflag == 1 + && grep(/^\Q$tryserver\E$/,@{$hostidref}) ) + || (!defined($hostidflag)) ) { + + if ($domfilter eq '' + || (&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))) { @@ -4170,6 +4175,7 @@ sub definerole { sub metadata_query { my ($query,$custom,$customshow,$server_array)=@_; my %rhash; + my %libserv = &all_library(); my @server_list = (defined($server_array) ? @$server_array : keys(%libserv) ); for my $server (@server_list) { @@ -4811,7 +4817,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'}; @@ -5038,7 +5044,7 @@ sub createcourse { } # ------------------------------------------------ Check supplied server name $course_server = $env{'user.homeserver'} if (! defined($course_server)); - if (! exists($libserv{$course_server})) { + if (! &is_library($course_server)) { return 'error:bad server name '.$course_server; } # ------------------------------------------------------------- Make the course @@ -7404,7 +7410,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 +7598,8 @@ BEGIN { # ------------------------------------------------------------- Read hosts file { my %hostname; + my %hostdom; + my %libserv; open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); while (my $configline=<$config>) { @@ -7613,9 +7621,19 @@ BEGIN { my ($lonid) = @_; return $hostname{$lonid}; } + sub all_hostnames { return %hostname; } + + sub is_library { + return exists($libserv{$_[0]}); + } + + sub all_library { + return %libserv; + } + sub get_servers { my ($domain,$type) = @_; my %possible_hosts = ($type eq 'library') ? %libserv @@ -7623,7 +7641,7 @@ BEGIN { my %result; if (ref($domain) eq 'ARRAY') { while ( my ($host,$hostname) = each(%possible_hosts)) { - if (grep(/\Q$hostdom{$host}\E/,@$domain)) { + if (grep(/^\Q$hostdom{$host}\E$/,@$domain)) { $result{$host} = $hostname; } } @@ -7636,6 +7654,12 @@ BEGIN { } return %result; } + + sub host_domain { + my ($lonid) = @_; + return $hostdom{$lonid}; + } + sub all_domains { my %seen; my @uniq = grep(!$seen{$_}++, values(%hostdom));