--- loncom/lonnet/perl/lonnet.pm 2007/03/02 23:53:19 1.840 +++ loncom/lonnet/perl/lonnet.pm 2007/03/03 01:33:10 1.841 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.840 2007/03/02 23:53:19 albertel Exp $ +# $Id: lonnet.pm,v 1.841 2007/03/03 01:33:10 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -640,19 +640,19 @@ sub homeserver { my $index="$uname:$udom"; if (exists($homecache{$index})) { return $homecache{$index}; } - my $tryserver; - foreach $tryserver (keys %libserv) { + + my %servers = &get_servers($udom,'library'); + foreach my $tryserver (keys(%servers)) { next if ($ignoreBadCache ne 'true' && exists($badServerCache{$tryserver})); - if ($hostdom{$tryserver} eq $udom) { - my $answer=reply("home:$udom:$uname",$tryserver); - if ($answer eq 'found') { - delete($badServerCache{$tryserver}); - return $homecache{$index}=$tryserver; - } elsif ($answer eq 'no_host') { - $badServerCache{$tryserver}=1; - } - } + + my $answer=reply("home:$udom:$uname",$tryserver); + if ($answer eq 'found') { + delete($badServerCache{$tryserver}); + return $homecache{$index}=$tryserver; + } elsif ($answer eq 'no_host') { + $badServerCache{$tryserver}=1; + } } return 'no_host'; } @@ -663,24 +663,22 @@ sub idget { my ($udom,@ids)=@_; my %returnhash=(); - my $tryserver; - foreach $tryserver (keys %libserv) { - if ($hostdom{$tryserver} eq $udom) { - my $idlist=join('&',@ids); - $idlist=~tr/A-Z/a-z/; - my $reply=&reply("idget:$udom:".$idlist,$tryserver); - my @answer=(); - if (($reply ne 'con_lost') && ($reply!~/^error\:/)) { - @answer=split(/\&/,$reply); - } ; - my $i; - for ($i=0;$i<=$#ids;$i++) { - if ($answer[$i]) { - $returnhash{$ids[$i]}=$answer[$i]; - } - } - } - } + my %servers = &get_servers($udom,'library'); + foreach my $tryserver (keys(%servers)) { + my $idlist=join('&',@ids); + $idlist=~tr/A-Z/a-z/; + my $reply=&reply("idget:$udom:".$idlist,$tryserver); + my @answer=(); + if (($reply ne 'con_lost') && ($reply!~/^error\:/)) { + @answer=split(/\&/,$reply); + } ; + my $i; + for ($i=0;$i<=$#ids;$i++) { + if ($answer[$i]) { + $returnhash{$ids[$i]}=$answer[$i]; + } + } + } return %returnhash; } @@ -1912,13 +1910,12 @@ sub flushcourselogs { delete $domainrolehash{$entry}; } foreach my $dom (keys(%domrolebuffer)) { - foreach my $tryserver (keys %libserv) { - if ($hostdom{$tryserver} eq $dom) { - unless (&reply('domroleput:'.$dom.':'. - $domrolebuffer{$dom},$tryserver) eq 'ok') { - &logthis('Put of domain roles failed for '.$dom.' and '.$tryserver); - } - } + my %servers = &get_servers($dom,'library'); + foreach my $tryserver (keys(%servers)) { + unless (&reply('domroleput:'.$dom.':'. + $domrolebuffer{$dom},$tryserver) eq 'ok') { + &logthis('Put of domain roles failed for '.$dom.' and '.$tryserver); + } } } $dumpcount++; @@ -2194,19 +2191,19 @@ sub get_domain_roles { } my $rolelist = join(':',@{$roles}); my %personnel = (); - foreach my $tryserver (keys(%libserv)) { - if ($hostdom{$tryserver} eq $dom) { - %{$personnel{$tryserver}}=(); - foreach my $line ( - split(/\&/,&reply('domrolesdump:'.$dom.':'. - &escape($startdate).':'.&escape($enddate).':'. - &escape($rolelist), $tryserver))) { - my ($key,$value) = split(/\=/,$line,2); - if (($key) && ($value)) { - $personnel{$tryserver}{&unescape($key)} = &unescape($value); - } - } - } + + my %servers = &get_servers($dom,'library'); + foreach my $tryserver (keys(%servers)) { + %{$personnel{$tryserver}}=(); + foreach my $line (split(/\&/,&reply('domrolesdump:'.$dom.':'. + &escape($startdate).':'. + &escape($enddate).':'. + &escape($rolelist), $tryserver))) { + my ($key,$value) = split(/\=/,$line,2); + if (($key) && ($value)) { + $personnel{$tryserver}{&unescape($key)} = &unescape($value); + } + } } return %personnel; } @@ -4459,12 +4456,11 @@ sub auto_instcode_format { my $courses = ''; my @homeservers; if ($caller eq 'global') { - foreach my $tryserver (keys(%libserv)) { - if ($hostdom{$tryserver} eq $codedom) { - if (!grep(/^\Q$tryserver\E$/,@homeservers)) { - push(@homeservers,$tryserver); - } - } + my %servers = &get_servers($codedom,'library'); + foreach my $tryserver (keys(%servers)) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { + push(@homeservers,$tryserver); + } } } else { push(@homeservers,&homeserver($caller,$codedom)); @@ -4498,35 +4494,31 @@ sub auto_instcode_format { sub auto_instcode_defaults { my ($domain,$returnhash,$code_order) = @_; my @homeservers; - foreach my $tryserver (keys(%libserv)) { - if ($hostdom{$tryserver} eq $domain) { - if (!grep(/^\Q$tryserver\E$/,@homeservers)) { - push(@homeservers,$tryserver); - } - } + + my %servers = &get_servers($domain,'library'); + foreach my $tryserver (keys(%servers)) { + if (!grep(/^\Q$tryserver\E$/,@homeservers)) { + push(@homeservers,$tryserver); + } } - my $ok_response = 0; + my $response; - while (@homeservers > 0 && $ok_response == 0) { - my $server = shift(@homeservers); + foreach my $server (@homeservers) { $response=&reply('autoinstcodedefaults:'.$domain,$server); - if ($response !~ /(con_lost|error|no_such_host|refused)/) { - foreach my $pair (split(/\&/,$response)) { - my ($name,$value)=split(/\=/,$pair); - if ($name eq 'code_order') { - @{$code_order} = split(/\&/,&unescape($value)); - } else { - $returnhash->{&unescape($name)}=&unescape($value); - } - } - $ok_response = 1; - } - } - if ($ok_response) { - return 'ok'; - } else { - return $response; + next if ($response =~ /(con_lost|error|no_such_host|refused)/); + + foreach my $pair (split(/\&/,$response)) { + my ($name,$value)=split(/\=/,$pair); + if ($name eq 'code_order') { + @{$code_order} = split(/\&/,&unescape($value)); + } else { + $returnhash->{&unescape($name)}=&unescape($value); + } + } + return 'ok'; } + + return $response; } sub auto_validate_class_sec { @@ -4824,16 +4816,14 @@ sub modifyuser { } elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) { $unhome=$env{'course.'.$env{'request.course.id'}.'.home'}; } else { # load balancing routine for determining $unhome - my $tryserver; my $loadm=10000000; - foreach $tryserver (keys %libserv) { - if ($hostdom{$tryserver} eq $udom) { - my $answer=reply('load',$tryserver); - if (($answer=~/\d+/) && ($answer<$loadm)) { - $loadm=$answer; - $unhome=$tryserver; - } - } + my %servers = &get_servers($udom,'library'); + foreach my $tryserver (keys(%servers)) { + my $answer=reply('load',$tryserver); + if (($answer=~/\d+/) && ($answer<$loadm)) { + $loadm=$answer; + $unhome=$tryserver; + } } } if (($unhome eq '') || ($unhome eq 'no_host')) { @@ -5581,28 +5571,27 @@ sub dirlist { return @listing_results; } elsif(!defined($alternateDirectoryRoot)) { my %allusers; - foreach my $tryserver (keys(%libserv)) { - if($hostdom{$tryserver} eq $udom) { - my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'. - $udom, $tryserver); - my @listing_results; - if ($listing eq 'unknown_cmd') { - $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'. - $udom, $tryserver); - @listing_results = split(/:/,$listing); - } else { - @listing_results = - map { &unescape($_); } split(/:/,$listing); - } - if ($listing_results[0] ne 'no_such_dir' && - $listing_results[0] ne 'empty' && - $listing_results[0] ne 'con_lost') { - foreach my $line (@listing_results) { - my ($entry) = split(/&/,$line,2); - $allusers{$entry} = 1; - } - } - } + my %servers = &get_servers($udom,'library'); + foreach my $tryserver (keys(%servers)) { + my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'. + $udom, $tryserver); + my @listing_results; + if ($listing eq 'unknown_cmd') { + $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'. + $udom, $tryserver); + @listing_results = split(/:/,$listing); + } else { + @listing_results = + map { &unescape($_); } split(/:/,$listing); + } + if ($listing_results[0] ne 'no_such_dir' && + $listing_results[0] ne 'empty' && + $listing_results[0] ne 'con_lost') { + foreach my $line (@listing_results) { + my ($entry) = split(/&/,$line,2); + $allusers{$entry} = 1; + } + } } my $alluserstr=''; foreach my $user (sort(keys(%allusers))) { @@ -5614,18 +5603,12 @@ sub dirlist { return ('missing user name'); } } elsif(!defined($alternateDirectoryRoot)) { - my $tryserver; - my %alldom=(); - foreach $tryserver (keys(%libserv)) { - $alldom{$hostdom{$tryserver}}=1; - } - my $alldomstr=''; - foreach my $domain (sort(keys(%alldom))) { - $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:'; - } - $alldomstr=~s/:$//; - return split(/:/,$alldomstr); - } else { + my @all_domains = sort(&all_domains()); + foreach my $domain (@all_domains) { + $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain'; + } + return @all_domains; + } else { return ('missing domain'); } } @@ -7633,6 +7616,23 @@ BEGIN { sub all_hostnames { return %hostname; } + sub get_servers { + my ($domain,$type) = @_; + my %possible_hosts = ($type eq 'library') ? %libserv + : %hostname; + my %result; + while ( my ($host,$hostname) = each(%possible_hosts)) { + if ($hostdom{$host} eq $domain) { + $result{$host} = $hostname; + } + } + return %result; + } + sub all_domains { + my %seen; + my @uniq = grep(!$seen{$_}++, values(%hostdom)); + return @uniq; + } } sub get_hosts_from_ip {