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

Diff for /loncom/lond between versions 1.458 and 1.470

version 1.458, 2010/09/26 14:31:26 version 1.470, 2011/01/22 21:10:18
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 4278  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 4422  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 5004  sub get_sections_handler { Line 5008  sub get_sections_handler {
 sub validate_course_owner_handler {  sub validate_course_owner_handler {
     my ($cmd, $tail, $client)  = @_;      my ($cmd, $tail, $client)  = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($inst_course_id, $owner, $cdom) = split(/:/, $tail);      my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail);
       
     $owner = &unescape($owner);      $owner = &unescape($owner);
     my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);      $coowners = &unescape($coowners);
       my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners);
     &Reply($client, \$outcome, $userinput);      &Reply($client, \$outcome, $userinput);
   
   
Line 5995  if (-e $pidfile) { Line 6000  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 6233  sub logstatus { Line 6238  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 6383  sub make_new_child { Line 6388  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 6391  sub make_new_child { Line 6397  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 7346  sub releasereqd_check { Line 7359  sub releasereqd_check {
                 my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});                  my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'});
                 return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));                  return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor));
             }              }
           } else {
               return;
         }          }
     }      }
     return 1;      return 1;
Line 7353  sub releasereqd_check { Line 7368  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 7394  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 7429  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.458  
changed lines
  Added in v.1.470

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