[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.456 and 1.469

version 1.456, 2010/09/26 01:50:28 version 1.469, 2011/01/20 10:55:02
Line 15 Line 15
 #  #
 # LON-CAPA is distributed in the hope that it will be useful,  # LON-CAPA is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
   
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.  # GNU General Public License for more details.
 #  #
Line 1121  sub establish_key_handler { Line 1122  sub establish_key_handler {
 sub load_handler {  sub load_handler {
     my ($cmd, $tail, $replyfd) = @_;      my ($cmd, $tail, $replyfd) = @_;
   
   
   
    # Get the load average from /proc/loadavg and calculate it as a percentage of     # Get the load average from /proc/loadavg and calculate it as a percentage of
    # the allowed load limit as set by the perl global variable lonLoadLim     # the allowed load limit as set by the perl global variable lonLoadLim
   
Line 2422  sub user_has_session_handler { Line 2425  sub user_has_session_handler {
   
     my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));      my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
           
     &logthis("Looking for $udom $uname");  
     opendir(DIR,$perlvar{'lonIDsDir'});      opendir(DIR,$perlvar{'lonIDsDir'});
     my $filename;      my $filename;
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
Line 3198  sub dump_with_regexp { Line 3200  sub dump_with_regexp {
                     my $cdom = $1;                      my $cdom = $1;
                     my $cnum = $2;                      my $cnum = $2;
                     unless ($skipcheck) {                      unless ($skipcheck) {
                         next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,$minor,                          my ($role,$end,$start) = split(/\_/,$value);
                                                         $now,\%homecourses,\@ids));                          if (!$end || $end > $now) {
                               next unless (&releasereqd_check($cnum,$cdom,$key,$value,$major,
                                                               $minor,\%homecourses,\@ids));
                           }
                     }                      }
                 }                  }
             }              }
Line 4275  sub put_domain_handler { Line 4280  sub put_domain_handler {
 sub get_domain_handler {  sub get_domain_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
   
     my $userinput = "$client:$tail";      my $userinput = "$client:$tail";
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);      my ($udom,$namespace,$what)=split(/:/,$tail,3);
Line 4419  sub get_id_handler { Line 4425  sub get_id_handler {
 sub put_dcmail_handler {  sub put_dcmail_handler {
     my ($cmd,$tail,$client) = @_;      my ($cmd,$tail,$client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
                                                                                   
   
     my ($udom,$what)=split(/:/,$tail);      my ($udom,$what)=split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());      my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT());
Line 5992  if (-e $pidfile) { Line 5999  if (-e $pidfile) {
 $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},  $server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
                                 Type      => SOCK_STREAM,                                  Type      => SOCK_STREAM,
                                 Proto     => 'tcp',                                  Proto     => 'tcp',
                                 Reuse     => 1,                                  ReuseAddr     => 1,
                                 Listen    => 10 )                                  Listen    => 10 )
   or die "making socket: $@\n";    or die "making socket: $@\n";
   
Line 6230  sub logstatus { Line 6237  sub logstatus {
 sub initnewstatus {  sub initnewstatus {
     my $docdir=$perlvar{'lonDocRoot'};      my $docdir=$perlvar{'lonDocRoot'};
     my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");      my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");
     my $now=time;      my $now=time();
     my $local=localtime($now);      my $local=localtime($now);
     print $fh "LOND status $local - parent $$\n\n";      print $fh "LOND status $local - parent $$\n\n";
     opendir(DIR,"$docdir/lon-status/londchld");      opendir(DIR,"$docdir/lon-status/londchld");
Line 6380  sub make_new_child { Line 6387  sub make_new_child {
             or die "Can't unblock SIGINT for fork: $!\n";              or die "Can't unblock SIGINT for fork: $!\n";
         $children{$pid} = $clientip;          $children{$pid} = $clientip;
         &status('Started child '.$pid);          &status('Started child '.$pid);
    close($client);
         return;          return;
     } else {      } else {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
Line 6388  sub make_new_child { Line 6396  sub make_new_child {
                                 #don't get intercepted                                  #don't get intercepted
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
         $SIG{ALRM}= \&timeout;          $SIG{ALRM}= \&timeout;
    #
    # Block sigpipe as it gets thrownon socket disconnect and we want to 
    # deal with that as a read faiure instead.
    #
    my $blockset = POSIX::SigSet->new(SIGPIPE);
    sigprocmask(SIG_BLOCK, $blockset);
   
         $lastlog='Forked ';          $lastlog='Forked ';
         $status='Forked';          $status='Forked';
   
Line 7300  sub get_usersession_config { Line 7315  sub get_usersession_config {
 }  }
   
 sub releasereqd_check {  sub releasereqd_check {
     my ($cnum,$cdom,$key,$value,$major,$minor,$now,$homecourses,$ids) = @_;      my ($cnum,$cdom,$key,$value,$major,$minor,$homecourses,$ids) = @_;
     my $home = &Apache::lonnet::homeserver($cnum,$cdom);      my $home = &Apache::lonnet::homeserver($cnum,$cdom);
     return if ($home eq 'no_host');      return if ($home eq 'no_host');
     my ($reqdmajor,$reqdminor,$displayrole);      my ($reqdmajor,$reqdminor,$displayrole);
Line 7314  sub releasereqd_check { Line 7329  sub releasereqd_check {
             return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));              return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
         }          }
     }      }
     my ($role,$end,$start) = split(/_/,$value);      my $hashid = $cdom.':'.$cnum;
     if (!$end || $end > $now) {      my ($courseinfo,$cached) =
         my $hashid = $cdom.':'.$cnum;          &Apache::lonnet::is_cached_new('courseinfo',$hashid);
         my ($courseinfo,$cached) =      if (defined($cached)) {
             &Apache::lonnet::is_cached_new('courseinfo',$hashid);          if (ref($courseinfo) eq 'HASH') {
         if (defined($cached)) {              if (exists($courseinfo->{'releaserequired'})) {
             if (ref($courseinfo) eq 'HASH') {                  my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                 if (exists($courseinfo->{'releaserequired'})) {                  return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
                     my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});  
                     return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));  
                 }  
             }              }
         } else {          }
             if (ref($ids) eq 'ARRAY') {      } else {
                 if (grep(/^\Q$home\E$/,@{$ids})) {          if (ref($ids) eq 'ARRAY') {
                     if (ref($homecourses) eq 'HASH') {              if (grep(/^\Q$home\E$/,@{$ids})) {
                         if (ref($homecourses->{$hashid}) eq 'ARRAY') {                  if (ref($homecourses) eq 'HASH') {
                             push(@{$homecourses->{$hashid}},{$key=>$value});                      if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                         } else {                          push(@{$homecourses->{$hashid}},{$key=>$value});
                             $homecourses->{$hashid} = [{$key=>$value}];                      } else {
                         }                          $homecourses->{$hashid} = [{$key=>$value}];
                     }                      }
                     return;  
                 }                  }
                   return;
             }              }
             my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);          }
             if (ref($courseinfo) eq 'HASH') {          my $courseinfo = &get_courseinfo_hash($cnum,$cdom,$home);
                 if (exists($courseinfo->{'releaserequired'})) {          if (ref($courseinfo) eq 'HASH') {
                     my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});              if (exists($courseinfo->{'releaserequired'})) {
                     return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));                  my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                 }                  return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
             }              }
           } else {
               return;
         }          }
     }      }
     return 1;      return 1;
