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

Diff for /loncom/lond between versions 1.121 and 1.130

version 1.121, 2003/03/27 23:00:28 version 1.130, 2003/05/08 22:23:19
Line 57  use LONCAPA::Configuration; Line 57  use LONCAPA::Configuration;
   
 use IO::Socket;  use IO::Socket;
 use IO::File;  use IO::File;
 use Apache::File;  #use Apache::File;
 use Symbol;  use Symbol;
 use POSIX;  use POSIX;
 use Crypt::IDEA;  use Crypt::IDEA;
Line 375  sub reconlonc { Line 375  sub reconlonc {
         if (kill 0 => $loncpid) {          if (kill 0 => $loncpid) {
     &logthis("lonc at pid $loncpid responding, sending USR1");      &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;              kill USR1 => $loncpid;
             sleep 5;  
             if (-e "$peerfile") { return; }  
             &logthis("$peerfile still not there, give it another try");  
             sleep 10;  
             if (-e "$peerfile") { return; }  
             &logthis(  
  "<font color=blue>WARNING: $peerfile still not there, giving up</font>");  
         } else {          } else {
     &logthis(      &logthis(
               "<font color=red>CRITICAL: "                "<font color=red>CRITICAL: "
Line 543  sub make_new_child { Line 536  sub make_new_child {
     } else {      } else {
         # Child can *not* return from this subroutine.          # Child can *not* return from this subroutine.
         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before          $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
           $SIG{CHLD} = 'DEFAULT'; #make this default so that pwauth returns 
                                   #don't get intercepted
         $SIG{USR1}= \&logstatus;          $SIG{USR1}= \&logstatus;
         $SIG{ALRM}= \&timeout;          $SIG{ALRM}= \&timeout;
         $lastlog='Forked ';          $lastlog='Forked ';
Line 670  sub make_new_child { Line 665  sub make_new_child {
                           $loadavg=<$loadfile>;                            $loadavg=<$loadfile>;
                        }                         }
                        $loadavg =~ s/\s.*//g;                         $loadavg =~ s/\s.*//g;
                        my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};         my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
        print $client "$loadpercent\n";         print $client "$loadpercent\n";
   # -------------------------------------------------------------------- userload
      } elsif ($userinput =~ /^userload/) {
          my $userloadpercent=&userload();
          print $client "$userloadpercent\n";
 # ----------------------------------------------------------------- currentauth  # ----------------------------------------------------------------- currentauth
    } elsif ($userinput =~ /^currentauth/) {     } elsif ($userinput =~ /^currentauth/) {
      if ($wasenc==1) {       if ($wasenc==1) {
Line 1479  sub make_new_child { Line 1478  sub make_new_child {
                        print $client "ok\n";                         print $client "ok\n";
 # -------------------------------------------------------------------- chatretr  # -------------------------------------------------------------------- chatretr
                    } elsif ($userinput =~ /^chatretr/) {                     } elsif ($userinput =~ /^chatretr/) {
                        my ($cmd,$cdom,$cnum)=split(/\:/,$userinput);                         my 
                           ($cmd,$cdom,$cnum,$udom,$uname)=split(/\:/,$userinput);
                        my $reply='';                         my $reply='';
                        foreach (&getchat($cdom,$cnum)) {                         foreach (&getchat($cdom,$cnum,$udom,$uname)) {
    $reply.=&escape($_).':';     $reply.=&escape($_).':';
                        }                         }
                        $reply=~s/\:$//;                         $reply=~s/\:$//;
Line 1833  sub addline { Line 1833  sub addline {
 }  }
   
 sub getchat {  sub getchat {
     my ($cdom,$cname)=@_;      my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;      my %hash;
     my $proname=&propath($cdom,$cname);      my $proname=&propath($cdom,$cname);
     my @entries=();      my @entries=();
Line 1842  sub getchat { Line 1842  sub getchat {
  @entries=map { $_.':'.$hash{$_} } sort keys %hash;   @entries=map { $_.':'.$hash{$_} } sort keys %hash;
  untie %hash;   untie %hash;
     }      }
     return @entries;      my @participants=();
       $cutoff=time-60;
       if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
       &GDBM_WRCREAT(),0640)) {
           $hash{$uname.':'.$udom}=time;
           foreach (sort keys %hash) {
       if ($hash{$_}>$cutoff) {
    $participants[$#participants+1]='active_participant:'.$_;
               }
           }
           untie %hash;
       }
       return (@participants,@entries);
 }  }
   
 sub chatadd {  sub chatadd {
Line 2059  sub version { Line 2071  sub version {
     return "version:$VERSION";      return "version:$VERSION";
 }  }
   
   #There is a copy of this in lonnet.pm
   sub userload {
       my $numusers=0;
       {
    opendir(LONIDS,$perlvar{'lonIDsDir'});
    my $filename;
    my $curtime=time;
    while ($filename=readdir(LONIDS)) {
       if ($filename eq '.' || $filename eq '..') {next;}
       my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8];
       if ($curtime-$atime < 3600) { $numusers++; }
    }
    closedir(LONIDS);
       }
       my $userloadpercent=0;
       my $maxuserload=$perlvar{'lonUserLoadLim'};
       if ($maxuserload) {
    $userloadpercent=100*$numusers/$maxuserload;
       }
       $userloadpercent=sprintf("%.2f",$userloadpercent);
       return $userloadpercent;
   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
 =head1 NAME  =head1 NAME
Removed from v.1.121  
changed lines
  Added in v.1.130

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