[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.840 and 1.841

version 1.840, 2007/03/02 23:53:19 version 1.841, 2007/03/03 01:33:10
Line 640  sub homeserver { Line 640  sub homeserver {
     my $index="$uname:$udom";      my $index="$uname:$udom";
   
     if (exists($homecache{$index})) { return $homecache{$index}; }      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' &&           next if ($ignoreBadCache ne 'true' && 
  exists($badServerCache{$tryserver}));   exists($badServerCache{$tryserver}));
  if ($hostdom{$tryserver} eq $udom) {  
            my $answer=reply("home:$udom:$uname",$tryserver);   my $answer=reply("home:$udom:$uname",$tryserver);
            if ($answer eq 'found') {   if ($answer eq 'found') {
                delete($badServerCache{$tryserver});       delete($badServerCache{$tryserver}); 
        return $homecache{$index}=$tryserver;      return $homecache{$index}=$tryserver;
            } elsif ($answer eq 'no_host') {   } elsif ($answer eq 'no_host') {
        $badServerCache{$tryserver}=1;      $badServerCache{$tryserver}=1;
            }   }
        }  
     }          }    
     return 'no_host';      return 'no_host';
 }  }
Line 663  sub idget { Line 663  sub idget {
     my ($udom,@ids)=@_;      my ($udom,@ids)=@_;
     my %returnhash=();      my %returnhash=();
           
     my $tryserver;      my %servers = &get_servers($udom,'library');
     foreach $tryserver (keys %libserv) {      foreach my $tryserver (keys(%servers)) {
        if ($hostdom{$tryserver} eq $udom) {   my $idlist=join('&',@ids);
   my $idlist=join('&',@ids);   $idlist=~tr/A-Z/a-z/; 
           $idlist=~tr/A-Z/a-z/;    my $reply=&reply("idget:$udom:".$idlist,$tryserver);
   my $reply=&reply("idget:$udom:".$idlist,$tryserver);   my @answer=();
           my @answer=();   if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {
           if (($reply ne 'con_lost') && ($reply!~/^error\:/)) {      @answer=split(/\&/,$reply);
       @answer=split(/\&/,$reply);   }                    ;
           }                    ;   my $i;
           my $i;   for ($i=0;$i<=$#ids;$i++) {
           for ($i=0;$i<=$#ids;$i++) {      if ($answer[$i]) {
               if ($answer[$i]) {   $returnhash{$ids[$i]}=$answer[$i];
   $returnhash{$ids[$i]}=$answer[$i];      } 
               }    }
           }      } 
        }  
     }      
     return %returnhash;      return %returnhash;
 }  }
   
Line 1912  sub flushcourselogs { Line 1910  sub flushcourselogs {
         delete $domainrolehash{$entry};          delete $domainrolehash{$entry};
     }      }
     foreach my $dom (keys(%domrolebuffer)) {      foreach my $dom (keys(%domrolebuffer)) {
         foreach my $tryserver (keys %libserv) {   my %servers = &get_servers($dom,'library');
             if ($hostdom{$tryserver} eq $dom) {   foreach my $tryserver (keys(%servers)) {
                 unless (&reply('domroleput:'.$dom.':'.      unless (&reply('domroleput:'.$dom.':'.
                   $domrolebuffer{$dom},$tryserver) eq 'ok') {     $domrolebuffer{$dom},$tryserver) eq 'ok') {
                     &logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);   &logthis('Put of domain roles failed for '.$dom.' and  '.$tryserver);
                 }      }
             }  
         }          }
     }      }
     $dumpcount++;      $dumpcount++;
