--- loncom/lond 2003/03/28 18:26:28 1.122
+++ loncom/lond 2003/05/08 21:25:31 1.127
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.122 2003/03/28 18:26:28 www Exp $
+# $Id: lond,v 1.127 2003/05/08 21:25:31 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,7 +57,7 @@ use LONCAPA::Configuration;
use IO::Socket;
use IO::File;
-use Apache::File;
+#use Apache::File;
use Symbol;
use POSIX;
use Crypt::IDEA;
@@ -73,7 +73,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.122 $'; #' stupid emacs
+my $VERSION='$Revision: 1.127 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -375,13 +375,6 @@ sub reconlonc {
if (kill 0 => $loncpid) {
&logthis("lonc at pid $loncpid responding, sending USR1");
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(
- "WARNING: $peerfile still not there, giving up");
} else {
&logthis(
"CRITICAL: "
@@ -543,6 +536,8 @@ sub make_new_child {
} else {
# Child can *not* return from this subroutine.
$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{ALRM}= \&timeout;
$lastlog='Forked ';
@@ -670,8 +665,12 @@ sub make_new_child {
$loadavg=<$loadfile>;
}
$loadavg =~ s/\s.*//g;
- my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
+ my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
print $client "$loadpercent\n";
+# -------------------------------------------------------------------- userload
+ } elsif ($userinput =~ /^userload/) {
+ my $userloadpercent=&userload();
+ print $client "$userloadpercent\n";
# ----------------------------------------------------------------- currentauth
} elsif ($userinput =~ /^currentauth/) {
if ($wasenc==1) {
@@ -1843,7 +1842,19 @@ sub getchat {
@entries=map { $_.':'.$hash{$_} } sort keys %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 {
@@ -2060,6 +2071,27 @@ sub version {
return "version:$VERSION";
}
+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) { $num_users++; }
+ }
+ closedir(LONIDS);
+ }
+ my $userloadpercent=0;
+ my $maxuserload=$perlvar{'lonUserLoadLim'};
+ if ($maxuserload) {
+ $userloadpercent=100*$num_users/$maxuserload;
+ }
+ return $userloadpercent;
+}
+
# ----------------------------------- POD (plain old documentation, CPAN style)
=head1 NAME