[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.30 and 1.1056.4.33.2.1

version 1.1056.4.30, 2011/09/15 21:37:30 version 1.1056.4.33.2.1, 2012/02/01 18:27:09
Line 76  use HTTP::Date; Line 76  use HTTP::Date;
 use Image::Magick;  use Image::Magick;
   
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir  use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
             $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease);              $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
               %managerstab);
   
 my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,  my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
     %userrolehash, $processmarker, $dumpcount, %coursedombuf,      %userrolehash, $processmarker, $dumpcount, %coursedombuf,
Line 877  sub has_user_session { Line 878  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,$isredirect);
     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;
                       $isredirect = 1;
                   }
               } else {
                   ($login_host, $lowest_load) =
                       &compare_server_load($lonhost, $login_host, $lowest_load);
                   if ($login_host eq $lonhost) {
                       $portal_path = '';
                       $isredirect = '';
                   }
               }
           } 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,$portal_path,$isredirect);
 }  }
   
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
Line 1559  sub get_domain_defaults { Line 1578  sub get_domain_defaults {
         $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};          $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
         $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};          $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
         $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};          $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
           $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
     } else {      } else {
         $domdefaults{'lang_def'} = &domain($domain,'lang_def');          $domdefaults{'lang_def'} = &domain($domain,'lang_def');
         $domdefaults{'auth_def'} = &domain($domain,'auth_def');          $domdefaults{'auth_def'} = &domain($domain,'auth_def');
Line 3698  sub hashref2str { Line 3718  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 10013  sub get_dns { Line 10033  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});
Line 10528  BEGIN { Line 10549  BEGIN {
     }      }
 }  }
   
   # ---------------------------------------------------------- Read managers table
   {
       if (-e "$perlvar{'lonTabDir'}/managers.tab") {
           if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) {
               while (my $configline=<$config>) {
                   chomp($configline);
                   next if ($configline =~ /^\#/);
                   if (($configline =~ /^[\w\-]+$/) || ($configline =~ /^[\w\-]+\:[\w\-]+$/)) {
                       $managerstab{$configline} = 1;
                   }
               }
               close($config);
           }
       }
   }
   
 # ------------- set up temporary directory  # ------------- set up temporary directory
 {  {
     $tmpdir = $perlvar{'lonDaemons'}.'/tmp/';      $tmpdir = $perlvar{'lonDaemons'}.'/tmp/';
Line 11421  splitting on '&', supports elements that Line 11458  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.30  
changed lines
  Added in v.1.1056.4.33.2.1

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