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

Diff for /loncom/lond between versions 1.454 and 1.465

version 1.454, 2010/08/22 19:28:26 version 1.465, 2010/11/12 19:12:46
Line 1121  sub establish_key_handler { Line 1121  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 2155  sub update_resource_handler { Line 2157  sub update_resource_handler {
  my $transname="$fname.in.transfer";   my $transname="$fname.in.transfer";
  my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");   my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");
  my $response;   my $response;
  alarm(120);  # FIXME: cannot replicate files that take more than two minutes to transfer?
   # alarm(120);
   # FIXME: this should use the LWP mechanism, not internal alarms.
                   alarm(1200);
  {   {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',"$remoteurl");      my $request=new HTTP::Request('GET',"$remoteurl");
Line 2163  sub update_resource_handler { Line 2168  sub update_resource_handler {
  }   }
  alarm(0);   alarm(0);
  if ($response->is_error()) {   if ($response->is_error()) {
   # FIXME: we should probably clean up here instead of just whine
     unlink($transname);      unlink($transname);
     my $message=$response->status_line;      my $message=$response->status_line;
     &logthis("LWP GET: $message for $fname ($remoteurl)");      &logthis("LWP GET: $message for $fname ($remoteurl)");
  } else {   } else {
     if ($remoteurl!~/\.meta$/) {      if ($remoteurl!~/\.meta$/) {
   # FIXME: isn't there an internal LWP mechanism for this?
  alarm(120);   alarm(120);
  {   {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
Line 3166  sub dump_with_regexp { Line 3173  sub dump_with_regexp {
     }      }
     my $hashref = &tie_user_hash($udom, $uname, $namespace,      my $hashref = &tie_user_hash($udom, $uname, $namespace,
  &GDBM_READER());   &GDBM_READER());
     my $clientcheckrole;      my $skipcheck;
     if ($hashref) {      if ($hashref) {
         my $qresult='';          my $qresult='';
  my $count=0;   my $count=0;
         if ($extra ne '') {          if ($extra ne '') {
             $extra = &Apache::lonnet::thaw_unescape($extra);              $extra = &Apache::lonnet::thaw_unescape($extra);
             $clientcheckrole = $extra->{'clientcheckrole'};              $skipcheck = $extra->{'skipcheck'};
         }          }
         my @ids = &Apache::lonnet::current_machine_ids();          my @ids = &Apache::lonnet::current_machine_ids();
         my (%homecourses,$major,$minor,$now);          my (%homecourses,$major,$minor,$now);
         if (($namespace eq 'roles') && (!$clientcheckrole)) {          if (($namespace eq 'roles') && (!$skipcheck)) {
             my $loncaparev = $clientversion;              my $loncaparev = $clientversion;
             if ($loncaparev eq '') {              if ($loncaparev eq '') {
                 $loncaparev = $Apache::lonnet::loncaparevs{$clientname};                  $loncaparev = $Apache::lonnet::loncaparevs{$clientname};
Line 3192  sub dump_with_regexp { Line 3199  sub dump_with_regexp {
                 if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {                  if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_courseid)(/?[^_]*)_(cc|co|in|ta|ep|ad|st|cr)$}) {
                     my $cdom = $1;                      my $cdom = $1;
                     my $cnum = $2;                      my $cnum = $2;
                     unless ($clientcheckrole) {                      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 3214  sub dump_with_regexp { Line 3224  sub dump_with_regexp {
     }      }
  }   }
  if (&untie_user_hash($hashref)) {   if (&untie_user_hash($hashref)) {
             if (($namespace eq 'roles') && (!$clientcheckrole)) {              if (($namespace eq 'roles') && (!$skipcheck)) {
                 if (keys(%homecourses) > 0) {                  if (keys(%homecourses) > 0) {
                     $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,                      $qresult .= &check_homecourses(\%homecourses,$udom,$regexp,$count,
                                                    $range,$start,$end,$major,$minor);                                                     $range,$start,$end,$major,$minor);
Line 4270  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 4414  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 6225  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 6375  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 7295  sub get_usersession_config { Line 7308  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 7309  sub releasereqd_check { Line 7322  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));
             }              }
         }          }
     }      }
Line 7359  sub get_courseinfo_hash { Line 7369  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 7386  sub check_homecourses { Line 7404  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.454  
changed lines
  Added in v.1.465

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.