[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.1056.4.25 and 1.1056.4.31

version 1.1056.4.25, 2011/05/14 17:16:49 version 1.1056.4.31, 2011/09/28 15:31:05
Line 831  sub compare_server_load { Line 831  sub compare_server_load {
     my $userloadans = &reply('userload',$try_server);      my $userloadans = &reply('userload',$try_server);
   
     if ($loadans !~ /\d/ && $userloadans !~ /\d/) {      if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
         return; #didn't get a number from the server          return ($spare_server, $lowest_load); #didn't get a number from the server
     }      }
   
     my $load;      my $load;
Line 877  sub has_user_session { Line 877  sub has_user_session {
 # --------- determine least loaded server in a user's domain which allows login  # --------- determine least loaded server in a user's domain which allows login
   
 sub choose_server {  sub choose_server {
     my ($udom) = @_;      my ($udom,$checkloginvia) = @_;
     my %domconfhash = &Apache::loncommon::get_domainconf($udom);      my %domconfhash = &Apache::loncommon::get_domainconf($udom);
     my %servers = &get_servers($udom);      my %servers = &get_servers($udom);
     my $lowest_load = 30000;      my $lowest_load = 30000;
     my ($login_host,$hostname);      my ($login_host,$hostname,$portal_path);
     foreach my $lonhost (keys(%servers)) {      foreach my $lonhost (keys(%servers)) {
         my $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};          my $loginvia;
         if ($loginvia eq '') {          if ($checkloginvia) {
               $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
               if ($loginvia) {
                   my ($server,$path) = split(/:/,$loginvia);
                   ($login_host, $lowest_load) =
                       &compare_server_load($lonhost, $login_host, $lowest_load);
                   if ($login_host eq $server) {
                       $portal_path = $path;
                   }
               } else {
                   ($login_host, $lowest_load) =
                       &compare_server_load($lonhost, $login_host, $lowest_load);
                   if ($login_host eq $lonhost) {
                       $portal_path = '';
                   }
               }
           } else {
             ($login_host, $lowest_load) =              ($login_host, $lowest_load) =
             &compare_server_load($lonhost, $login_host, $lowest_load);                  &compare_server_load($lonhost, $login_host, $lowest_load);
         }          }
     }      }
     if ($login_host ne '') {      if ($login_host ne '') {
         $hostname = $servers{$login_host};          $hostname = &hostname($login_host);
     }      }
     return ($login_host,$hostname);      return ($login_host,$hostname);
 }  }
Line 1033  sub can_host_session { Line 1049  sub can_host_session {
     }      }
     if ($canhost) {      if ($canhost) {
         if (ref($hostedsessions) eq 'HASH') {          if (ref($hostedsessions) eq 'HASH') {
               my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
               my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
             if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {              if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
                 if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) {                  if (($uint_dom ne '') && 
                       (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) {
                     $canhost = 0;                      $canhost = 0;
                 } else {                  } else {
                     $canhost = 1;                      $canhost = 1;
                 }                  }
             }              }
             if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {              if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {
                 if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) {                  if (($uint_dom ne '') && 
                       (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'includedomain'}}))) {
                     $canhost = 1;                      $canhost = 1;
                 } else {                  } else {
                     $canhost = 0;                      $canhost = 0;
Line 6728  sub assignrole { Line 6748  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 8601  sub metadata { Line 8628  sub metadata {
     if (($uri eq '') ||       if (($uri eq '') || 
  (($uri =~ m|^/*adm/|) &&    (($uri =~ m|^/*adm/|) && 
      ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||       ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$}) || ($uri =~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) {          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
  return undef;   return undef;
     }      }
     if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/})       if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) 
Line 8643  sub metadata { Line 8670  sub metadata {
  &Apache::lonnet::ssi_body($which,   &Apache::lonnet::ssi_body($which,
   ('grade_target' => 'meta'));    ('grade_target' => 'meta'));
     $cachetime = 1; # only want this cached in the child not long term      $cachetime = 1; # only want this cached in the child not long term
  } elsif ($uri !~ m -^(editupload)/-) {   } elsif (($uri !~ m -^(editupload)/-) && 
                    ($uri !~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) {
     my $file=&filelocation('',&clutter($filename));      my $file=&filelocation('',&clutter($filename));
     #push(@{$metaentry{$uri.'.file'}},$file);      #push(@{$metaentry{$uri.'.file'}},$file);
     $metastring=&getfile($file);      $metastring=&getfile($file);
Line 10233  sub get_dns { Line 10261  sub get_dns {
         my ($lonid) = @_;          my ($lonid) = @_;
         return $internetdom{$lonid};          return $internetdom{$lonid};
     }      }
   
       sub is_LC_dns {
           &load_hosts_tab() if (!$loaded);
   
           my ($hostname) = @_;
           return exists($LC_dns_serv{$hostname});
       }
   
 }  }
   
 {   { 
Line 11401  splitting on '&', supports elements that Line 11437  splitting on '&', supports elements that
   
 =head2 Logging Routines  =head2 Logging Routines
   
 =over 4  
   
 These routines allow one to make log messages in the lonnet.log and  These routines allow one to make log messages in the lonnet.log and
 lonnet.perm logfiles.  lonnet.perm logfiles.
   
   =over 4
   
 =item *  =item *
   
 logtouch() : make sure the logfile, lonnet.log, exists  logtouch() : make sure the logfile, lonnet.log, exists
Removed from v.1.1056.4.25  
changed lines
  Added in v.1.1056.4.31

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