Line 7353  sub releasereqd_check { Line 7367  sub releasereqd_check {
   
 sub get_courseinfo_hash {  sub get_courseinfo_hash {
     my ($cnum,$cdom,$home) = @_;      my ($cnum,$cdom,$home) = @_;
     my $hashid = $cdom.':'.$cnum;      my %info;
     my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');      eval {
     if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {          local($SIG{ALRM}) = sub { die "timeout\n"; };
         return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);          local($SIG{__DIE__})='DEFAULT';
           alarm(3);
           %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.');
           alarm(0);
       };
       if ($@) {
           if ($@ eq "timeout\n") {
               &logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>");
           } else {
               &logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>");
           }
       } else {
           if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') {
               my $hashid = $cdom.':'.$cnum;
               return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600);
           }
     }      }
     return;      return;
 }  }
Line 7364  sub get_courseinfo_hash { Line 7393  sub get_courseinfo_hash {
 sub check_homecourses {  sub check_homecourses {
     my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;      my ($homecourses,$udom,$regexp,$count,$range,$start,$end,$major,$minor) = @_;
     my ($result,%addtocache);      my ($result,%addtocache);
       my $yesterday = time - 24*3600; 
     if (ref($homecourses) eq 'HASH') {      if (ref($homecourses) eq 'HASH') {
         my %okcourses;          my (%okcourses,%courseinfo,%recent);
         my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());          my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
         if ($hashref) {          if ($hashref) {
             while (my ($key,$value) = each(%$hashref)) {              while (my ($key,$value) = each(%$hashref)) {
                 my $unesc_key = &unescape($key);                  my $unesc_key = &unescape($key);
                 next if ($unesc_key =~ /^lasttime:/);                  if ($unesc_key =~ /^lasttime:(\w+)$/) {
                       my $cid = $1;
                       $cid =~ s/_/:/;
                       if ($value > $yesterday ) {
                           $recent{$cid} = 1;
                       }
                       next;
                   }
                 my $items = &Apache::lonnet::thaw_unescape($value);                  my $items = &Apache::lonnet::thaw_unescape($value);
                 if (ref($items) eq 'HASH') {                  if (ref($items) eq 'HASH') {
                     my $hashid = $unesc_key;                      my $hashid = $unesc_key;
                     $hashid =~ s/_/:/;                      $hashid =~ s/_/:/;
                     &Apache::lonnet::do_cache_new('courseinfo',$hashid,$items,600);                      $courseinfo{$hashid} = $items;
                     if (ref($homecourses->{$hashid}) eq 'ARRAY') {                      if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                         my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});                          my ($reqdmajor,$reqdminor) = split(/\./,$items->{'releaserequired'});
                         if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {                          if (&useable_role($reqdmajor,$reqdminor,$major,$minor)) {
Line 7391  sub check_homecourses { Line 7428  sub check_homecourses {
             &logthis('Failed to tie hash for nohist_courseids.db');              &logthis('Failed to tie hash for nohist_courseids.db');
             return;              return;
         }          }
           foreach my $hashid (keys(%recent)) {
               my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid);
               unless ($cached) {
                   &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
               }
           }
           foreach my $hashid (keys(%{$homecourses})) {
               next if ($recent{$hashid});
               &Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600);
           }
         foreach my $hashid (keys(%okcourses)) {          foreach my $hashid (keys(%okcourses)) {
             if (ref($homecourses->{$hashid}) eq 'ARRAY') {              if (ref($homecourses->{$hashid}) eq 'ARRAY') {
                 foreach my $role (@{$homecourses->{$hashid}}) {                  foreach my $role (@{$homecourses->{$hashid}}) {
Removed from v.1.456  
changed lines
  Added in v.1.469

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