--- loncom/loncron 2003/10/14 15:36:21 1.44
+++ loncom/loncron 2019/08/01 18:21:36 1.103.2.5
@@ -1,324 +1,234 @@
#!/usr/bin/perl
-# The LearningOnline Network
-# Housekeeping program, started by cron
+# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# (TCP networking package
-# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
-# 7/1,7/2,7/9,7/10,7/12 Gerd Kortemeyer)
+# $Id: loncron,v 1.103.2.5 2019/08/01 18:21:36 raeburn Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
#
-# 7/14,7/15,7/19,7/21,7/22,11/18,
-# 2/8 Gerd Kortemeyer
-# 12/23 Gerd Kortemeyer
-# YEAR=2001
-# 09/04,09/06,11/26 Gerd Kortemeyer
$|=1;
+use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
+use LONCAPA::Checksumming;
+use LONCAPA;
+use Apache::lonnet;
+use Apache::loncommon;
use IO::File;
use IO::Socket;
+use HTML::Entities;
+use Getopt::Long;
+use File::Copy;
+#globals
+use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);
+
+my $statusdir="/home/httpd/html/lon-status";
-# -------------------------------------------------- Non-critical communication
-sub reply {
- my ($cmd,$server)=@_;
- my $peerfile="$perlvar{'lonSockDir'}/$server";
- my $client=IO::Socket::UNIX->new(Peer =>"$peerfile",
- Type => SOCK_STREAM,
- Timeout => 10)
- or return "con_lost";
- print $client "$cmd\n";
- my $answer=<$client>;
- chomp($answer);
- if (!$answer) { $answer="con_lost"; }
- return $answer;
-}
# --------------------------------------------------------- Output error status
+sub log {
+ my $fh=shift;
+ if ($fh) { print $fh @_ }
+}
+
sub errout {
my $fh=shift;
- print $fh (<
+ Rotating $description ... ";
+ &log($fh," Seems like it started ... ";
+ &log($fh," Seems like that did not work! ');
+ printf("%-15s ",$daemon);
+ if ($fh) {
+ if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
+ if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
+ while (my $line= ";
+ &log($fh," Give it one more try ... ";
+ &log($fh," Unable to start $daemon
+ &log($fh,(<
Notices $notices Warnings $warnings
- Errors $errors '.$daemon.'
Log
';
- printf("%-10s ",$daemon);
- if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
- open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");
- while ($line=
";
-
+
my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
my $restartflag=1;
-
+ my $daemonpid;
if (-e $pidfile) {
my $lfh=IO::File->new("$pidfile");
- my $daemonpid=<$lfh>;
+ $daemonpid=<$lfh>;
chomp($daemonpid);
- if (kill 0 => $daemonpid) {
- print $fh "'.$daemon.'
Log
$daemon at pid $daemonpid responding";
- if ($sendusr1) { print $fh ", sending USR1"; }
- print $fh "
";
- if ($sendusr1) { kill USR1 => $daemonpid; }
+ if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
+ &log($fh,"$daemon at pid $daemonpid responding");
+ if ($send) { &log($fh,", sending $send"); }
+ &log($fh,"
");
+ if ($send eq 'USR1') { kill USR1 => $daemonpid; }
+ if ($send eq 'USR2') { kill USR2 => $daemonpid; }
$restartflag=0;
- print "running\n";
+ if ($send eq 'USR2') {
+ $result = 'reloaded';
+ print "reloaded\n";
+ } else {
+ $result = 'running';
+ print "running\n";
+ }
} else {
$errors++;
- print $fh "$daemon at pid $daemonpid not responding
";
+ &log($fh,"$daemon at pid $daemonpid not responding
");
$restartflag=1;
- print $fh "Decided to clean up stale .pid file and restart $daemon
";
+ &log($fh,"Decided to clean up stale .pid file and restart $daemon
");
}
}
if ($restartflag==1) {
$simplestatus{$daemon}='off';
$errors++;
- print $fh '
Killall '.$daemon.': '.
- `killall $daemon 2>&1`.' - ';
- sleep 2;
- print $fh unlink($pidfile).' - '.
- `killall -9 $daemon 2>&1`.
- '
';
- print $fh "$daemon not running, trying to start
";
-
- if (&start_daemon($fh,$daemon,$pidfile)) {
- print $fh "$daemon at pid $daemonpid responding
";
+ my $kadaemon=$daemon;
+ if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; }
+ &log($fh,'
Killall '.$daemon.': '.
+ `killall $kadaemon 2>&1`.' - ');
+ sleep 1;
+ &log($fh,unlink($pidfile).' - '.
+ `killall -9 $kadaemon 2>&1`.
+ '
');
+ &log($fh,"$daemon not running, trying to start
");
+
+ if (&start_daemon($fh,$daemon,$pidfile,$args)) {
+ &log($fh,"$daemon at pid $daemonpid responding
");
$simplestatus{$daemon}='restarted';
+ $result = 'started';
print "started\n";
} else {
$errors++;
- print $fh "$daemon at pid $daemonpid not responding
";
- print $fh "Give it one more try ...$daemon at pid $daemonpid not responding
");
+ &log($fh,"$daemon at pid $daemonpid responding
";
+ if (&start_daemon($fh,$daemon,$pidfile,$args)) {
+ &log($fh,"$daemon at pid $daemonpid responding
");
$simplestatus{$daemon}='restarted';
+ $result = 'started';
print "started\n";
} else {
+ $result = 'failed';
print " failed\n";
$simplestatus{$daemon}='failed';
$errors++; $errors++;
- print $fh "$daemon at pid $daemonpid not responding
";
- print $fh "Unable to start $daemon$daemon at pid $daemonpid not responding
");
+ &log($fh,"";
- open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");
- while ($line=
";
- }
+ if ($fh) {
+ if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
+ &log($fh,"");
+ if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
+ while (my $line=
";
- rename("$fname.2","$fname.3");
- rename("$fname.1","$fname.2");
- rename("$fname","$fname.1");
- }
+ my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
+ &rotate_logfile($fname,$fh,'logs');
&errout($fh);
+ return $result;
}
-# ================================================================ Main Program
-
-# --------------------------------- Read loncapa_apache.conf and loncapa.conf
-my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
-%perlvar=%{$perlvarref};
-undef $perlvarref;
-delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
-delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
-
-# --------------------------------------- Make sure that LON-CAPA is configured
-# I only test for one thing here (lonHostID). This is just a safeguard.
-if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
- print("Unconfigured machine.\n");
- $emailto=$perlvar{'lonSysEMail'};
- $hostname=`/bin/hostname`;
- chop $hostname;
- $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell
- $subj="LON: Unconfigured machine $hostname";
- system("echo 'Unconfigured machine $hostname.' |\
- mailto $emailto -s '$subj' > /dev/null");
- exit 1;
-}
-
-# ----------------------------- Make sure this process is running from user=www
-my $wwwid=getpwnam('www');
-if ($wwwid!=$<) {
- print("User ID mismatch. This program must be run as user 'www'\n");
- $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
- $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
- system("echo 'User ID mismatch. loncron must be run as user www.' |\
- mailto $emailto -s '$subj' > /dev/null");
- exit 1;
-}
-
-# ------------------------------------------------------------- Read hosts file
-{
- my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
-
- while (my $configline=<$config>) {
- my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
- if ($id && $domain && $role && $name && $ip) {
- $hostname{$id}=$name;
- $hostdom{$id}=$domain;
- $hostip{$id}=$ip;
- $hostrole{$id}=$role;
- if ($domdescr) { $domaindescription{$domain}=$domdescr; }
- if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) {
- $libserv{$id}=$name;
- }
- } else {
- if ($configline) {
-# &logthis("Skipping hosts.tab line -$configline-");
- }
- }
- }
-}
-
-# ------------------------------------------------------ Read spare server file
-{
- my $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab");
-
- while (my $configline=<$config>) {
- chomp($configline);
- if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
- $spareid{$configline}=1;
- }
- }
-}
-
-# ---------------------------------------------------------------- Start report
-
-$statusdir="/home/httpd/html/lon-status";
-
-$errors=0;
-$warnings=0;
-$notices=0;
-
-$now=time;
-$date=localtime($now);
-
-{
- my $fh=IO::File->new(">$statusdir/newstatus.html");
- my %simplestatus=();
-
- print $fh (< Cleaned up ".$cleaned." stale session token(s).";
- print $fh " Cleaned up ".$cleaned." stale session token(s). Cleaned up ".$cleaned." stale balancer files Cleaned up ".$cleaned." stale webDAV session token(s). Cleaned up ".$cleaned." stale sockets. ";
- rename("$fname.2","$fname.3");
- rename("$fname.1","$fname.2");
- rename("$fname","$fname.1");
+sub rotate_other_logs {
+ my ($fh) = @_;
+ my %logs = (
+ autoenroll => 'Auto Enroll log',
+ autocreate => 'Create Course log',
+ searchcat => 'Search Cataloguing log',
+ autoupdate => 'Auto Update log',
+ refreshcourseids_db => 'Refresh CourseIDs db log',
+ );
+ foreach my $item (keys(%logs)) {
+ my $fname=$perlvar{'lonDaemons'}.'/logs/'.$item.'.log';
+ &rotate_logfile($fname,$fh,$logs{$item});
}
+}
- print $fh " \n";
- $warnings=$warnings+5*$unsend;
- if ($unsend) { $simplestatus{'unsend'}=$unsend; }
- print $fh " Total unsend messages: $unsendLON Status Report $perlvar{'lonHostID'}
-$date ($now)
-
-
-
-
-Configuration
-PerlVars
-
-ENDHEADERS
-
- foreach $varname (sort(keys(%perlvar))) {
- print $fh "
\n";
- }
- print $fh "$varname $perlvar{$varname} Hosts
";
- foreach $id (sort(keys(%hostname))) {
- print $fh
- "
\n";
- }
- print $fh "$id $hostdom{$id} $hostrole{$id} ";
- print $fh "$hostname{$id} $hostip{$id} Spare Hosts
";
- foreach $id (sort(keys(%spareid))) {
- print $fh "
\n";
# --------------------------------------------------------------------- Machine
-
- print $fh 'Machine Information
';
- print $fh "loadavg
";
-
+sub log_machine_info {
+ my ($fh)=@_;
+ &log($fh,'Machine Information
');
+ &log($fh,"loadavg
");
+
open (LOADAVGH,"/proc/loadavg");
- $loadavg=df
";
- print $fh "";
+ &log($fh,"
");
- print $fh "df
");
+ &log($fh,"");
open (DFH,"df|");
- while ($line=
";
+ &log($fh,"ps
";
- print $fh "";
- $psproc=0;
+ &log($fh,"
");
if ($psproc>200) { $notices++; }
if ($psproc>250) { $notices++; }
+ &log($fh,"ps
");
+ &log($fh,"");
+ my $psproc=0;
- open (PSH,"ps -aux|");
- while ($line=
";
+ &log($fh,"distprobe
");
+ &log($fh,"");
+ &log($fh,&encode_entities(&LONCAPA::distro(),'<>&"'));
+ &log($fh,"
");
+
&errout($fh);
+}
-# --------------------------------------------------------------- clean out tmp
- print $fh 'Temporary Files
';
- $cleaned=0;
- $old=0;
- while ($fname=<$perlvar{'lonDaemons'}/tmp/*>) {
- my ($dev,$ino,$mode,$nlink,
- $uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,
- $blksize,$blocks)=stat($fname);
- $now=time;
- $since=$now-$mtime;
- if ($since>$perlvar{'lonExpire'}) {
- $line='';
- if (open(PROBE,$fname)) {
- $line=LON Status Report $perlvar{'lonHostID'}
+$date ($now)
+
+
+
+
+Configuration
+PerlVars
+
+ENDHEADERS
+
+ foreach my $varname (sort(keys(%perlvar))) {
+ &log($fh,"
\n");
+ }
+ &log($fh,"$varname ".
+ &encode_entities($perlvar{$varname},'<>&"')." Hosts
");
+ my %hostname = &Apache::lonnet::all_hostnames();
+ foreach my $id (sort(keys(%hostname))) {
+ my $role = (&Apache::lonnet::is_library($id) ? 'library'
+ : 'access');
+ &log($fh,
+ "
\n");
+ }
+ &log($fh,"$id ".&Apache::lonnet::host_domain($id).
+ " ".$role.
+ " ".&Apache::lonnet::hostname($id)." Spare Hosts
");
+ if (keys(%Apache::lonnet::spareid) > 0) {
+ &log($fh,"");
+ foreach my $type (sort(keys(%Apache::lonnet::spareid))) {
+ &log($fh,"
\n");
+ } else {
+ &log($fh,"No spare hosts specified");
+ foreach my $id (@{ $Apache::lonnet::spareid{$type} }) {
+ &log($fh,"
\n
\n");
}
- print $fh "Cleaned up ".$cleaned." files (".$old." old checkout tokens).";
+ return $fh;
+}
+
+# --------------------------------------------------------------- clean out tmp
+sub clean_tmp {
+ my ($fh)=@_;
+ &log($fh,'Temporary Files
');
+ my ($cleaned,$old,$removed) = (0,0,0);
+ my %errors = (
+ dir => [],
+ file => [],
+ failopen => [],
+ );
+ my %error_titles = (
+ dir => 'failed to remove empty directory:',
+ file => 'failed to unlike stale file',
+ failopen => 'failed to open file or directory'
+ );
+ ($cleaned,$old,$removed) = &recursive_clean_tmp('',$cleaned,$old,$removed,\%errors);
+ &log($fh,"Cleaned up: ".$cleaned." files; removed: $removed empty directories; (found: $old old checkout tokens)");
+ foreach my $key (sort(keys(%errors))) {
+ if (ref($errors{$key}) eq 'ARRAY') {
+ if (@{$errors{$key}} > 0) {
+ &log($fh,"Error during cleanup ($error_titles{$key}):
');
+ }
+ }
+ }
+}
+
+sub recursive_clean_tmp {
+ my ($subdir,$cleaned,$old,$removed,$errors) = @_;
+ my $base = "$perlvar{'lonDaemons'}/tmp";
+ my $path = $base;
+ next if ($subdir =~ m{\.\./});
+ next unless (ref($errors) eq 'HASH');
+ unless ($subdir eq '') {
+ $path .= '/'.$subdir;
+ }
+ if (opendir(my $dh,"$path")) {
+ while (my $file = readdir($dh)) {
+ next if ($file =~ /^\.\.?$/);
+ my $fname = "$path/$file";
+ if (-d $fname) {
+ my $innerdir;
+ if ($subdir eq '') {
+ $innerdir = $file;
+ } else {
+ $innerdir = $subdir.'/'.$file;
+ }
+ ($cleaned,$old,$removed) =
+ &recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);
+ my @doms = &Apache::lonnet::current_machine_domains();
+
+ if (open(my $dirhandle,$fname)) {
+ unless (($innerdir eq 'helprequests') ||
+ (($innerdir =~ /^addcourse/) && ($innerdir !~ m{/\d+$}))) {
+ my @contents = grep {!/^\.\.?$/} readdir($dirhandle);
+ join('&&',@contents)."\n";
+ if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {
+ closedir($dirhandle);
+ if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {
+ if (rmdir($fname)) {
+ $removed ++;
+ } elsif (ref($errors->{dir}) eq 'ARRAY') {
+ push(@{$errors->{dir}},$fname);
+ }
+ }
+ }
+ } else {
+ closedir($dirhandle);
+ }
+ }
+ } else {
+ my ($dev,$ino,$mode,$nlink,
+ $uid,$gid,$rdev,$size,
+ $atime,$mtime,$ctime,
+ $blksize,$blocks)=stat($fname);
+ my $now=time;
+ my $since=$now-$mtime;
+ if ($since>$perlvar{'lonExpire'}) {
+ if ($subdir eq '') {
+ my $line='';
+ if ($fname =~ /\.db$/) {
+ if (unlink($fname)) {
+ $cleaned++;
+ } elsif (ref($errors->{file}) eq 'ARRAY') {
+ push(@{$errors->{file}},$fname);
+ }
+ } elsif (open(PROBE,$fname)) {
+ my $line='';
+ $line=Session Tokens
';
- $cleaned=0;
- $active=0;
- while ($fname=<$perlvar{'lonIDsDir'}/*>) {
+sub clean_lonIDs {
+ my ($fh)=@_;
+ &log($fh,'Session Tokens
');
+ my $cleaned=0;
+ my $active=0;
+ while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
my ($dev,$ino,$mode,$nlink,
$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,
$blksize,$blocks)=stat($fname);
- $now=time;
- $since=$now-$mtime;
+ my $now=time;
+ my $since=$now-$mtime;
if ($since>$perlvar{'lonExpire'}) {
$cleaned++;
- print $fh "Unlinking $fname
";
+ &log($fh,"Unlinking $fname
");
unlink("$fname");
} else {
$active++;
}
-
}
- print $fh "$active open session(s)
";
-
-# ----------------------------------------------------------------------- httpd
-
- print $fh 'httpd
Access Log
';
-
- open (DFH,"tail -n25 /etc/httpd/logs/access_log|");
- while ($line=
Error Log
";
-
- open (DFH,"tail -n25 /etc/httpd/logs/error_log|");
- while ($line=
";
- &errout($fh);
-
-
-# ---------------------------------------------------------------------- lonsql
-
- &checkon_daemon($fh,'lonsql',200000);
+ &log($fh,"$active open session(s)
");
+}
-# ------------------------------------------------------------------------ lond
+# -------------------------------------------------------- clean out balanceIDs
- &checkon_daemon($fh,'lond',40000,1);
+sub clean_balanceIDs {
+ my ($fh)=@_;
+ &log($fh,'Session Tokens
');
+ my $cleaned=0;
+ my $active=0;
+ if (-d $perlvar{'lonBalanceDir'}) {
+ while (my $fname=<$perlvar{'balanceDir'}/*.id>) {
+ my ($dev,$ino,$mode,$nlink,
+ $uid,$gid,$rdev,$size,
+ $atime,$mtime,$ctime,
+ $blksize,$blocks)=stat($fname);
+ my $now=time;
+ my $since=$now-$mtime;
+ if ($since>$perlvar{'lonExpire'}) {
+ $cleaned++;
+ &log($fh,"Unlinking $fname
");
+ unlink("$fname");
+ } else {
+ $active++;
+ }
+ }
+ }
+ &log($fh,"$active unexpired balancer files
");
+}
-# ------------------------------------------------------------------------ lonc
+# ------------------------------------------------ clean out webDAV Session IDs
+sub clean_webDAV_sessionIDs {
+ my ($fh)=@_;
+ if ($perlvar{'lonRole'} eq 'library') {
+ &log($fh,'WebDAV Session Tokens
');
+ my $cleaned=0;
+ my $active=0;
+ my $now = time;
+ if (-d $perlvar{'lonDAVsessDir'}) {
+ while (my $fname=<$perlvar{'lonDAVsessDir'}/*>) {
+ my @stats = stat($fname);
+ my $since=$now-$stats[9];
+ if ($since>$perlvar{'lonExpire'}) {
+ $cleaned++;
+ &log($fh,"Unlinking $fname
");
+ unlink("$fname");
+ } else {
+ $active++;
+ }
+ }
+ &log($fh,"$active open webDAV session(s)
");
+ }
+ }
+}
- &checkon_daemon($fh,'lonc',40000,1);
+# ----------------------------------------------------------- clean out sockets
+sub clean_sockets {
+ my ($fh)=@_;
+ my $cleaned=0;
+ opendir(SOCKETS,$perlvar{'lonSockDir'});
+ while (my $fname=readdir(SOCKETS)) {
+ next if (-d $fname
+ || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
+ $cleaned++;
+ &log($fh,"Unlinking $fname
");
+ unlink("/home/httpd/sockets/$fname");
+ }
+ &log($fh,"lonnet
Temp Log
';
- print "checking logs\n";
+sub rotate_lonnet_logs {
+ my ($fh)=@_;
+ &log($fh,'
";
- &errout($fh);
# ----------------------------------------------------------------- Connections
-
- print $fh 'lonnet
Temp Log
');
+ print "Checking logs.\n";
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
- while ($line=
Perm Log
";
+ &log($fh,"
Perm Log
");
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
- while ($line=
");
+ &errout($fh);
+}
- if ($size>40000) {
- print $fh "Rotating logs ...Connections
';
- print "testing connections\n";
- print $fh "Delayed Messages
');
+ print "Checking buffers.\n";
+
+ &log($fh,'Scanning Permanent Log
');
- print $fh 'Delayed Messages
';
- print "checking buffers\n";
+ my $unsend=0;
- print $fh 'Scanning Permanent Log
';
+ my %hostname = &Apache::lonnet::all_hostnames();
+ my $numhosts = scalar(keys(%hostname));
- $unsend=0;
- {
- my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");
- while ($line=<$dfh>) {
- ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
- if ($sdf eq 'F') {
- $local=localtime($time);
- print $fh "Failed: $time, $dserv, $dcmd
";
- $warnings++;
- }
- if ($sdf eq 'S') { $unsend--; }
- if ($sdf eq 'D') { $unsend++; }
+ my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log");
+ while (my $line=<$dfh>) {
+ my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
+ if ($numhosts) {
+ next unless ($hostname{$dserv});
+ }
+ if ($sdf eq 'F') {
+ my $local=localtime($time);
+ &log($fh,"Failed: $time, $dserv, $dcmd
");
+ $warnings++;
}
+ if ($sdf eq 'S') { $unsend--; }
+ if ($sdf eq 'D') { $unsend++; }
}
- print $fh "Total unsend messages: $unsendOutgoing Buffer
";
+ &log($fh,"Outgoing Buffer
\n");
+# list directory with delayed messages and remember offline servers
+ my %servers=();
open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
- while ($line=
\n");
close (DFH);
+# pong to all servers that have delayed messages
+# this will trigger a reverse connection, which should flush the buffers
+ foreach my $tryserver (sort(keys(%servers))) {
+ if ($hostname{$tryserver} || !$numhosts) {
+ my $answer;
+ eval {
+ local $SIG{ ALRM } = sub { die "TIMEOUT" };
+ alarm(20);
+ $answer = &Apache::lonnet::reply("pong",$tryserver);
+ alarm(0);
+ };
+ if ($@ && $@ =~ m/TIMEOUT/) {
+ &log($fh,"Attempted pong to $tryserver timed out
";
- };
+ while (my $line=
");
+ print "Time out while contacting: $tryserver for pong.\n";
+ } else {
+ &log($fh,"Pong to $tryserver: $answer
");
+ }
+ } else {
+ &log($fh,"$tryserver has delayed messages, but is not part of the cluster -- skipping 'Pong'.
");
+ }
+ }
+}
-# ------------------------------------------------------------------------- End
- print $fh "\n";
+sub finish_logging {
+ my ($fh)=@_;
+ &log($fh,"\n");
$totalcount=$notices+4*$warnings+100*$errors;
&errout($fh);
- print $fh "Total Error Count: $totalcount
";
- $now=time;
- $date=localtime($now);
- print $fh "
$date ($now)\n";
- print "lon-status webpage updated\n";
+ &log($fh,"Total Error Count: $totalcount
");
+ my $now=time;
+ my $date=localtime($now);
+ &log($fh,"
$date ($now)