Line 2194  sub get_domain_roles { Line 2191  sub get_domain_roles {
     }      }
     my $rolelist = join(':',@{$roles});      my $rolelist = join(':',@{$roles});
     my %personnel = ();      my %personnel = ();
     foreach my $tryserver (keys(%libserv)) {  
         if ($hostdom{$tryserver} eq $dom) {      my %servers = &get_servers($dom,'library');
             %{$personnel{$tryserver}}=();      foreach my $tryserver (keys(%servers)) {
             foreach my $line (   %{$personnel{$tryserver}}=();
                 split(/\&/,&reply('domrolesdump:'.$dom.':'.   foreach my $line (split(/\&/,&reply('domrolesdump:'.$dom.':'.
                    &escape($startdate).':'.&escape($enddate).':'.      &escape($startdate).':'.
                    &escape($rolelist), $tryserver))) {      &escape($enddate).':'.
                 my ($key,$value) = split(/\=/,$line,2);      &escape($rolelist), $tryserver))) {
                 if (($key) && ($value)) {      my ($key,$value) = split(/\=/,$line,2);
                     $personnel{$tryserver}{&unescape($key)} = &unescape($value);      if (($key) && ($value)) {
                 }   $personnel{$tryserver}{&unescape($key)} = &unescape($value);
             }      }
         }   }
     }      }
     return %personnel;      return %personnel;
 }  }
