version 1.26, 2002/05/11 21:18:14
|
version 1.136, 2024/10/24 21:24:43
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
|
|
# The LearningOnline Network |
# Housekeeping program, started by cron, loncontrol and loncron.pl |
# Housekeeping program, started by cron |
# |
|
# $Id$ |
|
# |
|
# 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/ |
# |
# |
# (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) |
|
# |
|
# 7/14,7/15,7/19,7/21,7/22,11/18, |
|
# 2/8 Gerd Kortemeyer |
|
# 12/6/2000,12/8 Scott Harrison |
|
# 12/23 Gerd Kortemeyer |
|
# YEAR=2001 |
|
# 1/10/2001, 2/12/, 2/26, 3/15, 04/11, 04/21,8/27 Scott Harrison |
|
# 09/04,09/06,11/26 Gerd Kortemeyer |
|
# YEAR=2002 |
|
# 5/11/2002 Scott Harrison |
|
|
|
$|=1; |
$|=1; |
|
use strict; |
|
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
use LONCAPA::Checksumming; |
|
use LONCAPA; |
|
use LONCAPA::LWPReq; |
|
use Apache::lonnet; |
|
use Apache::loncommon; |
|
|
use IO::File; |
use IO::File; |
use IO::Socket; |
use IO::Socket; |
|
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 |
# --------------------------------------------------------- Output error status |
|
|
|
sub log { |
|
my $fh=shift; |
|
if ($fh) { print $fh @_ } |
|
} |
|
|
sub errout { |
sub errout { |
my $fh=shift; |
my $fh=shift; |
print $fh (<<ENDERROUT); |
&log($fh,(<<ENDERROUT)); |
<p><table border=2 bgcolor="#CCCCCC"> |
<table border="2" bgcolor="#CCCCCC"> |
<tr><td>Notices</td><td>$notices</td></tr> |
<tr><td>Notices</td><td>$notices</td></tr> |
<tr><td>Warnings</td><td>$warnings</td></tr> |
<tr><td>Warnings</td><td>$warnings</td></tr> |
<tr><td>Errors</td><td>$errors</td></tr> |
<tr><td>Errors</td><td>$errors</td></tr> |
</table><p><a href="#top">Top</a><p> |
</table><p><a href="#top">Top</a></p> |
ENDERROUT |
ENDERROUT |
} |
} |
|
|
# ================================================================ Main Program |
sub rotate_logfile { |
|
my ($file,$fh,$description) = @_; |
# ------------------------------------------- Read access.conf and loncapa.conf |
my $size=(stat($file))[7]; |
my $perlvarref=LONCAPA::Configuration::read_conf('access.conf','loncapa.conf'); |
if ($size>40000) { |
my %perlvar=%{$perlvarref}; |
&log($fh,"<p>Rotating $description ...</p>"); |
undef $perlvarref; |
rename("$file.2","$file.3"); |
delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed |
rename("$file.1","$file.2"); |
delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed |
rename("$file","$file.1"); |
|
} |
# --------------------------------------- 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 |
sub start_daemon { |
my $wwwid=getpwnam('www'); |
my ($fh,$daemon,$pidfile,$args) = @_; |
if ($wwwid!=$<) { |
my $progname=$daemon; |
print("User ID mismatch. This program must be run as user 'www'\n"); |
if ($daemon eq 'lonc') { |
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
$progname='loncnew'; |
$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)=split(/:/,$configline); |
|
$hostname{$id}=$name; |
|
$hostdom{$id}=$domain; |
|
$hostrole{$id}=$role; |
|
$hostip{$id}=$ip; |
|
if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) { |
|
$libserv{$id}=$name; |
|
} |
|
} |
} |
|
my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors"; |
|
&rotate_logfile($error_fname,$fh,'error logs'); |
|
if ($daemon eq 'lonc') { |
|
&clean_sockets($fh); |
|
} |
|
system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors"); |
|
sleep 1; |
|
if (-e $pidfile) { |
|
&log($fh,"<p>Seems like it started ...</p>"); |
|
my $lfh=IO::File->new("$pidfile"); |
|
my $daemonpid=<$lfh>; |
|
chomp($daemonpid); |
|
if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) { |
|
return 1; |
|
} else { |
|
return 0; |
|
} |
|
} |
|
&log($fh,"<p>Seems like that did not work!</p>"); |
|
$errors++; |
|
return 0; |
} |
} |
|
|
# ------------------------------------------------------ Read spare server file |
sub checkon_daemon { |
{ |
my ($fh,$daemon,$maxsize,$send,$args)=@_; |
my $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab"); |
|
|
my $result; |
while (my $configline=<$config>) { |
&log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>'); |
chomp($configline); |
printf("%-15s ",$daemon); |
if (($configline) && ($configline ne $perlvar{'lonHostID'})) { |
if ($fh) { |
$spareid{$configline}=1; |
if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){ |
} |
if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) { |
|
while (my $line=<DFH>) { |
|
&log($fh,"$line"); |
|
if ($line=~/INFO/) { $notices++; } |
|
if ($line=~/WARNING/) { $notices++; } |
|
if ($line=~/CRITICAL/) { $warnings++; } |
|
} |
|
close (DFH); |
|
} |
|
} |
|
&log($fh,"</tt></p>"); |
} |
} |
|
|
|
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 ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) { |
|
&log($fh,"<h3>$daemon at pid $daemonpid responding"); |
|
if ($send) { &log($fh,", sending $send"); } |
|
&log($fh,"</h3>"); |
|
if ($send eq 'USR1') { kill USR1 => $daemonpid; } |
|
if ($send eq 'USR2') { kill USR2 => $daemonpid; } |
|
$restartflag=0; |
|
if ($send eq 'USR2') { |
|
$result = 'reloaded'; |
|
print "reloaded\n"; |
|
} else { |
|
$result = 'running'; |
|
print "running\n"; |
|
} |
|
} else { |
|
$errors++; |
|
&log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>"); |
|
$restartflag=1; |
|
&log($fh,"<h3>Decided to clean up stale .pid file and restart $daemon</h3>"); |
|
} |
|
} |
|
if ($restartflag==1) { |
|
$simplestatus{$daemon}='off'; |
|
$errors++; |
|
my $kadaemon=$daemon; |
|
if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; } |
|
&log($fh,'<br /><font color="red">Killall '.$daemon.': '. |
|
`killall $kadaemon 2>&1`.' - '); |
|
sleep 1; |
|
&log($fh,unlink($pidfile).' - '. |
|
`killall -9 $kadaemon 2>&1`. |
|
'</font><br />'); |
|
if ($kadaemon eq 'loncnew') { |
|
&clean_lonc_childpids(); |
|
} |
|
&log($fh,"<h3>$daemon not running, trying to start</h3>"); |
|
|
|
if (&start_daemon($fh,$daemon,$pidfile,$args)) { |
|
&log($fh,"<h3>$daemon at pid $daemonpid responding</h3>"); |
|
$simplestatus{$daemon}='restarted'; |
|
$result = 'started'; |
|
print "started\n"; |
|
} else { |
|
$errors++; |
|
&log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>"); |
|
&log($fh,"<p>Give it one more try ...</p>"); |
|
print " "; |
|
if (&start_daemon($fh,$daemon,$pidfile,$args)) { |
|
&log($fh,"<h3>$daemon at pid $daemonpid responding</h3>"); |
|
$simplestatus{$daemon}='restarted'; |
|
$result = 'started'; |
|
print "started\n"; |
|
} else { |
|
$result = 'failed'; |
|
print " failed\n"; |
|
$simplestatus{$daemon}='failed'; |
|
$errors++; $errors++; |
|
&log($fh,"<h3>$daemon at pid $daemonpid not responding</h3>"); |
|
&log($fh,"<p>Unable to start $daemon</p>"); |
|
} |
|
} |
|
if ($fh) { |
|
if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){ |
|
&log($fh,"<p><pre>"); |
|
if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) { |
|
while (my $line=<DFH>) { |
|
&log($fh,"$line"); |
|
if ($line=~/WARNING/) { $notices++; } |
|
if ($line=~/CRITICAL/) { $notices++; } |
|
} |
|
close (DFH); |
|
} |
|
&log($fh,"</pre></p>"); |
|
} |
|
} |
|
} |
|
|
|
my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log"; |
|
&rotate_logfile($fname,$fh,'logs'); |
|
|
|
&errout($fh); |
|
return $result; |
} |
} |
|
|
# ---------------------------------------------------------------- Start report |
# --------------------------------------------------------------------- Machine |
|
sub log_machine_info { |
|
my ($fh)=@_; |
|
&log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>'); |
|
&log($fh,"<h3>loadavg</h3>"); |
|
|
|
my $cpucount; |
|
if (open(PIPE,"lscpu |grep '^CPU(s)' 2>&1 |")) { |
|
my $info = <PIPE>; |
|
chomp($info); |
|
($cpucount) = ($info =~ /^\QCPU(s):\E\s+(\d+)$/); |
|
close(PIPE); |
|
} |
|
if (!$cpucount) { |
|
$cpucount = 1; |
|
} |
|
my %loadtarget = ( |
|
error => 4.0*$cpucount, |
|
warn => 2.0*$cpucount, |
|
note => 1.0*$cpucount, |
|
); |
|
open (LOADAVGH,"/proc/loadavg"); |
|
my $loadavg=<LOADAVGH>; |
|
close (LOADAVGH); |
|
|
|
&log($fh,"<tt>$loadavg</tt>"); |
|
|
$statusdir="/home/httpd/html/lon-status"; |
my @parts=split(/\s+/,$loadavg); |
|
if ($parts[1]>$loadtarget{'error'}) { |
|
$errors++; |
|
} elsif ($parts[1]>$loadtarget{'warn'}) { |
|
$warnings++; |
|
} elsif ($parts[1]>$loadtarget{'note'}) { |
|
$notices++; |
|
} |
|
|
$errors=0; |
&log($fh,"<h3>df</h3>"); |
$warnings=0; |
&log($fh,"<pre>"); |
$notices=0; |
|
|
open (DFH,"df|"); |
|
while (my $line=<DFH>) { |
|
&log($fh,&encode_entities($line,'<>&"')); |
|
@parts=split(/\s+/,$line); |
|
my $usage=$parts[4]; |
|
$usage=~s/\W//g; |
|
if ($usage>90) { |
|
$warnings++; |
|
$notices++; |
|
} elsif ($usage>80) { |
|
$warnings++; |
|
} elsif ($usage>60) { |
|
$notices++; |
|
} |
|
if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; } |
|
} |
|
close (DFH); |
|
&log($fh,"</pre>"); |
|
|
$now=time; |
|
$date=localtime($now); |
|
|
|
{ |
&log($fh,"<h3>ps</h3>"); |
my $fh=IO::File->new(">$statusdir/newstatus.html"); |
&log($fh,"<pre>"); |
|
my $psproc=0; |
|
|
print $fh (<<ENDHEADERS); |
open (PSH,"ps aux --cols 140 |"); |
<html> |
while (my $line=<PSH>) { |
|
&log($fh,&encode_entities($line,'<>&"')); |
|
$psproc++; |
|
} |
|
close (PSH); |
|
&log($fh,"</pre>"); |
|
|
|
if ($psproc>200) { $notices++; } |
|
if ($psproc>250) { $notices++; } |
|
|
|
&log($fh,"<h3>distprobe</h3>"); |
|
&log($fh,"<pre>"); |
|
&log($fh,&encode_entities(&LONCAPA::distro(),'<>&"')); |
|
&log($fh,"</pre>"); |
|
|
|
&errout($fh); |
|
} |
|
|
|
sub start_logging { |
|
my $fh=IO::File->new(">$statusdir/newstatus.html"); |
|
%simplestatus=(); |
|
my $now=time; |
|
my $date=localtime($now); |
|
|
|
|
|
&log($fh,(<<ENDHEADERS)); |
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> |
|
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> |
<head> |
<head> |
<title>LON Status Report $perlvar{'lonHostID'}</title> |
<title>LON Status Report $perlvar{'lonHostID'}</title> |
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> |
</head> |
</head> |
<body bgcolor="#AAAAAA"> |
<body bgcolor="#AAAAAA"> |
<a name="top"> |
<a name="top" /> |
<h1>LON Status Report $perlvar{'lonHostID'}</h1> |
<h1>LON Status Report $perlvar{'lonHostID'}</h1> |
<h2>$date ($now)</h2> |
<h2>$date ($now)</h2> |
<ol> |
<ol> |
<li><a href="#configuration">Configuration</a> |
<li><a href="#configuration">Configuration</a></li> |
<li><a href="#machine">Machine Information</a> |
<li><a href="#machine">Machine Information</a></li> |
<li><a href="#tmp">Temporary Files</a> |
<li><a href="#tmp">Temporary Files</a></li> |
<li><a href="#tokens">Session Tokens</a> |
<li><a href="#tokens">Session Tokens</a></li> |
<li><a href="#httpd">httpd</a> |
<li><a href="#webdav">WebDAV Session Tokens</a></li> |
<li><a href="#lonsql">lonsql</a> |
<li><a href="#httpd">httpd</a></li> |
<li><a href="#lond">lond</a> |
<li><a href="#lonsql">lonsql</a></li> |
<li><a href="#lonc">lonc</a> |
<li><a href="#lond">lond</a></li> |
<li><a href="#lonnet">lonnet</a> |
<li><a href="#lonc">lonc</a></li> |
<li><a href="#connections">Connections</a> |
<li><a href="#lonnet">lonnet</a></li> |
<li><a href="#delayed">Delayed Messages</a> |
<li><a href="#connections">Connections</a></li> |
<li><a href="#errcount">Error Count</a> |
<li><a href="#bashconf">bash readline config</a></li> |
|
<li><a href="#delayed">Delayed Messages</a></li> |
|
<li><a href="#errcount">Error Count</a></li> |
</ol> |
</ol> |
<hr> |
<hr /> |
<a name="configuration"> |
<a name="configuration" /> |
<h2>Configuration</h2> |
<h2>Configuration</h2> |
<h3>PerlVars</h3> |
<h3>PerlVars</h3> |
<table border=2> |
<table border="2"> |
ENDHEADERS |
ENDHEADERS |
|
|
foreach $varname (keys %perlvar) { |
foreach my $varname (sort(keys(%perlvar))) { |
print $fh "<tr><td>$varname</td><td>$perlvar{$varname}</td></tr>\n"; |
&log($fh,"<tr><td>$varname</td><td>". |
} |
&encode_entities($perlvar{$varname},'<>&"')."</td></tr>\n"); |
print $fh "</table><h3>Hosts</h3><table border=2>"; |
} |
foreach $id (keys %hostname) { |
&log($fh,"</table><h3>Hosts</h3><table border='2'>"); |
print $fh |
my %hostname = &Apache::lonnet::all_hostnames(); |
"<tr><td>$id</td><td>$hostdom{$id}</td><td>$hostrole{$id}</td>"; |
foreach my $id (sort(keys(%hostname))) { |
print $fh "<td>$hostname{$id}</td><td>$hostip{$id}</td></tr>\n"; |
my $role = (&Apache::lonnet::is_library($id) ? 'library' |
} |
: 'access'); |
print $fh "</table><h3>Spare Hosts</h3><ol>"; |
&log($fh, |
foreach $id (keys %spareid) { |
"<tr><td>$id</td><td>".&Apache::lonnet::host_domain($id). |
print $fh "<li>$id\n"; |
"</td><td>".$role. |
|
"</td><td>".&Apache::lonnet::hostname($id)."</td></tr>\n"); |
|
} |
|
&log($fh,"</table><h3>Spare Hosts</h3>"); |
|
if (keys(%Apache::lonnet::spareid) > 0) { |
|
&log($fh,"<ul>"); |
|
foreach my $type (sort(keys(%Apache::lonnet::spareid))) { |
|
&log($fh,"<li>$type\n<ol>"); |
|
foreach my $id (@{ $Apache::lonnet::spareid{$type} }) { |
|
&log($fh,"<li>$id</li>\n"); |
|
} |
|
&log($fh,"</ol>\n</li>\n"); |
|
} |
|
&log($fh,"</ul>\n"); |
|
} else { |
|
&log($fh,"No spare hosts specified<br />\n"); |
|
} |
|
return $fh; |
} |
} |
|
|
print $fh "</ol>\n"; |
# --------------------------------------------------------------- clean out tmp |
|
sub clean_tmp { |
# --------------------------------------------------------------------- Machine |
my ($fh)=@_; |
|
&log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>'); |
|
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}):<ul><li>". |
|
join('</li><li><tt>',@{$errors{$key}}).'</tt></li></ul><br />'); |
|
} |
|
} |
|
} |
|
} |
|
|
print $fh '<hr><a name="machine"><h2>Machine Information</h2>'; |
sub recursive_clean_tmp { |
print $fh "<h3>loadavg</h3>"; |
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=<PROBE>; |
|
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); |
|
} |
|
return ($cleaned,$old,$removed); |
|
} |
|
|
open (LOADAVGH,"/proc/loadavg"); |
# ------------------------------------------------------------ clean out lonIDs |
$loadavg=<LOADAVGH>; |
sub clean_lonIDs { |
close (LOADAVGH); |
my ($fh)=@_; |
|
&log($fh,'<hr /><a name="tokens" /><h2>Session Tokens</h2>'); |
|
my $cleaned=0; |
|
my $active=0; |
|
while (my $fname=<$perlvar{'lonIDsDir'}/*>) { |
|
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<br />"); |
|
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<br />"); |
|
} |
|
} else { |
|
$active++; |
|
} |
|
} |
|
} |
|
&log($fh,"<p>Cleaned up ".$cleaned." stale session token(s).</p>"); |
|
&log($fh,"<h3>$active open session(s)</h3>"); |
|
} |
|
|
print $fh "<tt>$loadavg</tt>"; |
# -------------------------------------------------------- clean out balanceIDs |
|
|
@parts=split(/\s+/,$loadavg); |
sub clean_balanceIDs { |
if ($parts[1]>4.0) { |
my ($fh)=@_; |
$errors++; |
&log($fh,'<hr /><a name="balcookies" /><h2>Session Tokens</h2>'); |
} elsif ($parts[1]>2.0) { |
my $cleaned=0; |
$warnings++; |
my $active=0; |
} elsif ($parts[1]>1.0) { |
if (-d $perlvar{'lonBalanceDir'}) { |
$notices++; |
while (my $fname=<$perlvar{'lonBalanceDir'}/*.id>) { |
} |
my ($dev,$ino,$mode,$nlink, |
|
$uid,$gid,$rdev,$size, |
print $fh "<h3>df</h3>"; |
$atime,$mtime,$ctime, |
print $fh "<pre>"; |
$blksize,$blocks)=stat($fname); |
|
my $now=time; |
open (DFH,"df|"); |
my $since=$now-$mtime; |
while ($line=<DFH>) { |
if ($since>$perlvar{'lonExpire'}) { |
print $fh "$line"; |
$cleaned++; |
@parts=split(/\s+/,$line); |
&log($fh,"Unlinking $fname<br />"); |
$usage=$parts[4]; |
unlink("$fname"); |
$usage=~s/\W//g; |
} else { |
if ($usage>90) { |
$active++; |
$warnings++; |
} |
$notices++; |
} |
} elsif ($usage>80) { |
} |
$warnings++; |
&log($fh,"<p>Cleaned up ".$cleaned." stale balancer files</p>"); |
} elsif ($usage>60) { |
&log($fh,"<h3>$active unexpired balancer files</h3>"); |
$notices++; |
|
} |
|
if ($usage>95) { $warnings++; $warnings++ } |
|
} |
|
close (DFH); |
|
print $fh "</pre>"; |
|
|
|
|
|
print $fh "<h3>ps</h3>"; |
|
print $fh "<pre>"; |
|
$psproc=0; |
|
|
|
open (PSH,"ps -aux|"); |
|
while ($line=<PSH>) { |
|
print $fh "$line"; |
|
$psproc++; |
|
} |
} |
close (PSH); |
|
print $fh "</pre>"; |
|
|
|
if ($psproc>200) { $notices++; } |
# ------------------------------------------------ clean out webDAV Session IDs |
if ($psproc>250) { $notices++; } |
sub clean_webDAV_sessionIDs { |
|
my ($fh)=@_; |
|
if ($perlvar{'lonRole'} eq 'library') { |
|
&log($fh,'<hr /><a name="webdav" /><h2>WebDAV Session Tokens</h2>'); |
|
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<br />"); |
|
unlink("$fname"); |
|
} else { |
|
$active++; |
|
} |
|
} |
|
&log($fh,"<p>Cleaned up ".$cleaned." stale webDAV session token(s).</p>"); |
|
&log($fh,"<h3>$active open webDAV session(s)</h3>"); |
|
} |
|
} |
|
} |
|
|
&errout($fh); |
# ------------------------------------------------------------ clean out ltiIDs |
|
|
# --------------------------------------------------------------- clean out tmp |
sub clean_ltiIDs { |
print $fh '<hr><a name="tmp"><h2>Temporary Files</h2>'; |
my ($fh)=@_; |
$cleaned=0; |
&log($fh,'<hr /><a name="ltisessions" /><h2>LTI Session Pointers</h2>'); |
while ($fname=<$perlvar{'lonDaemons'}/tmp/*>) { |
my $cleaned=0; |
my ($dev,$ino,$mode,$nlink, |
my $active=0; |
$uid,$gid,$rdev,$size, |
if (-d $perlvar{'ltiIDsDir'}) { |
$atime,$mtime,$ctime, |
while (my $fname=<$perlvar{'ltiIDsDir'}/*>) { |
$blksize,$blocks)=stat($fname); |
my ($dev,$ino,$mode,$nlink, |
$now=time; |
$uid,$gid,$rdev,$size, |
$since=$now-$mtime; |
$atime,$mtime,$ctime, |
if ($since>$perlvar{'lonExpire'}) { |
$blksize,$blocks)=stat($fname); |
$cleaned++; |
my $now=time; |
unlink("$fname"); |
my $since=$now-$mtime; |
} |
if ($since>$perlvar{'lonExpire'}) { |
|
$cleaned++; |
|
&log($fh,"Unlinking $fname<br />"); |
|
unlink("$fname"); |
|
} else { |
|
$active++; |
|
} |
|
} |
|
} |
|
&log($fh,"<p>Cleaned up ".$cleaned." old LTI session pointers.</p>"); |
|
&log($fh,"<h3>$active unexpired LTI session pointers</h3>"); |
} |
} |
print $fh "Cleaned up ".$cleaned." files."; |
|
|
|
# ------------------------------------------------------------ clean out lonIDs |
# ----------------------------------------------------------- clean out sockets |
print $fh '<hr><a name="tokens"><h2>Session Tokens</h2>'; |
sub clean_sockets { |
$cleaned=0; |
my ($fh)=@_; |
$active=0; |
my $cleaned=0; |
while ($fname=<$perlvar{'lonIDsDir'}/*>) { |
opendir(SOCKETS,$perlvar{'lonSockDir'}); |
my ($dev,$ino,$mode,$nlink, |
while (my $fname=readdir(SOCKETS)) { |
$uid,$gid,$rdev,$size, |
next if (-d $fname |
$atime,$mtime,$ctime, |
|| $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/); |
$blksize,$blocks)=stat($fname); |
$cleaned++; |
$now=time; |
&log($fh,"Unlinking $fname<br />"); |
$since=$now-$mtime; |
unlink("/home/httpd/sockets/$fname"); |
if ($since>$perlvar{'lonExpire'}) { |
} |
$cleaned++; |
&log($fh,"<p>Cleaned up ".$cleaned." stale sockets.</p>"); |
print $fh "Unlinking $fname<br>"; |
|
unlink("$fname"); |
|
} else { |
|
$active++; |
|
} |
|
|
|
} |
} |
print $fh "<p>Cleaned up ".$cleaned." stale session token(s)."; |
|
print $fh "<h3>$active open session(s)</h3>"; |
|
|
|
# ----------------------------------------------------------------------- httpd |
# ----------------------------------------------------------------------- httpd |
|
sub check_httpd_logs { |
|
my ($fh)=@_; |
|
if (open(PIPE,"./lchttpdlogs|")) { |
|
while (my $line=<PIPE>) { |
|
&log($fh,$line); |
|
if ($line=~/\[error\]/) { $notices++; } |
|
} |
|
close(PIPE); |
|
} |
|
&errout($fh); |
|
} |
|
|
print $fh '<hr><a name="httpd"><h2>httpd</h2><h3>Access Log</h3><pre>'; |
# ---------------------------------------------------------------------- lonnet |
|
|
open (DFH,"tail -n25 /etc/httpd/logs/access_log|"); |
sub rotate_lonnet_logs { |
while ($line=<DFH>) { print $fh "$line" }; |
my ($fh)=@_; |
close (DFH); |
&log($fh,'<hr /><a name="lonnet" /><h2>lonnet</h2><h3>Temp Log</h3><pre>'); |
|
print "Checking logs.\n"; |
print $fh "</pre><h3>Error Log</h3><pre>"; |
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){ |
|
open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|"); |
open (DFH,"tail -n25 /etc/httpd/logs/error_log|"); |
while (my $line=<DFH>) { |
while ($line=<DFH>) { |
&log($fh,&encode_entities($line,'<>&"')); |
print $fh "$line"; |
} |
if ($line=~/\[error\]/) { $notices++; } |
|
}; |
|
close (DFH); |
|
print $fh "</pre>"; |
|
&errout($fh); |
|
|
|
|
|
# ---------------------------------------------------------------------- lonsql |
|
|
|
my $restartflag=1; |
|
if ($perlvar{'lonRole'} eq "library") { |
|
|
|
print $fh '<hr><a name="lonsql"><h2>lonsql</h2><h3>Log</h3><pre>'; |
|
print "lonsql\n"; |
|
if (-e "$perlvar{'lonDaemons'}/logs/lonsql.log"){ |
|
open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonsql.log|"); |
|
while ($line=<DFH>) { |
|
print $fh "$line"; |
|
if ($line=~/INFO/) { $notices++; } |
|
if ($line=~/WARNING/) { $notices++; } |
|
if ($line=~/CRITICAL/) { $warnings++; } |
|
}; |
|
close (DFH); |
close (DFH); |
} |
} |
print $fh "</pre>"; |
&log($fh,"</pre><h3>Perm Log</h3><pre>"); |
|
|
my $lonsqlfile="$perlvar{'lonDaemons'}/logs/lonsql.pid"; |
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { |
|
open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|"); |
$restartflag=1; |
while (my $line=<DFH>) { |
|
&log($fh,&encode_entities($line,'<>&"')); |
if (-e $lonsqlfile) { |
|
my $lfh=IO::File->new("$lonsqlfile"); |
|
my $lonsqlpid=<$lfh>; |
|
chomp($lonsqlpid); |
|
if (kill 0 => $lonsqlpid) { |
|
print $fh "<h3>lonsql at pid $lonsqlpid responding</h3>"; |
|
$restartflag=0; |
|
} else { |
|
$errors++; $errors++; |
|
print $fh "<h3>lonsql at pid $lonsqlpid not responding</h3>"; |
|
$restartflag=1; |
|
print $fh |
|
"<h3>Decided to clean up stale .pid file and restart lonsql</h3>"; |
|
} |
} |
|
close (DFH); |
|
} else { &log($fh,"No perm log\n") } |
|
|
|
my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log"; |
|
&rotate_logfile($fname,$fh,'lonnet log'); |
|
|
|
&log($fh,"</pre>"); |
|
&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}); |
} |
} |
if ($restartflag==1) { |
} |
$errors++; |
|
print $fh '<br><font color="red">Killall lonsql: '. |
# ----------------------------------------------------------------- Connections |
system('killall lonsql').' - '; |
sub test_connections { |
sleep 60; |
my ($fh)=@_; |
print $fh unlink($lonsqlfile).' - '. |
&log($fh,'<hr /><a name="connections" /><h2>Connections</h2>'); |
system('killall -9 lonsql'). |
print "Testing connections.\n"; |
'</font><br>'; |
&log($fh,"<table border='2'>"); |
print $fh "<h3>lonsql not running, trying to start</h3>"; |
my ($good,$bad)=(0,0); |
system( |
my %hostname = &Apache::lonnet::all_hostnames(); |
"$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors"); |
foreach my $tryserver (sort(keys(%hostname))) { |
sleep 10; |
print("."); |
if (-e $lonsqlfile) { |
my $result; |
print $fh "Seems like it started ...<p>"; |
my $answer=&Apache::lonnet::reply("ping",$tryserver); |
my $lfh=IO::File->new("$lonsqlfile"); |
if ($answer eq "$tryserver:$perlvar{'lonHostID'}") { |
my $lonsqlpid=<$lfh>; |
$result="<b>ok</b>"; |
chomp($lonsqlpid); |
$good++; |
sleep 30; |
} else { |
if (kill 0 => $lonsqlpid) { |
$result=$answer; |
print $fh "<h3>lonsql at pid $lonsqlpid responding</h3>"; |
$warnings++; |
|
if ($answer eq 'con_lost') { |
|
$bad++; |
|
$warnings++; |
} else { |
} else { |
$errors++; $errors++; |
$good++; #self connection |
print $fh "<h3>lonsql at pid $lonsqlpid not responding</h3>"; |
|
print $fh "Give it one more try ...<p>"; |
|
system( |
|
"$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors"); |
|
sleep 10; |
|
} |
} |
} else { |
|
print $fh "Seems like that did not work!<p>"; |
|
$errors++; |
|
} |
|
if (-e "$perlvar{'lonDaemons'}/logs/lonsql.log"){ |
|
print $fh "<p><pre>"; |
|
open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonsql.log|"); |
|
while ($line=<DFH>) { |
|
print $fh "$line"; |
|
if ($line=~/WARNING/) { $notices++; } |
|
if ($line=~/CRITICAL/) { $notices++; } |
|
}; |
|
close (DFH); |
|
print $fh "</pre>"; |
|
} |
} |
|
if ($answer =~ /con_lost/) { print(" $tryserver down\n"); } |
|
&log($fh,"<tr><td>$tryserver</td><td>$result</td></tr>\n"); |
} |
} |
|
&log($fh,"</table>"); |
|
print "\n$good good, $bad bad connections\n"; |
|
&errout($fh); |
|
} |
|
|
$fname="$perlvar{'lonDaemons'}/logs/lonsql.log"; |
|
|
|
my ($dev,$ino,$mode,$nlink, |
# ------------------------------------------------------------ Delayed messages |
$uid,$gid,$rdev,$size, |
sub check_delayed_msg { |
$atime,$mtime,$ctime, |
my ($fh,$weightsref,$exclusionsref)=@_; |
$blksize,$blocks)=stat($fname); |
&log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>'); |
|
print "Checking buffers.\n"; |
|
|
|
&log($fh,'<h3>Scanning Permanent Log</h3>'); |
|
|
if ($size>40000) { |
my $unsend=0; |
print $fh "Rotating logs ...<p>"; |
my $ignored=0; |
rename("$fname.2","$fname.3"); |
|
rename("$fname.1","$fname.2"); |
my %hostname = &Apache::lonnet::all_hostnames(); |
rename("$fname","$fname.1"); |
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(); |
|
} |
} |
} |
|
|
&errout($fh); |
# |
} |
# For LON-CAPA 1.2.0 to 2.1.3 (release dates: 8/31/2004 and 3/31/2006) any |
# ------------------------------------------------------------------------ lond |
# 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). |
|
# |
|
|
|
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; |
|
} |
|
|
print $fh '<hr><a name="lond"><h2>lond</h2><h3>Log</h3><pre>'; |
if ($checkbackwards) { |
print "lond\n"; |
if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { |
|
while(my $line=<BW>) { |
|
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,"<b>Failed: $time, $dserv, $dcmd</b><br />"); |
|
$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,"<p>Unsend messages by node, active (undegraded) nodes in cluster</p>\n"); |
|
foreach my $key (sort(keys(%active))) { |
|
&log($fh,&encode_entities("$key => $active{$key}",'<>&"')."\n"); |
|
} |
|
} |
|
&log($fh,"<p>Total unsend messages: <b>$unsend</b> for ".scalar(keys(%active))." active (undegraded) nodes in cluster.</p>\n"); |
|
if (keys(%exclusions) > 0) { |
|
&log($fh,"<p>Total incomplete updates <b>$ignored</b> for ".scalar(keys(%exclusions))." degraded nodes in cluster.</p>\n"); |
|
} |
|
if ($retired) { |
|
&log($fh,"<p>Total unsent <b>$nodest</b> for $retired nodes no longer in cluster.</p>\n"); |
|
} |
|
if ($unsend > 0) { |
|
$warnings=$warnings+$weights{'U'}*$unsend; |
|
} |
|
} |
|
|
if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){ |
if ($unsend) { $simplestatus{'unsend'}=$unsend; } |
open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/lond.log|"); |
&log($fh,"<h3>Outgoing Buffer</h3>\n<pre>"); |
while ($line=<DFH>) { |
# list directory with delayed messages and remember offline servers |
print $fh "$line"; |
my %servers=(); |
if ($line=~/INFO/) { $notices++; } |
open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|"); |
if ($line=~/WARNING/) { $notices++; } |
while (my $line=<DFH>) { |
if ($line=~/CRITICAL/) { $warnings++; } |
my ($server)=($line=~/\.(\w+)$/); |
}; |
if ($server) { $servers{$server}=1; } |
close (DFH); |
&log($fh,&encode_entities($line,'<>&"')); |
} |
} |
print $fh "</pre>"; |
&log($fh,"</pre>\n"); |
|
|
my $londfile="$perlvar{'lonDaemons'}/logs/lond.pid"; |
|
|
|
$restartflag=1; |
|
if (-e $londfile) { |
|
my $lfh=IO::File->new("$londfile"); |
|
my $londpid=<$lfh>; |
|
chomp($londpid); |
|
if (kill 0 => $londpid) { |
|
print $fh "<h3>lond at pid $londpid responding, sending USR1</h3>"; |
|
kill USR1 => $londpid; |
|
$restartflag=0; |
|
} else { |
|
$errors++; |
|
print $fh "<h3>lond at pid $londpid not responding</h3>"; |
|
$restartflag=1; |
|
print $fh |
|
"<h3>Decided to clean up stale .pid file and restart lond</h3>"; |
|
} |
|
} |
|
if ($restartflag==1) { |
|
$errors++; |
|
print $fh '<br><font color="red">Killall lond: '. |
|
system('killall lond').' - '; |
|
sleep 60; |
|
print $fh unlink($londfile).' - '.system('killall -9 lond'). |
|
'</font><br>'; |
|
print $fh "<h3>lond not running, trying to start</h3>"; |
|
system( |
|
"$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors"); |
|
sleep 10; |
|
if (-e $londfile) { |
|
print $fh "Seems like it started ...<p>"; |
|
my $lfh=IO::File->new("$londfile"); |
|
my $londpid=<$lfh>; |
|
chomp($londpid); |
|
sleep 30; |
|
if (kill 0 => $londpid) { |
|
print $fh "<h3>lond at pid $londpid responding</h3>"; |
|
} else { |
|
$errors++; $errors++; |
|
print $fh "<h3>lond at pid $londpid not responding</h3>"; |
|
print $fh "Give it one more try ...<p>"; |
|
system( |
|
"$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors"); |
|
sleep 10; |
|
} |
|
} else { |
|
print $fh "Seems like that did not work!<p>"; |
|
$errors++; |
|
} |
|
if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){ |
|
print $fh "<p><pre>"; |
|
open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lond.log|"); |
|
while ($line=<DFH>) { |
|
print $fh "$line"; |
|
if ($line=~/WARNING/) { $notices++; } |
|
if ($line=~/CRITICAL/) { $notices++; } |
|
}; |
|
close (DFH); |
close (DFH); |
print $fh "</pre>"; |
# 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<br />"); |
|
print "Time out while contacting: $tryserver for pong.\n"; |
|
} else { |
|
&log($fh,"Pong to $tryserver: $answer<br />"); |
|
} |
|
} else { |
|
&log($fh,"$tryserver has delayed messages, but is not part of the cluster -- skipping 'Pong'.<br />"); |
|
} |
|
} |
} |
} |
|
|
$fname="$perlvar{'lonDaemons'}/logs/lond.log"; |
sub finish_logging { |
|
my ($fh,$weightsref)=@_; |
|
my %weights; |
|
if (ref($weightsref) eq 'HASH') { |
|
%weights = %{$weightsref}; |
|
} |
|
&log($fh,"<a name='errcount' />\n"); |
|
$totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors); |
|
&errout($fh); |
|
&log($fh,"<h1>Total Error Count: $totalcount</h1>"); |
|
my $now=time; |
|
my $date=localtime($now); |
|
&log($fh,"<hr />$date ($now)</body></html>\n"); |
|
print "lon-status webpage updated.\n"; |
|
$fh->close(); |
|
|
|
if ($errors) { $simplestatus{'errors'}=$errors; } |
|
if ($warnings) { $simplestatus{'warnings'}=$warnings; } |
|
if ($notices) { $simplestatus{'notices'}=$notices; } |
|
$simplestatus{'time'}=time; |
|
} |
|
|
my ($dev,$ino,$mode,$nlink, |
sub log_simplestatus { |
$uid,$gid,$rdev,$size, |
rename("$statusdir/newstatus.html","$statusdir/index.html"); |
$atime,$mtime,$ctime, |
|
$blksize,$blocks)=stat($fname); |
my $sfh=IO::File->new(">$statusdir/loncron_simple.txt"); |
|
if (defined($sfh)) { |
if ($size>40000) { |
foreach my $key (keys(%simplestatus)) { |
print $fh "Rotating logs ...<p>"; |
print $sfh $key.'='.$simplestatus{$key}.'&'; |
rename("$fname.2","$fname.3"); |
} |
rename("$fname.1","$fname.2"); |
print $sfh "\n"; |
rename("$fname","$fname.1"); |
$sfh->close(); |
} |
} else { |
|
print "Could not write to $statusdir/loncron_simple.txt\n"; |
&errout($fh); |
} |
# ------------------------------------------------------------------------ lonc |
|
|
|
print $fh '<hr><a name="lonc"><h2>lonc</h2><h3>Log</h3><pre>'; |
|
print "lonc\n"; |
|
|
|
if (-e "$perlvar{'lonDaemons'}/logs/lonc.log"){ |
|
open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/lonc.log|"); |
|
while ($line=<DFH>) { |
|
print $fh "$line"; |
|
if ($line=~/INFO/) { $notices++; } |
|
if ($line=~/WARNING/) { $notices++; } |
|
if ($line=~/CRITICAL/) { $warnings++; } |
|
}; |
|
close (DFH); |
|
} |
|
print $fh "</pre>"; |
|
|
|
my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; |
|
|
|
$restartflag=1; |
|
if (-e $loncfile) { |
|
my $lfh=IO::File->new("$loncfile"); |
|
my $loncpid=<$lfh>; |
|
chomp($loncpid); |
|
if (kill 0 => $loncpid) { |
|
print $fh "<h3>lonc at pid $loncpid responding, sending USR1</h3>"; |
|
kill USR1 => $loncpid; |
|
$restartflag=0; |
|
} else { |
|
$errors++; |
|
print $fh "<h3>lonc at pid $loncpid not responding</h3>"; |
|
# Solution: kill parent and children processes, remove .pid and restart |
|
$restartflag=1; |
|
print $fh |
|
"<h3>Decided to clean up stale .pid file and restart lonc</h3>"; |
|
} |
|
} |
|
if ($restartflag==1) { |
|
$errors++; |
|
print $fh '<br><font color="red">Killall lonc: '. |
|
system('killall lonc').' - '; |
|
sleep 60; |
|
print $fh unlink($loncfile).' - '.system('killall -9 lonc'). |
|
'</font><br>'; |
|
print $fh "<h3>lonc not running, trying to start</h3>"; |
|
system( |
|
"$perlvar{'lonDaemons'}/lonc 2>>$perlvar{'lonDaemons'}/logs/lonc_errors"); |
|
sleep 10; |
|
if (-e $loncfile) { |
|
print $fh "Seems like it started ...<p>"; |
|
my $lfh=IO::File->new("$loncfile"); |
|
my $loncpid=<$lfh>; |
|
chomp($loncpid); |
|
sleep 30; |
|
if (kill 0 => $loncpid) { |
|
print $fh "<h3>lonc at pid $loncpid responding</h3>"; |
|
} else { |
|
$errors++; $errors++; |
|
print $fh "<h3>lonc at pid $loncpid not responding</h3>"; |
|
print $fh "Give it one more try ...<p>"; |
|
system( |
|
"$perlvar{'lonDaemons'}/lonc 2>>$perlvar{'lonDaemons'}/logs/lonc_errors"); |
|
sleep 10; |
|
} |
|
} else { |
|
print $fh "Seems like that did not work!<p>"; |
|
$errors++; |
|
} |
|
if (-e "$perlvar{'lonDaemons'}/logs/lonc.log") { |
|
print $fh "<p><pre>"; |
|
open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonc.log|"); |
|
while ($line=<DFH>) { |
|
print $fh "$line"; |
|
if ($line=~/WARNING/) { $notices++; } |
|
if ($line=~/CRITICAL/) { $notices++; } |
|
}; |
|
close (DFH); |
|
print $fh "</pre>"; |
|
} |
|
} |
} |
|
|
$fname="$perlvar{'lonDaemons'}/logs/lonc.log"; |
sub write_loncaparevs { |
|
print "Retrieving LON-CAPA version information.\n"; |
|
my %hostname = &Apache::lonnet::all_hostnames(); |
|
my $output; |
|
foreach my $id (sort(keys(%hostname))) { |
|
if ($id ne '') { |
|
my $loncaparev; |
|
eval { |
|
local $SIG{ ALRM } = sub { die "TIMEOUT" }; |
|
alarm(10); |
|
$loncaparev = |
|
&Apache::lonnet::get_server_loncaparev('',$id,1,'loncron'); |
|
alarm(0); |
|
}; |
|
if ($@ && $@ =~ m/TIMEOUT/) { |
|
print "Time out while contacting lonHost: $id for version.\n"; |
|
} |
|
if ($loncaparev =~ /^[\w.\-]+$/) { |
|
$output .= $id.':'.$loncaparev."\n"; |
|
} |
|
} |
|
} |
|
if ($output) { |
|
if (open(my $fh,'>',"$perlvar{'lonTabDir'}/loncaparevs.tab")) { |
|
print $fh $output; |
|
close($fh); |
|
&Apache::lonnet::load_loncaparevs(); |
|
} else { |
|
print "Could not write to $perlvar{'lonTabDir'}/loncaparevs.tab\n"; |
|
} |
|
} |
|
return; |
|
} |
|
|
my ($dev,$ino,$mode,$nlink, |
sub write_serverhomeIDs { |
$uid,$gid,$rdev,$size, |
print "Retrieving LON-CAPA lonHostID information.\n"; |
$atime,$mtime,$ctime, |
my %name_to_host = &Apache::lonnet::all_names(); |
$blksize,$blocks)=stat($fname); |
my $output; |
|
foreach my $name (sort(keys(%name_to_host))) { |
|
if ($name ne '') { |
|
if (ref($name_to_host{$name}) eq 'ARRAY') { |
|
my $serverhomeID; |
|
eval { |
|
local $SIG{ ALRM } = sub { die "TIMEOUT" }; |
|
alarm(10); |
|
$serverhomeID = |
|
&Apache::lonnet::get_server_homeID($name,1,'loncron'); |
|
alarm(0); |
|
}; |
|
if ($@ && $@ =~ m/TIMEOUT/) { |
|
print "Time out while contacting server: $name\n"; |
|
} |
|
if ($serverhomeID ne '') { |
|
$output .= $name.':'.$serverhomeID."\n"; |
|
} else { |
|
$output .= $name.':'.$name_to_host{$name}->[0]."\n"; |
|
} |
|
} |
|
} |
|
} |
|
if ($output) { |
|
if (open(my $fh,'>',"$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { |
|
print $fh $output; |
|
close($fh); |
|
&Apache::lonnet::load_serverhomeIDs(); |
|
} else { |
|
print "Could not write to $perlvar{'lonTabDir'}/serverhomeIDs.tab\n"; |
|
} |
|
} |
|
return; |
|
} |
|
|
if ($size>40000) { |
sub write_checksums { |
print $fh "Rotating logs ...<p>"; |
my $distro = &LONCAPA::distro(); |
rename("$fname.2","$fname.3"); |
if ($distro) { |
rename("$fname.1","$fname.2"); |
print "Retrieving file version and checksumming.\n"; |
rename("$fname","$fname.1"); |
my $numchksums = 0; |
|
my ($chksumsref,$versionsref) = |
|
&LONCAPA::Checksumming::get_checksums($distro,$perlvar{'lonDaemons'}, |
|
$perlvar{'lonLib'}, |
|
$perlvar{'lonIncludes'}, |
|
$perlvar{'lonTabDir'}); |
|
if (ref($chksumsref) eq 'HASH') { |
|
$numchksums = scalar(keys(%{$chksumsref})); |
|
} |
|
print "File version retrieved and checksumming completed for $numchksums files.\n"; |
|
} else { |
|
print "File version retrieval and checksumming skipped - could not determine Linux distro.\n"; |
|
} |
|
return; |
} |
} |
|
|
|
sub write_hostips { |
&errout($fh); |
my $lontabdir = $perlvar{'lonTabDir'}; |
# ---------------------------------------------------------------------- lonnet |
my $defdom = $perlvar{'lonDefDomain'}; |
|
my $lonhost = $perlvar{'lonHostID'}; |
|
my $newfile = "$lontabdir/currhostips.tab"; |
|
my $oldfile = "$lontabdir/prevhostips.tab"; |
|
my (%prevhosts,%currhosts,%ipchange); |
|
if ((-e $newfile) && (-s $newfile)) { |
|
move($newfile,$oldfile); |
|
chmod(0644,$oldfile); |
|
if (open(my $fh,'<',$oldfile)) { |
|
while (my $line=<$fh>) { |
|
chomp($line); |
|
if ($line =~ /^([^:]+):([\d.]+)$/) { |
|
$prevhosts{$1} = $2; |
|
} |
|
} |
|
close($fh); |
|
} |
|
} |
|
my ($ip_info,$cached) = |
|
&Apache::lonnet::is_cached_new('iphost','iphost'); |
|
if (!$cached) { |
|
&Apache::lonnet::get_iphost(); |
|
($ip_info,$cached) = |
|
&Apache::lonnet::is_cached_new('iphost','iphost'); |
|
} |
|
if (ref($ip_info) eq 'ARRAY') { |
|
%currhosts = %{$ip_info->[1]}; |
|
if (open(my $fh,'>',$newfile)) { |
|
foreach my $key (keys(%currhosts)) { |
|
print $fh "$key:$currhosts{$key}\n"; |
|
} |
|
close($fh); |
|
chmod(0644,$newfile); |
|
} else { |
|
print "Could not write to $lontabdir/currhostips.tab\n"; |
|
} |
|
} |
|
if (keys(%prevhosts) && keys(%currhosts)) { |
|
foreach my $key (keys(%prevhosts)) { |
|
unless ($currhosts{$key} eq $prevhosts{$key}) { |
|
$ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key}; |
|
} |
|
} |
|
foreach my $key (keys(%currhosts)) { |
|
unless ($currhosts{$key} eq $prevhosts{$key}) { |
|
$ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key}; |
|
} |
|
} |
|
} |
|
if (&Apache::lonnet::domain($defdom,'primary') eq $lonhost) { |
|
if (keys(%ipchange)) { |
|
if (open(my $fh,'>>',$perlvar{'lonDaemons'}.'/logs/hostip.log')) { |
|
print $fh "********************\n".localtime(time).' Changes --'."\n". |
|
"| Hostname | Previous IP | New IP |\n". |
|
" --------------------------------- \n"; |
|
foreach my $hostname (sort(keys(%ipchange))) { |
|
print $fh "| $hostname | $ipchange{$hostname} |\n"; |
|
} |
|
print $fh "\n*******************\n\n"; |
|
close($fh); |
|
} else { |
|
print "Could not write to $perlvar{'lonDaemons'}/logs/hostip.log\n"; |
|
} |
|
my $emailto = &Apache::loncommon::build_recipient_list(undef, |
|
'hostipmail',$defdom); |
|
if ($emailto) { |
|
my $subject = "LON-CAPA Hostname to IP change ($perlvar{'lonHostID'})"; |
|
my $chgmail = "To: $emailto\n". |
|
"Subject: $subject\n". |
|
"Content-type: text/plain\; charset=UTF-8\n". |
|
"MIME-Version: 1.0\n\n". |
|
"Host/IP changes\n". |
|
" \n". |
|
"| Hostname | Previous IP | New IP |\n". |
|
" --------------------------------- \n"; |
|
foreach my $hostname (sort(keys(%ipchange))) { |
|
$chgmail .= "| $hostname | $ipchange{$hostname} |\n"; |
|
} |
|
$chgmail .= "\n\n"; |
|
if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) { |
|
print $mailh $chgmail; |
|
close($mailh); |
|
print "Sending mail notification of hostname/IP changes.\n"; |
|
} |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
print $fh '<hr><a name="lonnet"><h2>lonnet</h2><h3>Temp Log</h3><pre>'; |
sub clean_nosslverify { |
print "lonnet\n"; |
my ($fh) = @_; |
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){ |
my %unlinked; |
open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|"); |
if (-d "$perlvar{'lonSockDir'}/nosslverify") { |
while ($line=<DFH>) { |
if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) { |
print $fh "$line"; |
while (my $fname=readdir($dh)) { |
}; |
next if ($fname =~ /^\.+$/); |
close (DFH); |
if (unlink("/home/httpd/sockets/nosslverify/$fname")) { |
} |
&log($fh,"Unlinking $fname<br />"); |
print $fh "</pre><h3>Perm Log</h3><pre>"; |
$unlinked{$fname} = 1; |
|
} |
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { |
} |
open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|"); |
closedir($dh); |
while ($line=<DFH>) { |
} |
print $fh "$line"; |
} |
}; |
&log($fh,"<p>Removed ".scalar(keys(%unlinked))." nosslverify clients</p>"); |
close (DFH); |
return %unlinked; |
} else { print $fh "No perm log\n" } |
} |
|
sub clean_lonc_childpids { |
$fname="$perlvar{'lonDaemons'}/logs/lonnet.log"; |
my $childpiddir = "$perlvar{'lonDocRoot'}/lon-status/loncchld"; |
|
if (-d $childpiddir) { |
my ($dev,$ino,$mode,$nlink, |
if (opendir(my $dh,$childpiddir)) { |
$uid,$gid,$rdev,$size, |
while (my $fname=readdir($dh)) { |
$atime,$mtime,$ctime, |
next if ($fname =~ /^\.+$/); |
$blksize,$blocks)=stat($fname); |
unlink("$childpiddir/$fname"); |
|
} |
if ($size>40000) { |
closedir($dh); |
print $fh "Rotating logs ...<p>"; |
} |
rename("$fname.2","$fname.3"); |
} |
rename("$fname.1","$fname.2"); |
|
rename("$fname","$fname.1"); |
|
} |
} |
|
|
print $fh "</pre>"; |
sub write_connection_config { |
&errout($fh); |
my ($domconf,%connectssl,%changes); |
# ----------------------------------------------------------------- Connections |
$domconf = &get_domain_config(); |
|
if (ref($domconf) eq 'HASH') { |
|
if (ref($domconf->{'ssl'}) eq 'HASH') { |
|
foreach my $connect ('connto','connfrom') { |
|
if (ref($domconf->{'ssl'}->{$connect}) eq 'HASH') { |
|
my ($sslreq,$sslnoreq,$currsetting); |
|
my %contypes; |
|
foreach my $type ('dom','intdom','other') { |
|
$connectssl{$connect.'_'.$type} = $domconf->{'ssl'}->{$connect}->{$type}; |
|
} |
|
} |
|
} |
|
} |
|
if (keys(%connectssl)) { |
|
my %currconf; |
|
if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) { |
|
while (my $line = <$fh>) { |
|
chomp($line); |
|
my ($name,$value) = split(/=/,$line); |
|
if ($value =~ /^(?:no|yes|req)$/) { |
|
if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) { |
|
$currconf{$name} = $value; |
|
} |
|
} |
|
} |
|
close($fh); |
|
} |
|
if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) { |
|
my $count = 0; |
|
foreach my $key (sort(keys(%connectssl))) { |
|
print $fh "$key=$connectssl{$key}\n"; |
|
if (exists($currconf{$key})) { |
|
unless ($currconf{$key} eq $connectssl{$key}) { |
|
$changes{$key} = 1; |
|
} |
|
} else { |
|
$changes{$key} = 1; |
|
} |
|
$count ++; |
|
} |
|
close($fh); |
|
print "Completed writing SSL options for lonc/lond for $count items.\n"; |
|
} else { |
|
print "Could not write to $perlvar{'lonTabDir'}/connectionrules.tab\n"; |
|
} |
|
} else { |
|
print "Writing of SSL options skipped - no connection rules in domain configuration.\n"; |
|
} |
|
} else { |
|
print "Retrieval of SSL options for lonc/lond skipped - no configuration data available for domain.\n"; |
|
} |
|
return %changes; |
|
} |
|
|
print $fh '<hr><a name="connections"><h2>Connections</h2>'; |
sub get_domain_config { |
|
my ($dom,$primlibserv,$isprimary,$url,%confhash); |
|
$dom = $perlvar{'lonDefDomain'}; |
|
$primlibserv = &Apache::lonnet::domain($dom,'primary'); |
|
if ($primlibserv eq $perlvar{'lonHostID'}) { |
|
$isprimary = 1; |
|
} elsif ($primlibserv ne '') { |
|
my $protocol = $Apache::lonnet::protocol{$primlibserv}; |
|
my $hostname = &Apache::lonnet::hostname($primlibserv); |
|
unless ($protocol eq 'https') { |
|
$protocol = 'http'; |
|
} |
|
$url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl?primary='.$primlibserv.'&format=raw'; |
|
} |
|
if ($isprimary) { |
|
my $lonusersdir = $perlvar{'lonUsersDir'}; |
|
my $fname = $lonusersdir.'/'.$dom.'/configuration.db'; |
|
if (-e $fname) { |
|
my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER()); |
|
if (ref($dbref) eq 'HASH') { |
|
foreach my $key (sort(keys(%{$dbref}))) { |
|
my $value = $dbref->{$key}; |
|
if ($value =~ s/^__FROZEN__//) { |
|
$value = thaw(&LONCAPA::unescape($value)); |
|
} else { |
|
$value = &LONCAPA::unescape($value); |
|
} |
|
$confhash{$key} = $value; |
|
} |
|
&LONCAPA::locking_hash_untie($dbref); |
|
} |
|
} |
|
} else { |
|
my $request=new HTTP::Request('GET',$url); |
|
my $response=&LONCAPA::LWPReq::makerequest($primlibserv,$request,'',\%perlvar,5); |
|
unless ($response->is_error()) { |
|
my $content = $response->content; |
|
if ($content) { |
|
my @pairs=split(/\&/,$content); |
|
foreach my $item (@pairs) { |
|
my ($key,$value)=split(/=/,$item,2); |
|
my $what = &LONCAPA::unescape($key); |
|
if ($value =~ s/^__FROZEN__//) { |
|
$value = thaw(&LONCAPA::unescape($value)); |
|
} else { |
|
$value = &LONCAPA::unescape($value); |
|
} |
|
$confhash{$what}=$value; |
|
} |
|
} |
|
} |
|
} |
|
return \%confhash; |
|
} |
|
|
print $fh "<table border=2>"; |
sub write_hosttypes { |
foreach $tryserver (keys %hostname) { |
my %intdom = &Apache::lonnet::all_host_intdom(); |
|
my %hostdom = &Apache::lonnet::all_host_domain(); |
|
my $dom = $hostdom{$perlvar{'lonHostID'}}; |
|
my $internetdom = $intdom{$perlvar{'lonHostID'}}; |
|
my %changes; |
|
if (($dom ne '') && ($internetdom ne '')) { |
|
if (keys(%hostdom)) { |
|
my %currhosttypes; |
|
if (open(my $fh,'<',"$perlvar{'lonTabDir'}/hosttypes.tab")) { |
|
while (my $line = <$fh>) { |
|
chomp($line); |
|
my ($name,$value) = split(/:/,$line); |
|
if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) { |
|
$currhosttypes{$name} = $value; |
|
} |
|
} |
|
close($fh); |
|
} |
|
if (open(my $fh,'>',"$perlvar{'lonTabDir'}/hosttypes.tab")) { |
|
my $count = 0; |
|
foreach my $lonid (sort(keys(%hostdom))) { |
|
my $type = 'other'; |
|
if ($hostdom{$lonid} eq $dom) { |
|
$type = 'dom'; |
|
} elsif ($intdom{$lonid} eq $internetdom) { |
|
$type = 'intdom'; |
|
} |
|
print $fh "$lonid:$type\n"; |
|
if (exists($currhosttypes{$lonid})) { |
|
if ($type ne $currhosttypes{$lonid}) { |
|
$changes{$lonid} = 1; |
|
} |
|
} else { |
|
$changes{$lonid} = 1; |
|
} |
|
$count ++; |
|
} |
|
close($fh); |
|
print "Completed writing host type data for $count hosts.\n"; |
|
} else { |
|
print "Could not write to $perlvar{'lonTabDir'}/hosttypes.tab\n"; |
|
} |
|
} else { |
|
print "Writing of host types skipped - no hosts found.\n"; |
|
} |
|
} else { |
|
print "Writing of host types skipped - could not determine this host's LON-CAPA domain or 'internet' domain.\n"; |
|
} |
|
return %changes; |
|
} |
|
|
$answer=reply("pong",$tryserver); |
sub update_revocation_list { |
if ($answer eq "$tryserver:$perlvar{'lonHostID'}") { |
my ($result,$changed) = &Apache::lonnet::fetch_crl_pemfile(); |
$result="<b>ok</b>"; |
if ($result eq 'ok') { |
|
print "Certificate Revocation List (from CA) updated.\n"; |
} else { |
} else { |
$result=$answer; |
print "Certificate Revocation List from (CA) not updated.\n"; |
$warnings++; |
|
if ($answer eq 'con_lost') { $warnings++; } |
|
} |
} |
print $fh "<tr><td>$tryserver</td><td>$result</td></tr>\n"; |
return $changed; |
|
} |
|
|
|
sub reset_nosslverify_pids { |
|
my ($fh,%sslrem) = @_; |
|
&checkon_daemon($fh,'lond',40000,'USR2'); |
|
my $loncpidfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; |
|
my $loncppid; |
|
if ((-e $loncpidfile) && (open(my $pfh,'<',$loncpidfile))) { |
|
$loncppid=<$pfh>; |
|
chomp($loncppid); |
|
close($pfh); |
|
if ($loncppid =~ /^\d+$/) { |
|
my %pids_by_host; |
|
my $docdir = $perlvar{'lonDocRoot'}; |
|
if (-d "$docdir/lon-status/loncchld") { |
|
if (opendir(my $dh,"$docdir/lon-status/loncchld")) { |
|
while (my $file = readdir($dh)) { |
|
next if ($file =~ /^\./); |
|
if (open(my $fh,'<',"$docdir/lon-status/loncchld/$file")) { |
|
my $record = <$fh>; |
|
chomp($record); |
|
close($fh); |
|
my ($remotehost,$authmode) = split(/:/,$record); |
|
$pids_by_host{$remotehost}{$authmode}{$file} = 1; |
|
} |
|
} |
|
closedir($dh); |
|
if (keys(%pids_by_host)) { |
|
foreach my $host (keys(%pids_by_host)) { |
|
if ($sslrem{$host}) { |
|
if (ref($pids_by_host{$host}) eq 'HASH') { |
|
if (ref($pids_by_host{$host}{'insecure'}) eq 'HASH') { |
|
if (keys(%{$pids_by_host{$host}{'insecure'}})) { |
|
foreach my $pid (keys(%{$pids_by_host{$host}{'insecure'}})) { |
|
if (open(PIPE,"ps -o ppid= -p $pid |")) { |
|
my $ppid = <PIPE>; |
|
chomp($ppid); |
|
close(PIPE); |
|
$ppid =~ s/(^\s+|\s+$)//g; |
|
if (($ppid == $loncppid) && (kill 0 => $pid)) { |
|
kill QUIT => $pid; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return; |
} |
} |
print $fh "</table>"; |
|
|
|
&errout($fh); |
sub get_permcount_settings { |
# ------------------------------------------------------------ Delayed messages |
my ($domconf) = @_; |
|
my ($defaults,$names) = &Apache::loncommon::lon_status_items(); |
|
my (%weights,$threshold,$sysmail,$reportstatus,%exclusions); |
|
foreach my $type ('E','W','N','U') { |
|
$weights{$type} = $defaults->{$type}; |
|
} |
|
$threshold = $defaults->{'threshold'}; |
|
$sysmail = $defaults->{'sysmail'}; |
|
$reportstatus = 1; |
|
if (ref($domconf) eq 'HASH') { |
|
if (ref($domconf->{'contacts'}) eq 'HASH') { |
|
if ($domconf->{'contacts'}{'reportstatus'} == 0) { |
|
$reportstatus = 0; |
|
} |
|
if (ref($domconf->{'contacts'}{'lonstatus'}) eq 'HASH') { |
|
if (ref($domconf->{'contacts'}{'lonstatus'}{weights}) eq 'HASH') { |
|
foreach my $type ('E','W','N','U') { |
|
if (exists($domconf->{'contacts'}{'lonstatus'}{weights}{$type})) { |
|
$weights{$type} = $domconf->{'contacts'}{'lonstatus'}{weights}{$type}; |
|
} |
|
} |
|
} |
|
if (ref($domconf->{'contacts'}{'lonstatus'}{'excluded'}) eq 'ARRAY') { |
|
my @excluded = @{$domconf->{'contacts'}{'lonstatus'}{'excluded'}}; |
|
if (@excluded) { |
|
map { $exclusions{$_} = 1; } @excluded; |
|
} |
|
} |
|
if (exists($domconf->{'contacts'}{'lonstatus'}{'threshold'})) { |
|
$threshold = $domconf->{'contacts'}{'lonstatus'}{'threshold'}; |
|
} |
|
if (exists($domconf->{'contacts'}{'lonstatus'}{'sysmail'})) { |
|
$sysmail = $domconf->{'contacts'}{'lonstatus'}{'sysmail'}; |
|
} |
|
} |
|
} |
|
} |
|
return ($threshold,$sysmail,$reportstatus,\%weights,\%exclusions); |
|
} |
|
|
print $fh '<hr><a name="delayed"><h2>Delayed Messages</h2>'; |
sub read_serverhomeIDs { |
print "buffers\n"; |
my %server; |
|
if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") { |
|
if (open(my $fh,'<',"$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { |
|
while (<$fh>) { |
|
my($host,$id) = split(/:/); |
|
chomp($id); |
|
$server{$host} = $id; |
|
} |
|
close($fh); |
|
} |
|
} |
|
return %server; |
|
} |
|
|
|
sub check_bash_settings { |
|
my $distro = &LONCAPA::distro(); |
|
my ($check_bracketed_paste,$bracketed_warning); |
|
if ($distro =~ /^debian(\d+)$/) { |
|
if ($1 >= 12) { |
|
$check_bracketed_paste = 1; |
|
} |
|
} elsif ($distro =~ /^ubuntu(\d+)$/) { |
|
if ($1 >= 22) { |
|
$check_bracketed_paste = 1; |
|
} |
|
} elsif ($distro =~ /^(?:redhat|oracle|alma|rocky|centos-stream)(\d+)$/) { |
|
if ($1 >= 9) { |
|
$check_bracketed_paste = 1; |
|
} |
|
} elsif ($distro =~ /^fedora(\d+)/) { |
|
if ($1 >= 34) { |
|
$check_bracketed_paste = 1; |
|
} |
|
} |
|
if ($check_bracketed_paste) { |
|
if (open(PIPE,"bind -V 2>&1 | grep enable-bracketed-paste |")) { |
|
my $info = <PIPE>; |
|
chomp($info); |
|
my ($bracketed) = ($info =~ /^\Qenable-bracketed-paste\E\s+is\s+set\s+to\s+\W(on|off)\W$/); |
|
close(PIPE); |
|
if ($bracketed eq 'on') { |
|
$bracketed_warning = 1; |
|
} |
|
} else { |
|
print "Unable to check if bracketed paste is set to off for www user's shell\n"; |
|
} |
|
} |
|
return ($bracketed_warning,$check_bracketed_paste); |
|
} |
|
|
|
sub set_bracketed_paste_off { |
|
my $bash_www_cnf = '/home/www/.inputrc'; |
|
my $result; |
|
if (!-e $bash_www_cnf) { |
|
system("touch $bash_www_cnf"); |
|
if (open(my $cfh,'>',$bash_www_cnf)) { |
|
print $cfh <<'END'; |
|
$if R |
|
set enable-bracketed-paste off |
|
$endif |
|
|
|
$if maxima |
|
set enable-bracketed-paste off |
|
$endif |
|
END |
|
close($cfh); |
|
$result = "Updated $bash_www_cnf so enable-bracketed-paste is off for R bash shell"; |
|
} else { |
|
$result = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'"; |
|
} |
|
my $wwwuid = getpwnam('www'); |
|
my $wwwgid = getgrnam('www'); |
|
if ($wwwuid!=$<) { |
|
chown($wwwuid,$wwwgid,$bash_www_cnf); |
|
} |
|
} else { |
|
my (%bracketed_paste_on,%bracketed_paste_off,@preserve,$condition); |
|
$condition = ''; |
|
if (open(my $cfh,'<',$bash_www_cnf)) { |
|
while (my $line=<$cfh>) { |
|
chomp($line); |
|
if ($line =~ /^\$if\s+(\w+)\s*$/) { |
|
if ($1 eq 'R') { |
|
$condition = 'r'; |
|
} elsif ($1 eq 'maxima') { |
|
$condition = 'maxima'; |
|
} else { |
|
$condition = 'other'; |
|
} |
|
} elsif ($line =~ /^\$endif\s*$/) { |
|
$condition = ''; |
|
} |
|
if ($line =~ /^\s*set\s+enable\-bracketed\-paste\s+(off|on)\s*$/) { |
|
if ($1 eq 'off') { |
|
if ($condition ne '') { |
|
$bracketed_paste_off{$condition} = 1; |
|
} else { |
|
$bracketed_paste_off{all} = 1; |
|
} |
|
push(@preserve,$line); |
|
} else { |
|
if ($condition ne '') { |
|
$bracketed_paste_on{$condition} = 1; |
|
if (($condition eq 'r') || ($condition eq 'maxima')) { |
|
push(@preserve,' set enable-bracketed-paste off'); |
|
} else { |
|
push(@preserve,$line); |
|
} |
|
} else { |
|
$bracketed_paste_on{all} = 1; |
|
push(@preserve,$line); |
|
} |
|
} |
|
} else { |
|
push(@preserve,$line); |
|
} |
|
} |
|
close($cfh); |
|
} else { |
|
$result = "Could not open $bash_www_cnf to check if a value is included for 'enable-bracketed-paste'."; |
|
} |
|
if (($bracketed_paste_on{r} || $bracketed_paste_on{maxima}) || |
|
(!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r}) && |
|
!exists($bracketed_paste_off{maxima}) && !exists($bracketed_paste_on{maxima}))) { |
|
if (open(my $cfh,'>',$bash_www_cnf)) { |
|
if (@preserve) { |
|
foreach my $entry (@preserve) { |
|
print $cfh "$entry\n"; |
|
} |
|
if (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r})) { |
|
print $cfh <<'END'; |
|
$if R |
|
set enable-bracketed-paste off |
|
$endif |
|
END |
|
} |
|
if (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r})) { |
|
print $cfh <<'END'; |
|
$if maxima |
|
set enable-bracketed-paste off |
|
$endif |
|
END |
|
} |
|
} else { |
|
print $cfh <<'END'; |
|
$if R |
|
set enable-bracketed-paste off |
|
$endif |
|
|
|
$if maxima |
|
set enable-bracketed-paste off |
|
$endif |
|
END |
|
} |
|
close($cfh); |
|
$result = "Updated $bash_www_cnf"; |
|
} else { |
|
$result = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'"; |
|
} |
|
} else { |
|
$result = "No action needed; $bash_www_cnf already includes 'set enable-bracketed-paste to off'"; |
|
} |
|
} |
|
return $result; |
|
} |
|
|
print $fh '<h3>Scanning Permanent Log</h3>'; |
sub send_mail { |
|
my ($sysmail,$reportstatus) = @_; |
|
my $defdom = $perlvar{'lonDefDomain'}; |
|
my $origmail = $perlvar{'lonAdmEMail'}; |
|
my $emailto = &Apache::loncommon::build_recipient_list(undef, |
|
'lonstatusmail',$defdom,$origmail); |
|
if (($totalcount>$sysmail) && ($reportstatus)) { |
|
$emailto.=",$perlvar{'lonSysEMail'}"; |
|
} |
|
my $from; |
|
my $hostname=`/bin/hostname`; |
|
chop($hostname); |
|
$hostname=~s/[^\w\.]//g; |
|
if ($hostname) { |
|
$from = 'www@'.$hostname; |
|
} |
|
my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices"; |
|
my $loncronmail = "To: $emailto\n". |
|
"From: $from\n". |
|
"Subject: ".$subj."\n". |
|
"Content-type: text/html\; charset=UTF-8\n". |
|
"MIME-Version: 1.0\n\n"; |
|
if (open(my $fh,'<',$statusdir/index.html")) { |
|
while (<$fh>) { |
|
$loncronmail .= $_; |
|
} |
|
close($fh); |
|
} else { |
|
$loncronmail .= "Failed to read from http://$hostname/lon-status/index.html\n"; |
|
} |
|
$loncronmail .= "\n\n"; |
|
if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) { |
|
print $mailh $loncronmail; |
|
close($mailh); |
|
print "Sending mail.\n"; |
|
} else { |
|
print "Sending mail failed.\n"; |
|
} |
|
} |
|
|
$unsend=0; |
sub usage { |
{ |
print(<<USAGE); |
my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log"); |
loncron - housekeeping program that checks up on various parts of LON-CAPA |
while ($line=<$dfh>) { |
|
($time,$sdf,$dserv,$dcmd)=split(/:/,$line); |
Options: |
if ($sdf eq 'F') { |
--help Display |
$local=localtime($time); |
--noemail Do not send the status email |
print "<b>Failed: $time, $dserv, $dcmd</b><br>"; |
--justcheckconnections Only check the current status of the lonc/d |
$warnings++; |
connections, do not send emails do not |
} |
check if the daemons are running, do not |
if ($sdf eq 'S') { $unsend--; } |
generate lon-status |
if ($sdf eq 'D') { $unsend++; } |
--justcheckdaemons Only check that all of the Lon-CAPA daemons are |
} |
running, do not send emails do not |
} |
check the lonc/d connections, do not |
print $fh "Total unsend messages: <b>$unsend</b><p>\n"; |
generate lon-status |
$warnings=$warnings+5*$unsend; |
--justreload Only tell the daemons to reload the config files, |
|
do not send emails do not |
print $fh "<h3>Outgoing Buffer</h3>"; |
check if the daemons are running, do not |
|
generate lon-status |
open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|"); |
--justiptables Only update the dynamic iptables rules for the |
while ($line=<DFH>) { |
lond port; do not send emails, do not |
print $fh "$line<br>"; |
check if the daemons are running, do not |
}; |
generate lon-status |
close (DFH); |
USAGE |
|
|
# ------------------------------------------------------------------------- End |
|
print $fh "<a name=errcount>\n"; |
|
$totalcount=$notices+4*$warnings+100*$errors; |
|
&errout($fh); |
|
print $fh "<h1>Total Error Count: $totalcount</h1>"; |
|
$now=time; |
|
$date=localtime($now); |
|
print $fh "<hr>$date ($now)</body></html>\n"; |
|
print "writing done\n"; |
|
} |
|
|
|
rename ("$statusdir/newstatus.html","$statusdir/index.html"); |
|
|
|
if ($totalcount>200) { |
|
print "mailing\n"; |
|
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
|
$subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices"; |
|
system( |
|
"metasend -b -t $emailto -s '$subj' -f $statusdir/index.html -m text/html"); |
|
} |
} |
1; |
|
|
|
|
# ================================================================ Main Program |
|
sub main () { |
|
my ($help,$justcheckdaemons,$noemail,$justcheckconnections, |
|
$justreload,$justiptables); |
|
&GetOptions("help" => \$help, |
|
"justcheckdaemons" => \$justcheckdaemons, |
|
"noemail" => \$noemail, |
|
"justcheckconnections" => \$justcheckconnections, |
|
"justreload" => \$justreload, |
|
"justiptables" => \$justiptables |
|
); |
|
if ($help) { &usage(); return; } |
|
# --------------------------------- 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 |
|
chdir($perlvar{'lonDaemons'}); |
|
# --------------------------------------- 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"); |
|
my $emailto=$perlvar{'lonSysEMail'}; |
|
my $hostname = Sys::Hostname::FQDN::fqdn(); |
|
$hostname=~s/\.+/./g; |
|
$hostname=~s/\-+/-/g; |
|
$hostname=~s/[^\w\.-]//g; # make sure is safe to pass through shell |
|
my $subj="LON: Unconfigured machine $hostname"; |
|
system("echo 'Unconfigured machine $hostname.' |". |
|
" mail -s '$subj' $emailto > /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"); |
|
my $emailto="$perlvar{'lonAdmEMail'} $perlvar{'lonSysEMail'}"; |
|
my $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; |
|
system("echo 'User ID mismatch. loncron must be run as user www.' |". |
|
" mail -s '$subj' $emailto > /dev/null"); |
|
exit 1; |
|
} |
|
|
|
# -------------------------------------------- Force reload of host information |
|
my $nomemcache; |
|
if ($justcheckdaemons) { |
|
$nomemcache=1; |
|
my $memcachepidfile="$perlvar{'lonDaemons'}/logs/memcached.pid"; |
|
my $memcachepid; |
|
if (-e $memcachepidfile) { |
|
my $memfh=IO::File->new($memcachepidfile); |
|
$memcachepid=<$memfh>; |
|
chomp($memcachepid); |
|
if ($memcachepid =~ /^\d+$/ && kill 0 => $memcachepid) { |
|
undef($nomemcache); |
|
} |
|
} |
|
} |
|
if (!$justiptables) { |
|
&Apache::lonnet::load_hosts_tab(1,$nomemcache); |
|
&Apache::lonnet::load_domain_tab(1,$nomemcache); |
|
&Apache::lonnet::get_iphost(1,$nomemcache); |
|
} |
|
|
|
# ----------------------------------------- Force firewall update for lond port |
|
|
|
if ((!$justcheckdaemons) && (!$justreload)) { |
|
my $now = time; |
|
my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'. |
|
$now.$$.int(rand(10000)); |
|
if (open(my $fh,'>',"$tmpfile")) { |
|
my %iphosts = &Apache::lonnet::get_iphost(); |
|
foreach my $key (keys(%iphosts)) { |
|
print $fh "$key\n"; |
|
} |
|
close($fh); |
|
if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) { |
|
my $execpath = $perlvar{'lonDaemons'}.'/lciptables'; |
|
system("$execpath $tmpfile"); |
|
unlink('/tmp/lock_lciptables'); # Remove the lock file. |
|
} |
|
unlink($tmpfile); |
|
} |
|
} |
|
|
|
# ---------------------------------------------------------------- Start report |
|
|
|
$errors=0; |
|
$warnings=0; |
|
$notices=0; |
|
|
|
|
|
my $fh; |
|
if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) { |
|
$fh=&start_logging(); |
|
|
|
&log_machine_info($fh); |
|
&clean_tmp($fh); |
|
&clean_lonIDs($fh); |
|
&clean_balanceIDs($fh); |
|
&clean_webDAV_sessionIDs($fh); |
|
&clean_ltiIDs($fh); |
|
&check_httpd_logs($fh); |
|
&rotate_lonnet_logs($fh); |
|
&rotate_other_logs($fh); |
|
} |
|
if (!$justcheckconnections && !$justreload && !$justiptables) { |
|
&checkon_daemon($fh,'lonmemcached',40000); |
|
&checkon_daemon($fh,'lonsql',200000); |
|
if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') { |
|
&checkon_daemon($fh,'lond',40000,'USR2'); |
|
} |
|
&checkon_daemon($fh,'lonc',40000,'USR1'); |
|
&checkon_daemon($fh,'lonmaxima',40000); |
|
&checkon_daemon($fh,'lonr',40000); |
|
} |
|
if ($justreload) { |
|
&clean_nosslverify($fh); |
|
&write_connection_config(); |
|
&write_hosttypes(); |
|
&update_revocation_list(); |
|
&checkon_daemon($fh,'lond',40000,'USR2'); |
|
&checkon_daemon($fh,'lonc',40000,'USR2'); |
|
} |
|
if ($justcheckconnections) { |
|
&test_connections($fh); |
|
} |
|
if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) { |
|
my ($bracketed_warning,$check_bracketed_paste) = &check_bash_settings(); |
|
if ($check_bracketed_paste) { |
|
&log($fh,'<hr /><a name="bashconf" /><h2>bash readline config</h2><h3>Bracketed Paste</h3>'. |
|
'<p>Distros using bash readline library 8.1 or later need bracketed paste disabled for the R bash shell for the www user so R commands sent to lonr daemon will be processed.</p>'); |
|
my $bash_www_cnf = '/home/www/.inputrc'; |
|
my $non_empty_conffile; |
|
unless ($bracketed_warning) { |
|
if (-e $bash_www_cnf) { |
|
my $filesize = (stat($bash_www_cnf))[7]; |
|
if ($filesize > 0) { |
|
$non_empty_conffile = 1; |
|
} |
|
} |
|
} |
|
if (($bracketed_warning) || ($non_empty_conffile)) { |
|
my $bash_update = &set_bracketed_paste_off(); |
|
if ($bash_update) { |
|
&log($fh,'<p>'.$bash_update.'</p>'."\n"); |
|
} |
|
} else { |
|
&log($fh,'<p>No action needed; /home/www/.inputrc already set.</p>'."\n"); |
|
} |
|
} else { |
|
&log($fh,'<hr /><a name="bashconf" /><h2>bash readline config</h2><h3>Bracketed Paste</h3>'. |
|
'<p>No action needed for distros using pre-8.1 bash readline library</p>'."\n"); |
|
} |
|
my $domconf = &get_domain_config(); |
|
my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) = |
|
&get_permcount_settings($domconf); |
|
&check_delayed_msg($fh,$weightsref,$exclusionsref); |
|
&write_loncaparevs(); |
|
&write_serverhomeIDs(); |
|
&write_checksums(); |
|
&write_hostips(); |
|
my %sslrem = &clean_nosslverify($fh); |
|
my %conchgs = &write_connection_config(); |
|
my %hosttypechgs = &write_hosttypes(); |
|
my $hadcrlchg = &update_revocation_list(); |
|
if ((keys(%conchgs) > 0) || (keys(%hosttypechgs) > 0) || |
|
$hadcrlchg || (keys(%sslrem) > 0)) { |
|
&checkon_daemon($fh,'lond',40000,'USR2'); |
|
&reset_nosslverify_pids($fh,%sslrem); |
|
} |
|
&finish_logging($fh,$weightsref); |
|
&log_simplestatus(); |
|
if ($totalcount>$threshold && !$noemail) { &send_mail($sysmail,$reportstatus); } |
|
} |
|
} |
|
|
|
&main(); |
|
1; |
|
|