--- loncom/loncron 2004/05/11 19:15:03 1.47
+++ loncom/loncron 2024/07/10 02:47:53 1.130
@@ -2,7 +2,7 @@
# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# $Id: loncron,v 1.47 2004/05/11 19:15:03 albertel Exp $
+# $Id: loncron,v 1.130 2024/07/10 02:47:53 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -28,34 +28,32 @@
#
$|=1;
+use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
+use LONCAPA::Checksumming;
+use LONCAPA;
+use LONCAPA::LWPReq;
+use Apache::lonnet;
+use Apache::loncommon;
use IO::File;
use IO::Socket;
-use strict;
+use HTML::Entities;
+use Getopt::Long;
+use GDBM_File qw(GDBM_READER);
+use Storable qw(thaw);
+use File::ReadBackwards;
+use File::Copy;
+use Sys::Hostname::FQDN();
+
#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 {
@@ -66,72 +64,97 @@ sub log {
sub errout {
my $fh=shift;
&log($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
+
ENDERROUT
}
+sub rotate_logfile {
+ my ($file,$fh,$description) = @_;
+ my $size=(stat($file))[7];
+ if ($size>40000) {
+ &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 (my $line=
");
-
+
my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
-
+
my $restartflag=1;
my $daemonpid;
if (-e $pidfile) {
my $lfh=IO::File->new("$pidfile");
$daemonpid=<$lfh>;
chomp($daemonpid);
- if (kill 0 => $daemonpid) {
+ if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) {
&log($fh,"'.$daemon.'
Log
$daemon at pid $daemonpid responding");
- if ($sendusr1) { &log($fh,", sending USR1"); }
+ if ($send) { &log($fh,", sending $send"); }
&log($fh,"
");
- if ($sendusr1) { kill USR1 => $daemonpid; }
+ 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++;
&log($fh,"$daemon at pid $daemonpid not responding
");
@@ -142,84 +165,99 @@ sub checkon_daemon {
if ($restartflag==1) {
$simplestatus{$daemon}='off';
$errors++;
- &log($fh,'
Killall '.$daemon.': '.
- `killall $daemon 2>&1`.' - ');
- sleep 2;
+ 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 $daemon 2>&1`.
- '
');
+ `killall -9 $kadaemon 2>&1`.
+ '
');
+ if ($kadaemon eq 'loncnew') {
+ &clean_lonc_childpids();
+ }
&log($fh,"$daemon not running, trying to start
");
-
- if (&start_daemon($fh,$daemon,$pidfile)) {
+
+ if (&start_daemon($fh,$daemon,$pidfile,$args)) {
&log($fh,"$daemon at pid $daemonpid responding
");
$simplestatus{$daemon}='restarted';
+ $result = 'started';
print "started\n";
} else {
$errors++;
&log($fh,"$daemon at pid $daemonpid not responding
");
- &log($fh,"Give it one more try ...$daemon at pid $daemonpid responding
");
$simplestatus{$daemon}='restarted';
+ $result = 'started';
print "started\n";
} else {
+ $result = 'failed';
print " failed\n";
$simplestatus{$daemon}='failed';
$errors++; $errors++;
&log($fh,"$daemon at pid $daemonpid not responding
");
- &log($fh,"Unable to start $daemon");
- open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");
- while (my $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"); - } + &rotate_logfile($fname,$fh,'logs'); &errout($fh); + return $result; } # --------------------------------------------------------------------- Machine sub log_machine_info { my ($fh)=@_; - &log($fh,'
"); open (DFH,"df|"); - while (my $line=) { - &log($fh,"$line"); + while (my $line= ) { + &log($fh,&encode_entities($line,'<>&"')); @parts=split(/\s+/,$line); my $usage=$parts[4]; $usage=~s/\W//g; - if ($usage>90) { + if ($usage>90) { $warnings++; - $notices++; + $notices++; } elsif ($usage>80) { $warnings++; } elsif ($usage>60) { @@ -250,9 +288,9 @@ sub log_machine_info { &log($fh," "); my $psproc=0; - open (PSH,"ps -aux --cols 140 |"); - while (my $line=) { - &log($fh,"$line"); + open (PSH,"ps aux --cols 140 |"); + while (my $line= ) { + &log($fh,&encode_entities($line,'<>&"')); $psproc++; } close (PSH); @@ -261,258 +299,693 @@ sub log_machine_info { if ($psproc>200) { $notices++; } if ($psproc>250) { $notices++; } + &log($fh," distprobe
"); + &log($fh,""); + &log($fh,&encode_entities(&LONCAPA::distro(),'<>&"')); + &log($fh,""); + &errout($fh); } sub start_logging { - my ($hostdom,$hostrole,$hostname,$spareid)=@_; my $fh=IO::File->new(">$statusdir/newstatus.html"); my %simplestatus=(); my $now=time; my $date=localtime($now); - + &log($fh,(<+ + LON Status Report $perlvar{'lonHostID'} + - +LON Status Report $perlvar{'lonHostID'}
$date ($now)
-
-- Configuration -
- Machine Information -
- Temporary Files -
- Session Tokens -
- httpd -
- lonsql -
- lond -
- lonc -
- lonhttpd -
- lonnet -
- Connections -
- Delayed Messages -
- Error Coindex.html.unt +
- Configuration
+- Machine Information
+- Temporary Files
+- Session Tokens
+- WebDAV Session Tokens
+- httpd
+- lonsql
+- lond
+- lonc
+- lonnet
+- Connections
+- bash readline config
+- Delayed Messages
+- Error Count
- +
+Configuration
PerlVars
-+
ENDHEADERS foreach my $varname (sort(keys(%perlvar))) { - &log($fh,"
\n"); + &log($fh," $varname $perlvar{$varname} \n"); } - &log($fh," $varname ". + &encode_entities($perlvar{$varname},'<>&"')." Hosts
"); - foreach my $id (sort(keys(%{$hostname}))) { + &log($fh,"
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 ".$hostdom->{$id}. - " ".$hostrole->{$id}. - " ".$hostname->{$id}." Spare Hosts
"); - foreach my $id (sort(keys(%{$spareid}))) { - &log($fh,"
- $id\n"); + "
\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- $type\n
\n"); + } + &log($fh,""); + foreach my $id (@{ $Apache::lonnet::spareid{$type} }) { + &log($fh,"
\n- $id
\n"); + } + &log($fh,"
\n"); } - &log($fh,"\n"); return $fh; } # --------------------------------------------------------------- clean out tmp sub clean_tmp { my ($fh)=@_; - &log($fh,'Temporary Files
'); - my $cleaned=0; - my $old=0; - while (my $fname=<$perlvar{'lonDaemons'}/tmp/*>) { - 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'}) { - my $line=''; - if (open(PROBE,$fname)) { - $line=; - close(PROBE); - } - unless ($line=~/^CHECKOUTTOKEN\&/) { - $cleaned++; - unlink("$fname"); - } else { - if ($since>365*$perlvar{'lonExpire'}) { - $cleaned++; - unlink("$fname"); - } else { $old++; } - } - } + &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}):
- ". + join('
- ',@{$errors{$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=; + close(PROBE); + if ($line=~/^CHECKOUTTOKEN\&/) { + if ($since>365*$perlvar{'lonExpire'}) { + if (unlink($fname)) { + $cleaned++; + } elsif (ref($errors->{file}) eq 'ARRAY') { + push(@{$errors->{file}},$fname); + } + } else { + $old++; + } + } else { + if (unlink($fname)) { + $cleaned++; + } elsif (ref($errors->{file}) eq 'ARRAY') { + push(@{$errors->{file}},$fname); + } + } + } elsif (ref($errors->{failopen}) eq 'ARRAY') { + push(@{$errors->{failopen}},$fname); + } + } else { + if (unlink($fname)) { + $cleaned++; + } elsif (ref($errors->{file}) eq 'ARRAY') { + push(@{$errors->{file}},$fname); + } + } + } + } + } + closedir($dh); + } elsif (ref($errors->{failopen}) eq 'ARRAY') { + push(@{$errors->{failopen}},$path); } - &log($fh,"Cleaned up ".$cleaned." files (".$old." old checkout tokens)."); + return ($cleaned,$old,$removed); } # ------------------------------------------------------------ clean out lonIDs sub clean_lonIDs { my ($fh)=@_; - &log($fh,' Session Tokens
'); + &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); - my $now=time; - my $since=$now-$mtime; - if ($since>$perlvar{'lonExpire'}) { - $cleaned++; - &log($fh,"Unlinking $fname
"); - unlink("$fname"); - } else { - $active++; - } + my $now=time; + if (-l $fname) { + my $linkfname = readlink($fname); + if (-f $linkfname) { + if ($linkfname =~ m{^$perlvar{'lonIDsDir'}/[^/]+\.id$}) { + my @data = stat($linkfname); + my $mtime = $data[9]; + my $since=$now-$mtime; + if ($since>$perlvar{'lonExpire'}) { + if (unlink($linkfname)) { + $cleaned++; + &log($fh,"Unlinking $linkfname
"); + unlink($fname); + } + } + } + } else { + unlink($fname); + } + } elsif (-f $fname) { + my @data = stat($fname); + my $mtime = $data[9]; + my $since=$now-$mtime; + if ($since>$perlvar{'lonExpire'}) { + if (unlink($fname)) { + $cleaned++; + &log($fh,"Unlinking $fname
"); + } + } else { + $active++; + } + } } - &log($fh,"Cleaned up ".$cleaned." stale session token(s)."); + &log($fh,"
Cleaned up ".$cleaned." stale session token(s).
"); &log($fh,"$active open session(s)
"); } +# -------------------------------------------------------- clean out balanceIDs + +sub clean_balanceIDs { + my ($fh)=@_; + &log($fh,'Session Tokens
'); + my $cleaned=0; + my $active=0; + if (-d $perlvar{'lonBalanceDir'}) { + while (my $fname=<$perlvar{'lonBalanceDir'}/*.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,"Cleaned up ".$cleaned." stale balancer files
"); + &log($fh,"$active unexpired balancer files
"); +} + +# ------------------------------------------------ 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,"Cleaned up ".$cleaned." stale webDAV session token(s).
"); + &log($fh,"$active open webDAV session(s)
"); + } + } +} + +# ------------------------------------------------------------ clean out ltiIDs + +sub clean_ltiIDs { + my ($fh)=@_; + &log($fh,'LTI Session Pointers
'); + my $cleaned=0; + my $active=0; + if (-d $perlvar{'ltiIDsDir'}) { + while (my $fname=<$perlvar{'ltiIDsDir'}/*>) { + 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,"Cleaned up ".$cleaned." old LTI session pointers.
"); + &log($fh,"$active unexpired LTI session pointers
"); +} + +# ----------------------------------------------------------- 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,"Cleaned up ".$cleaned." stale sockets.
"); +} + # ----------------------------------------------------------------------- httpd sub check_httpd_logs { my ($fh)=@_; - &log($fh,'httpd
Access Log
'); - - open (DFH,"tail -n25 /etc/httpd/logs/access_log|"); - while (my $line=) { &log($fh,"$line") }; - close (DFH); - - &log($fh," Error Log
"); - - open (DFH,"tail -n25 /etc/httpd/logs/error_log|"); - while (my $line="); &errout($fh); } # ---------------------------------------------------------------------- lonnet -sub rotate_logs { +sub rotate_lonnet_logs { my ($fh)=@_; - &log($fh,') { - &log($fh,"$line"); - if ($line=~/\[error\]/) { $notices++; } + if (open(PIPE,"./lchttpdlogs|")) { + while (my $line= ) { + &log($fh,$line); + if ($line=~/\[error\]/) { $notices++; } + } + close(PIPE); } - close (DFH); - &log($fh," lonnet
Temp Log
'); - print "checking logs\n"; + &log($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 (my $line=) { - &log($fh,"$line"); + while (my $line= ) { + &log($fh,&encode_entities($line,'<>&"')); } close (DFH); } &log($fh," Perm Log
"); - + if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|"); - while (my $line="); &errout($fh); } +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}); + } +} + # ----------------------------------------------------------------- Connections sub test_connections { - my ($fh,$hostname)=@_; - &log($fh,') { - &log($fh,"$line"); + while (my $line= ) { + &log($fh,&encode_entities($line,'<>&"')); } close (DFH); } else { &log($fh,"No perm log\n") } my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log"; - - my ($dev,$ino,$mode,$nlink, - $uid,$gid,$rdev,$size, - $atime,$mtime,$ctime, - $blksize,$blocks)=stat($fname); - - if ($size>40000) { - &log($fh,"Rotating logs ... "); - rename("$fname.2","$fname.3"); - rename("$fname.1","$fname.2"); - rename("$fname","$fname.1"); - } + &rotate_logfile($fname,$fh,'lonnet log'); &log($fh,"
Connections
'); - print "testing connections\n"; - &log($fh,""); - foreach my $tryserver (sort(keys(%{$hostname}))) { + my ($fh)=@_; + &log($fh,'
Connections
'); + print "Testing connections.\n"; + &log($fh,""); + my ($good,$bad)=(0,0); + my %hostname = &Apache::lonnet::all_hostnames(); + foreach my $tryserver (sort(keys(%hostname))) { print("."); my $result; - my $answer=reply("pong",$tryserver); + my $answer=&Apache::lonnet::reply("ping",$tryserver); if ($answer eq "$tryserver:$perlvar{'lonHostID'}") { $result="ok"; + $good++; } else { $result=$answer; $warnings++; - if ($answer eq 'con_lost') { $warnings++; } + if ($answer eq 'con_lost') { + $bad++; + $warnings++; + } else { + $good++; #self connection + } } if ($answer =~ /con_lost/) { print(" $tryserver down\n"); } &log($fh,"
"); - + print "\n$good good, $bad bad connections\n"; &errout($fh); } # ------------------------------------------------------------ Delayed messages sub check_delayed_msg { - my ($fh)=@_; - &log($fh,'\n"); } &log($fh," $tryserver $result Delayed Messages
'); - print "checking buffers\n"; + my ($fh,$weightsref,$exclusionsref)=@_; + &log($fh,'Delayed Messages
'); + print "Checking buffers.\n"; &log($fh,'Scanning Permanent Log
'); my $unsend=0; + my $ignored=0; - my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log"); - while (my $line=<$dfh>) { - my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line); - 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++; } + my %hostname = &Apache::lonnet::all_hostnames(); + my $numhosts = scalar(keys(%hostname)); + my $checkbackwards = 0; + my $checkfrom = 0; + my $checkexcluded = 0; + my (%bymachine,%weights,%exclusions,%serverhomes); + if (ref($weightsref) eq 'HASH') { + %weights = %{$weightsref}; + } + if (ref($exclusionsref) eq 'HASH') { + %exclusions = %{$exclusionsref}; + if (keys(%exclusions)) { + $checkexcluded = 1; + %serverhomes = &read_serverhomeIDs(); + } } - &log($fh,"Total unsend messages: $unsend\n"); - $warnings=$warnings+5*$unsend; +# +# For LON-CAPA 1.2.0 to 2.1.3 (release dates: 8/31/2004 and 3/31/2006) any +# entry logged in lonnet.perm.log for completion of a delayed (critical) +# transaction lacked the hostID for the remote node to which the command +# to be completed was sent. +# +# Because of this, exclusion of items in lonnet.perm.log for nodes which are +# no longer part of the cluster from adding to the overall "unsend" count +# needs additional effort besides the changes made in loncron rev. 1.105. +# +# For "S" (completion) events logging in LON-CAPA 1.2.0 through 2.1.3 included +# "LondTransaction=HASH(hexadecimal)->getClient() :$cmd, where the hexadecimal +# is a memory location, and $cmd is the command sent to the remote node. +# +# Starting with 2.2.0 (released 8/21/2006) logging for "S" (completion) events +# had sethost:$host_id:$cmd after LondTransaction=HASH(hexadecimal)->getClient() +# +# Starting with 2.4.1 (released 6/13/2007) logging for "S" replaced echoing the +# getClient() call with the result of the Transaction->getClient() call itself +# undef for completion of delivery of a delayed message. +# +# The net effect of these changes is that lonnet.perm.log is now accessed three +# times: (a) oldest record is checked, if earlier than release date for 2.5.0 +# then (b) file is read backwards, with timestamp recorded for most recent +# instance of logged "S" event for "update" command without "sethost:$host_id:" +# then (c) file is read forward with records ignored which predate the timestamp +# recorded in (b), if one was found. +# +# In (c), when calculating the unsend total, i.e., the difference between delayed +# transactions ("D") and sent transactions ("S"), transactions are ignored if the +# target node is no longer in the cluster, and also (for "update" commands), if +# the target node is in the list of nodes excluded from the count, in the domain +# configuration for this machine's default domain. The idea here is to remove +# delayed "update" commands for nodes for which inbound access to port 5663, +# is blocked, but are still part of the LON-CAPA network, (i.e., they can still +# replicate content from other nodes). +# - if ($unsend) { $simplestatus{'unsend'}=$unsend; } - &log($fh,"
Outgoing Buffer
"); + my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r"); + if (defined($dfh)) { + while (my $line=<$dfh>) { + my ($time,$sdf,$rest)=split(/:/,$line,3); + if ($time < 1541185772) { + $checkbackwards = 1; + } + last; + } + undef $dfh; + } + + if ($checkbackwards) { + if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { + while(my $line=) { + if ($line =~ /\QLondTransaction=HASH\E[^:]+:update:/) { + ($checkfrom) = split(/:/,$line,2); + last; + } + } + close(BW); + } + } + $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r"); + if (defined($dfh)) { + while (my $line=<$dfh>) { + my ($time,$sdf,$rest)=split(/:/,$line,3); + next unless (($sdf eq 'F') || ($sdf eq 'S') || ($sdf eq 'D')); + next if (($checkfrom) && ($time <= $checkfrom)); + my ($dserv,$dcmd); + if ($sdf eq 'S') { + my ($serva,$cmda,$servb,$cmdb) = split(/:/,$rest); + if ($cmda eq 'sethost') { + chomp($cmdb); + $dcmd = $cmdb; + } else { + $dcmd = $cmda; + } + if (($serva =~ /^LondTransaction/) || ($serva eq '')) { + unless (($servb eq '') || ($servb =~ m{^/})) { + $dserv = $servb; + } + } else { + $dserv = $serva; + } + } else { + ($dserv,$dcmd) = split(/:/,$rest); + } + if ($sdf eq 'F') { + my $local=localtime($time); + &log($fh,"Failed: $time, $dserv, $dcmd
"); + $warnings++; + } + next if ((($dserv eq '') || ($dcmd eq '')) && ($sdf ne 'F')); + if ($sdf eq 'S') { + if ($dcmd eq 'update') { + if ($hostname{$dserv}) { + if ($exclusions{$serverhomes{$hostname{$dserv}}}) { + $ignored --; + } else { + $unsend --; + } + } + if (exists($bymachine{$dserv})) { + $bymachine{$dserv} --; + } else { + $bymachine{$dserv} = -1; + } + } else { + if ($hostname{$dserv}) { + $unsend --; + } + } + } elsif ($sdf eq 'D') { + if ($dcmd eq 'update') { + if ($hostname{$dserv}) { + if ($exclusions{$serverhomes{$hostname{$dserv}}}) { + $ignored ++; + } else { + $unsend ++; + } + } + if (exists($bymachine{$dserv})) { + $bymachine{$dserv} ++; + } else { + $bymachine{$dserv} = 1; + } + } else { + if ($hostname{$dserv}) { + $unsend ++; + } + } + } + } + undef $dfh; + my $nodest = 0; + my $retired = 0; + my %active; + if (keys(%bymachine)) { + unless ($checkexcluded) { + %serverhomes = &read_serverhomeIDs(); + } + foreach my $key (keys(%bymachine)) { + if ($bymachine{$key} > 0) { + if ($hostname{$key}) { + $active{$serverhomes{$hostname{$key}}} += $bymachine{$key}; + } else { + $retired ++; + $nodest += $bymachine{$key}; + } + } + } + } + if (keys(%active)) { + &log($fh,"Unsend messages by node, active (undegraded) nodes in cluster
\n"); + foreach my $key (sort(keys(%active))) { + &log($fh,&encode_entities("$key => $active{$key}",'<>&"')."\n"); + } + } + &log($fh,"Total unsend messages: $unsend for ".scalar(keys(%active))." active (undegraded) nodes in cluster.
\n"); + if (keys(%exclusions) > 0) { + &log($fh,"Total incomplete updates $ignored for ".scalar(keys(%exclusions))." degraded nodes in cluster.
\n"); + } + if ($retired) { + &log($fh,"Total unsent $nodest for $retired nodes no longer in cluster.
\n"); + } + if ($unsend > 0) { + $warnings=$warnings+$weights{'U'}*$unsend; + } + } + if ($unsend) { $simplestatus{'unsend'}=$unsend; } + &log($fh,"Outgoing Buffer
\n"); +# list directory with delayed messages and remember offline servers + my %servers=(); open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|"); - while (my $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) { - &log($fh,"$line
"); + while (my $line=) { + my ($server)=($line=~/\.(\w+)$/); + if ($server) { $servers{$server}=1; } + &log($fh,&encode_entities($line,'<>&"')); } + &log($fh,"
"); + 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'.
"); + } + } } sub finish_logging { - my ($fh)=@_; - &log($fh,"\n"); - $totalcount=$notices+4*$warnings+100*$errors; + my ($fh,$weightsref)=@_; + my %weights; + if (ref($weightsref) eq 'HASH') { + %weights = %{$weightsref}; + } + &log($fh,"\n"); + $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors); &errout($fh); &log($fh,"Total Error Count: $totalcount
"); my $now=time; my $date=localtime($now); - &log($fh,"
$date ($now)\n"); - print "lon-status webpage updated\n"; + &log($fh,"
$date ($now)