Line 4459  sub auto_instcode_format { Line 4456  sub auto_instcode_format {
     my $courses = '';      my $courses = '';
     my @homeservers;      my @homeservers;
     if ($caller eq 'global') {      if ($caller eq 'global') {
         foreach my $tryserver (keys(%libserv)) {   my %servers = &get_servers($codedom,'library');
             if ($hostdom{$tryserver} eq $codedom) {   foreach my $tryserver (keys(%servers)) {
                 if (!grep(/^\Q$tryserver\E$/,@homeservers)) {      if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
                     push(@homeservers,$tryserver);   push(@homeservers,$tryserver);
                 }      }
             }  
         }          }
     } else {      } else {
         push(@homeservers,&homeserver($caller,$codedom));          push(@homeservers,&homeserver($caller,$codedom));
Line 4498  sub auto_instcode_format { Line 4494  sub auto_instcode_format {
 sub auto_instcode_defaults {  sub auto_instcode_defaults {
     my ($domain,$returnhash,$code_order) = @_;      my ($domain,$returnhash,$code_order) = @_;
     my @homeservers;      my @homeservers;
     foreach my $tryserver (keys(%libserv)) {  
         if ($hostdom{$tryserver} eq $domain) {      my %servers = &get_servers($domain,'library');
             if (!grep(/^\Q$tryserver\E$/,@homeservers)) {      foreach my $tryserver (keys(%servers)) {
                 push(@homeservers,$tryserver);   if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
             }      push(@homeservers,$tryserver);
         }   }
     }      }
     my $ok_response = 0;  
     my $response;      my $response;
     while (@homeservers > 0 && $ok_response == 0) {      foreach my $server (@homeservers) {
         my $server = shift(@homeservers);  
         $response=&reply('autoinstcodedefaults:'.$domain,$server);          $response=&reply('autoinstcodedefaults:'.$domain,$server);
         if ($response !~ /(con_lost|error|no_such_host|refused)/) {          next if ($response =~ /(con_lost|error|no_such_host|refused)/);
             foreach my $pair (split(/\&/,$response)) {  
                 my ($name,$value)=split(/\=/,$pair);   foreach my $pair (split(/\&/,$response)) {
                 if ($name eq 'code_order') {      my ($name,$value)=split(/\=/,$pair);
                     @{$code_order} = split(/\&/,&unescape($value));      if ($name eq 'code_order') {
                 } else {   @{$code_order} = split(/\&/,&unescape($value));
                     $returnhash->{&unescape($name)}=&unescape($value);      } else {
                 }   $returnhash->{&unescape($name)}=&unescape($value);
             }      }
             $ok_response = 1;   }
         }   return 'ok';
     }  
     if ($ok_response) {  
         return 'ok';  
     } else {  
         return $response;  
     }      }
   
       return $response;
 }   } 
   
 sub auto_validate_class_sec {  sub auto_validate_class_sec {
Line 4824  sub modifyuser { Line 4816  sub modifyuser {
  } elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) {   } elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) {
     $unhome=$env{'course.'.$env{'request.course.id'}.'.home'};      $unhome=$env{'course.'.$env{'request.course.id'}.'.home'};
         } else { # load balancing routine for determining $unhome          } else { # load balancing routine for determining $unhome
             my $tryserver;  
             my $loadm=10000000;              my $loadm=10000000;
             foreach $tryserver (keys %libserv) {      my %servers = &get_servers($udom,'library');
        if ($hostdom{$tryserver} eq $udom) {      foreach my $tryserver (keys(%servers)) {
                   my $answer=reply('load',$tryserver);   my $answer=reply('load',$tryserver);
                   if (($answer=~/\d+/) && ($answer<$loadm)) {   if (($answer=~/\d+/) && ($answer<$loadm)) {
       $loadm=$answer;      $loadm=$answer;
                       $unhome=$tryserver;      $unhome=$tryserver;
                   }   }
        }  
     }      }
         }          }
         if (($unhome eq '') || ($unhome eq 'no_host')) {          if (($unhome eq '') || ($unhome eq 'no_host')) {
Line 5581  sub dirlist { Line 5571  sub dirlist {
             return @listing_results;              return @listing_results;
         } elsif(!defined($alternateDirectoryRoot)) {          } elsif(!defined($alternateDirectoryRoot)) {
             my %allusers;              my %allusers;
             foreach my $tryserver (keys(%libserv)) {      my %servers = &get_servers($udom,'library');
                 if($hostdom{$tryserver} eq $udom) {      foreach my $tryserver (keys(%servers)) {
                     my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.   my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'.
  $udom, $tryserver);       $udom, $tryserver);
                     my @listing_results;   my @listing_results;
                     if ($listing eq 'unknown_cmd') {   if ($listing eq 'unknown_cmd') {
                         $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.      $listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
   $udom, $tryserver);        $udom, $tryserver);
                         @listing_results = split(/:/,$listing);      @listing_results = split(/:/,$listing);
                     } else {   } else {
                         @listing_results =      @listing_results =
                             map { &unescape($_); } split(/:/,$listing);   map { &unescape($_); } split(/:/,$listing);
                     }   }
                     if ($listing_results[0] ne 'no_such_dir' &&    if ($listing_results[0] ne 'no_such_dir' && 
                         $listing_results[0] ne 'empty'       &&      $listing_results[0] ne 'empty'       &&
                         $listing_results[0] ne 'con_lost') {      $listing_results[0] ne 'con_lost') {
                         foreach my $line (@listing_results) {      foreach my $line (@listing_results) {
                             my ($entry) = split(/&/,$line,2);   my ($entry) = split(/&/,$line,2);
                             $allusers{$entry} = 1;   $allusers{$entry} = 1;
                         }      }
                     }   }
                 }  
             }              }
             my $alluserstr='';              my $alluserstr='';
             foreach my $user (sort(keys(%allusers))) {              foreach my $user (sort(keys(%allusers))) {
Line 5614  sub dirlist { Line 5603  sub dirlist {
             return ('missing user name');              return ('missing user name');
         }          }
     } elsif(!defined($alternateDirectoryRoot)) {      } elsif(!defined($alternateDirectoryRoot)) {
         my $tryserver;          my @all_domains = sort(&all_domains());
         my %alldom=();           foreach my $domain (@all_domains) {
         foreach $tryserver (keys(%libserv)) {               $domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain';
             $alldom{$hostdom{$tryserver}}=1;           }
         }           return @all_domains;
         my $alldomstr='';       } else {
         foreach my $domain (sort(keys(%alldom))) {  
             $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:';  
         }  
         $alldomstr=~s/:$//;  
         return split(/:/,$alldomstr);         
     } else {  
         return ('missing domain');          return ('missing domain');
     }      }
 }  }
Line 7633  BEGIN { Line 7616  BEGIN {
     sub all_hostnames {      sub all_hostnames {
  return %hostname;   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 {  sub get_hosts_from_ip {
Removed from v.1.840  
changed lines
  Added in v.1.841

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>