[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.1129 and 1.1135

version 1.1129, 2011/08/09 01:35:24 version 1.1135, 2011/10/16 14:24:39
Line 348  sub get_remote_globals { Line 348  sub get_remote_globals {
   
 sub remote_devalidate_cache {  sub remote_devalidate_cache {
     my ($lonhost,$name,$id) = @_;      my ($lonhost,$name,$id) = @_;
     my $response = &reply('devalidatecache',&escape($name).':'.&escape($id),$lonhost);      my $response = &reply('devalidatecache:'.&escape($name).':'.&escape($id),$lonhost);
     return $response;      return $response;
 }  }
   
Line 1242  sub check_loadbalancing { Line 1242  sub check_loadbalancing {
         my %domconfig =          my %domconfig =
             &Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use);              &Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use);
         if (ref($domconfig{'loadbalancing'}) eq 'HASH') {          if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
             $result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'usersessions'}{'loadbalancing'},$cachetime);              $result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime);
         }          }
     }      }
     if (ref($result) eq 'HASH') {      if (ref($result) eq 'HASH') {
Line 1308  sub check_loadbalancing { Line 1308  sub check_loadbalancing {
             my %domconfig =              my %domconfig =
                 &Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom);                  &Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom);
             if (ref($domconfig{'loadbalancing'}) eq 'HASH') {              if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
                 $result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'usersessions'}{'loadbalancing'},$cachetime);                  $result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime);
             }              }
         }          }
         if (ref($result) eq 'HASH') {          if (ref($result) eq 'HASH') {
Line 2212  sub is_cached_new { Line 2212  sub is_cached_new {
     my ($name,$id,$debug) = @_;      my ($name,$id,$debug) = @_;
     $id=&make_key($name,$id);      $id=&make_key($name,$id);
     if (exists($remembered{$id})) {      if (exists($remembered{$id})) {
  if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }   if ($debug) { &Apache::lonnet::logthis("Early return $id of $remembered{$id} "); }
  $accessed{$id}=[&gettimeofday()];   $accessed{$id}=[&gettimeofday()];
  $hits++;   $hits++;
  return ($remembered{$id},1);   return ($remembered{$id},1);
Line 3986  sub hashref2str { Line 3986  sub hashref2str {
       $result.='=';        $result.='=';
       #print("Got a ref of ".(ref($key))." skipping.");        #print("Got a ref of ".(ref($key))." skipping.");
     } else {      } else {
  if ($key) {$result.=&escape($key).'=';} else { last; }   if (defined($key)) {$result.=&escape($key).'=';} else { last; }
     }      }
   
     if(ref($hashref->{$key}) eq 'ARRAY') {      if(ref($hashref->{$key}) eq 'ARRAY') {
Line 6179  sub allowed { Line 6179  sub allowed {
     }      }
    return 'F';     return 'F';
 }  }
   #
   #   Removes the versino from a URI and
   #   splits it in to its filename and path to the filename.
   #   Seems like File::Basename could have done this more clearly.
   #   Parameters:
   #      $uri   - input URI
   #   Returns:
   #     Two element list consisting of 
   #     $pathname  - the URI up to and excluding the trailing /
   #     $filename  - The part of the URI following the last /
   #  NOTE:
   #    Another realization of this is simply:
   #    use File::Basename;
   #    ...
   #    $uri = shift;
   #    $filename = basename($uri);
   #    $path     = dirname($uri);
   #    return ($filename, $path);
   #
   #     The implementation below is probably faster however.
   #
 sub split_uri_for_cond {  sub split_uri_for_cond {
     my $uri=&deversion(&declutter(shift));      my $uri=&deversion(&declutter(shift));
     my @uriparts=split(/\//,$uri);      my @uriparts=split(/\//,$uri);
Line 7075  sub assignrole { Line 7095  sub assignrole {
                     return 'refused';                      return 'refused';
                 }                  }
             }              }
           } elsif ($role eq 'au') {
               if ($url ne '/'.$udom.'/') {
                   &logthis('Attempt by '.$env{'user.name'}.':'.$env{'user.domain'}.
                            ' to assign author role for '.$uname.':'.$udom.
                            ' in domain: '.$url.' refused (wrong domain).');
                   return 'refused';
               }
         }          }
         $mrole=$role;          $mrole=$role;
     }      }
Line 8222  sub dirlist { Line 8249  sub dirlist {
   
     if($udom) {      if($udom) {
         if($uname) {          if($uname) {
               my $uhome = &homeserver($uname,$udom);
               return if ($uhome eq 'no_host'); 
             $listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':'              $listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':'
                               .$getuserdir.':'.&escape($dirRoot)                                .$getuserdir.':'.&escape($dirRoot)
                               .':'.&escape($uname).':'.&escape($udom),                                .':'.&escape($uname).':'.&escape($udom),$uhome);
                               &homeserver($uname,$udom));  
             if ($listing eq 'unknown_cmd') {              if ($listing eq 'unknown_cmd') {
                 $listing = &reply('ls2:'.$dirRoot.'/'.$uri,                  $listing = &reply('ls2:'.$dirRoot.'/'.$uri,$uhome);
                                   &homeserver($uname,$udom));  
             } else {              } else {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);                  @listing_results = map { &unescape($_); } split(/:/,$listing);
             }              }
             if ($listing eq 'unknown_cmd') {              if ($listing eq 'unknown_cmd') {
                 $listing = &reply('ls:'.$dirRoot.'/'.$uri,                  $listing = &reply('ls:'.$dirRoot.'/'.$uri,$uhome);
   &homeserver($uname,$udom));  
                 @listing_results = split(/:/,$listing);                  @listing_results = split(/:/,$listing);
             } else {              } else {
                 @listing_results = map { &unescape($_); } split(/:/,$listing);                  @listing_results = map { &unescape($_); } split(/:/,$listing);
             }              }
               if (($listing eq 'no_such_host') || ($listing eq 'con_lost') || 
                   ($listing eq 'rejected') || ($listing eq 'refused')) {
                   return;       
               }
             return @listing_results;              return @listing_results;
         } elsif(!$alternateRoot) {          } elsif(!$alternateRoot) {
             my %allusers;              my %allusers;
Line 9686  sub getCODE { Line 9716  sub getCODE {
     }      }
     return undef;      return undef;
 }  }
   #
   #  Determines the random seed for a specific context:
   #
   # parameters:
   #   symb      - in course context the symb for the seed.
   #   course_id - The course id of the form domain_coursenum.
   #   domain    - Domain for the user.
   #   course    - Course for the user.
   #   cenv      - environment of the course.
   #
   # NOTE:
   #   All parameters are picked out of the environment if missing
   #   or not defined.
   #   If a symb cannot be determined the current time is used instead.
   #
   #  For a given well defined symb, courside, domain, username,
   #  and course environment, the seed is reproducible.
   #
 sub rndseed {  sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;      my ($symb,$courseid,$domain,$username, $cenv)=@_;
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();      my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
     if (!defined($symb)) {      if (!defined($symb)) {
  unless ($symb=$wsymb) { return time; }   unless ($symb=$wsymb) { return time; }
Line 9696  sub rndseed { Line 9743  sub rndseed {
     if (!$courseid) { $courseid=$wcourseid; }      if (!$courseid) { $courseid=$wcourseid; }
     if (!$domain) { $domain=$wdomain; }      if (!$domain) { $domain=$wdomain; }
     if (!$username) { $username=$wusername }      if (!$username) { $username=$wusername }
     my $which=&get_rand_alg();  
       my $which;
       if (defined($cenv->{'rndseed'})) {
    $which = $cenv->{'rndseed'};
       } else {
    $which =&get_rand_alg($courseid);
       }
   
     if (defined(&getCODE())) {      if (defined(&getCODE())) {
   
  if ($which eq '64bit5') {   if ($which eq '64bit5') {
     return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);      return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
  } elsif ($which eq '64bit4') {   } elsif ($which eq '64bit4') {
Line 10406  sub get_dns { Line 10460  sub get_dns {
     while (%alldns) {      while (%alldns) {
  my ($dns) = keys(%alldns);   my ($dns) = keys(%alldns);
  my $ua=new LWP::UserAgent;   my $ua=new LWP::UserAgent;
           $ua->timeout(30);
  my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");   my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
  my $response=$ua->request($request);   my $response=$ua->request($request);
         delete($alldns{$dns});          delete($alldns{$dns});
Removed from v.1.1129  
changed lines
  Added in v.1.1135

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