[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.890.2.1 and 1.898

version 1.890.2.1, 2007/06/25 23:30:27 version 1.898, 2007/07/20 23:16:19
Line 214  sub reply { Line 214  sub reply {
 # ----------------------------------------------------------- Send USR1 to lonc  # ----------------------------------------------------------- Send USR1 to lonc
   
 sub reconlonc {  sub reconlonc {
       my ($lonid) = @_;
       my $hostname = &hostname($lonid);
       if ($lonid) {
    my $peerfile="$perlvar{'lonSockDir'}/$hostname";
    if ($hostname && -e $peerfile) {
       &logthis("Trying to reconnect lonc for $lonid ($hostname)");
       my $client=IO::Socket::UNIX->new(Peer    => $peerfile,
        Type    => SOCK_STREAM,
        Timeout => 10);
       if ($client) {
    print $client ("reset_retries\n");
    my $answer=<$client>;
    #reset just this one.
       }
    }
    return;
       }
   
     &logthis("Trying to reconnect lonc");      &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";      my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (open(my $fh,"<$loncfile")) {      if (open(my $fh,"<$loncfile")) {
Line 1378  sub ssi { Line 1396  sub ssi {
     my $request;      my $request;
   
     $form{'no_update_last_known'}=1;      $form{'no_update_last_known'}=1;
       &Apache::lonenc::check_encrypt(\$fn);
     if (%form) {      if (%form) {
       $request=new HTTP::Request('POST',&absolute_url().$fn);        $request=new HTTP::Request('POST',&absolute_url().$fn);
       $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));        $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
Line 2095  sub userrolelog { Line 2113  sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     =$tend.':'.$tstart;                      =$tend.':'.$tstart;
     }      }
       if (($env{'request.role'} =~ /dc\./) &&
    (($trole=~/^au/) || ($trole=~/^in/) ||
    ($trole=~/^cc/) || ($trole=~/^ep/) ||
    ($trole=~/^cr/) || ($trole=~/^ta/))) {
          $userrolehash
            {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                       =$tend.':'.$tstart;
       }
     if (($trole=~/^dc/) || ($trole=~/^ad/) ||      if (($trole=~/^dc/) || ($trole=~/^ad/) ||
         ($trole=~/^li/) || ($trole=~/^li/) ||          ($trole=~/^li/) || ($trole=~/^li/) ||
         ($trole=~/^au/) || ($trole=~/^dg/) ||          ($trole=~/^au/) || ($trole=~/^dg/) ||
Line 2104  sub userrolelog { Line 2130  sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     = $tend.':'.$tstart;                      = $tend.':'.$tstart;
     }      }
       &flushcourselogs();
 }  }
   
 sub get_course_adv_roles {  sub get_course_adv_roles {
Line 3786  sub customaccess { Line 3813  sub customaccess {
     $ucrs = &LONCAPA::clean_username($ucrs);      $ucrs = &LONCAPA::clean_username($ucrs);
     my $access=0;      my $access=0;
     foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {      foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
  my ($effect,$realm,$role)=split(/\:/,$right);   my ($effect,$realm,$role,$type)=split(/\:/,$right);
         if ($role) {   if ($type eq 'user') {
    if ($role ne $urole) { next; }      foreach my $scope (split(/\s*\,\s*/,$realm)) {
         }   my ($tdom,$tuname)=split(m{/},$scope);
         foreach my $scope (split(/\s*\,\s*/,$realm)) {   if ($tdom) {
             my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);      if ($tdom ne $env{'user.domain'}) { next; }
             if ($tdom) {   }
  if ($tdom ne $udom) { next; }   if ($tuname) {
             }      if ($tuname ne $env{'user.name'}) { next; }
             if ($tcrs) {   }
  if ($tcrs ne $ucrs) { next; }   $access=($effect eq 'allow');
             }   last;
             if ($tsec) {      }
  if ($tsec ne $usec) { next; }   } else {
             }      if ($role) {
             $access=($effect eq 'allow');   if ($role ne $urole) { next; }
             last;      }
         }      foreach my $scope (split(/\s*\,\s*/,$realm)) {
  if ($realm eq '' && $role eq '') {   my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
             $access=($effect eq 'allow');   if ($tdom) {
       if ($tdom ne $udom) { next; }
    }
    if ($tcrs) {
       if ($tcrs ne $ucrs) { next; }
    }
    if ($tsec) {
       if ($tsec ne $usec) { next; }
    }
    $access=($effect eq 'allow');
    last;
       }
       if ($realm eq '' && $role eq '') {
    $access=($effect eq 'allow');
       }
  }   }
     }      }
     return $access;      return $access;
Line 7066  sub getCODE { Line 7107  sub getCODE {
 sub rndseed {  sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;      my ($symb,$courseid,$domain,$username)=@_;
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();      my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
     if (!$symb) {      if (!defined($symb)) {
  unless ($symb=$wsymb) { return time; }   unless ($symb=$wsymb) { return time; }
     }      }
     if (!$courseid) { $courseid=$wcourseid; }      if (!$courseid) { $courseid=$wcourseid; }
Line 7852  sub get_dns { Line 7893  sub get_dns {
     }      }
           
     sub reset_hosts_info {      sub reset_hosts_info {
    &purge_remembered();
  &reset_domain_info();   &reset_domain_info();
  &reset_hosts_ip_info();   &reset_hosts_ip_info();
  undef(%name_to_host);   undef(%name_to_host);
Line 7977  sub get_dns { Line 8019  sub get_dns {
           
     sub get_iphost {      sub get_iphost {
  my ($ignore_cache) = @_;   my ($ignore_cache) = @_;
   
  if (!$ignore_cache) {   if (!$ignore_cache) {
     if (%iphost) {      if (%iphost) {
  return %iphost;   return %iphost;
Line 7990  sub get_dns { Line 8033  sub get_dns {
  return %iphost;   return %iphost;
     }      }
  }   }
   
    # get yesterday's info for fallback
    my %old_name_to_ip;
    my ($ip_info,$cached)=
       &Apache::lonnet::is_cached_new('iphost','iphost');
    if ($cached) {
       %old_name_to_ip = %{$ip_info->[1]};
    }
   
  my %name_to_host = &all_names();   my %name_to_host = &all_names();
  foreach my $name (keys(%name_to_host)) {   foreach my $name (keys(%name_to_host)) {
     my $ip;      my $ip;
     if (!exists($name_to_ip{$name})) {      if (!exists($name_to_ip{$name})) {
  $ip = gethostbyname($name);   $ip = gethostbyname($name);
  if (!$ip || length($ip) ne 4) {   if (!$ip || length($ip) ne 4) {
     &logthis("Skipping name $name no IP found");      if (defined($old_name_to_ip{$name})) {
     next;   $ip = $old_name_to_ip{$name};
    &logthis("Can't find $name defaulting to old $ip");
       } else {
    &logthis("Name $name no IP found");
    next;
       }
    } else {
       $ip=inet_ntoa($ip);
  }   }
  $ip=inet_ntoa($ip);  
  $name_to_ip{$name} = $ip;   $name_to_ip{$name} = $ip;
     } else {      } else {
  $ip = $name_to_ip{$name};   $ip = $name_to_ip{$name};
Line 8011  sub get_dns { Line 8069  sub get_dns {
  }   }
  &Apache::lonnet::do_cache_new('iphost','iphost',   &Apache::lonnet::do_cache_new('iphost','iphost',
       [\%iphost,\%name_to_ip,\%lonid_to_ip],        [\%iphost,\%name_to_ip,\%lonid_to_ip],
       24*60*60);        48*60*60);
   
  return %iphost;   return %iphost;
     }      }
Removed from v.1.890.2.1  
changed lines
  Added in v.1.898

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