[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.226 and 1.231

version 1.226, 2002/05/18 18:54:29 version 1.231, 2002/05/22 13:56:43
Line 77  use Apache::File; Line 77  use Apache::File;
 use LWP::UserAgent();  use LWP::UserAgent();
 use HTTP::Headers;  use HTTP::Headers;
 use vars   use vars 
 qw(%perlvar %hostname %homecache %badhomecache %hostip %spareid %hostdom   qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab      %libserv %pr %prp %metacache %packagetab 
    %courselogs %accesshash $processmarker $dumpcount      %courselogs %accesshash $processmarker $dumpcount 
    %coursedombuf %coursehombuf %courseresdatacache);     %coursedombuf %coursehombuf %courseresdatacache);
Line 481  sub authenticate { Line 481  sub authenticate {
 # ---------------------- Find the homebase for a user from domain's lib servers  # ---------------------- Find the homebase for a user from domain's lib servers
   
 sub homeserver {  sub homeserver {
     my ($uname,$udom)=@_;      my ($uname,$udom,$ignoreBadCache)=@_;
     my $index="$uname:$udom";      my $index="$uname:$udom";
     if ($homecache{$index}) {       if ($homecache{$index}) { 
         return "$homecache{$index}";           return "$homecache{$index}"; 
     }      }
     my $tryserver;      my $tryserver;
     foreach $tryserver (keys %libserv) {      foreach $tryserver (keys %libserv) {
         next if (exists($badhomecache{$index}->{$tryserver}));          next if ($ignoreBadCache ne 'true' && 
    exists($badServerCache{$tryserver}));
  if ($hostdom{$tryserver} eq $udom) {   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') { 
               $homecache{$index}=$tryserver;                $homecache{$index}=$tryserver;
               return $tryserver;                 return $tryserver; 
            } else {             } elsif ($answer eq 'no_host') {
                $badhomecache{$index}->{$tryserver}=1;         $badServerCache{$tryserver}=1;
            }             }
        } else {  
            $badhomecache{$index}->{$tryserver}=1;  
        }         }
     }          }    
     return 'no_host';      return 'no_host';
Line 1880  sub modifyuser { Line 1879  sub modifyuser {
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :               (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified').                                        ' desiredhome not specified'). 
              ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});               ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom,'true');
 # ----------------------------------------------------------------- Create User  # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && ($umode) && ($upass)) {      if (($uhome eq 'no_host') && ($umode) && ($upass)) {
         my $unhome='';          my $unhome='';
Line 1910  sub modifyuser { Line 1909  sub modifyuser {
  unless ($reply eq 'ok') {   unless ($reply eq 'ok') {
             return 'error: '.$reply;              return 'error: '.$reply;
         }             }   
         $uhome=&homeserver($uname,$udom);          $uhome=&homeserver($uname,$udom,'true');
         if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {          if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
     return 'error: verify home';      return 'error: verify home';
         }          }
Line 2017  sub createcourse { Line 2016  sub createcourse {
    my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).     my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
        unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};         unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
 # ----------------------------------------------- Make sure that does not exist  # ----------------------------------------------- Make sure that does not exist
    my $uhome=&homeserver($uname,$udom);     my $uhome=&homeserver($uname,$udom,'true');
    unless (($uhome eq '') || ($uhome eq 'no_host')) {     unless (($uhome eq '') || ($uhome eq 'no_host')) {
        $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).         $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
         unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};          unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
        $uhome=&homeserver($uname,$udom);                $uhome=&homeserver($uname,$udom,'true');       
        unless (($uhome eq '') || ($uhome eq 'no_host')) {         unless (($uhome eq '') || ($uhome eq 'no_host')) {
            return 'error: unable to generate unique course-ID';             return 'error: unable to generate unique course-ID';
        }          } 
Line 2030  sub createcourse { Line 2029  sub createcourse {
     my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',      my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
                       $ENV{'user.home'});                        $ENV{'user.home'});
     unless ($reply eq 'ok') { return 'error: '.$reply; }      unless ($reply eq 'ok') { return 'error: '.$reply; }
     $uhome=&homeserver($uname,$udom);      $uhome=&homeserver($uname,$udom,'true');
     if (($uhome eq '') || ($uhome eq 'no_host')) {       if (($uhome eq '') || ($uhome eq 'no_host')) { 
  return 'error: no such course';   return 'error: no such course';
     }      }
Line 2805  sub goodbye { Line 2804  sub goodbye {
 }  }
   
 BEGIN {  BEGIN {
 # ---------------------------------- Read loncapa_apache.conf and loncapa.conf  # ----------------------------------- Read loncapa.conf and loncapa_apache.conf
 # (eventually access.conf will become deprecated)  
     unless ($readit) {      unless ($readit) {
   
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf");      my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
         if ($configline =~ /^[^\#]*PerlSetVar/) {          if ($configline =~ /^[^\#]*PerlSetVar/) {
Line 2821  BEGIN { Line 2818  BEGIN {
     }      }
 }  }
 {  {
     my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf");      my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf");
   
     while (my $configline=<$config>) {      while (my $configline=<$config>) {
         if ($configline =~ /^[^\#]*PerlSetVar/) {          if ($configline =~ /^[^\#]*PerlSetVar/) {
Removed from v.1.226  
changed lines
  Added in v.1.231

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