|
version 1.35, 2002/11/27 17:14:26
|
version 1.133, 2024/07/28 23:49:32
|
|
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 loncapa_apache.conf and loncapa.conf |
my $size=(stat($file))[7]; |
| my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
if ($size>40000) { |
| %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 |
sub start_daemon { |
| # I only test for one thing here (lonHostID). This is just a safeguard. |
my ($fh,$daemon,$pidfile,$args) = @_; |
| if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) { |
my $progname=$daemon; |
| print("Unconfigured machine.\n"); |
if ($daemon eq 'lonc') { |
| $emailto=$perlvar{'lonSysEMail'}; |
$progname='loncnew'; |
| $hostname=`/bin/hostname`; |
} |
| chop $hostname; |
my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors"; |
| $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell |
&rotate_logfile($error_fname,$fh,'error logs'); |
| $subj="LON: Unconfigured machine $hostname"; |
if ($daemon eq 'lonc') { |
| system("echo 'Unconfigured machine $hostname.' |\ |
&clean_sockets($fh); |
| mailto $emailto -s '$subj' > /dev/null"); |
} |
| exit 1; |
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; |
| } |
} |
| |
|
| # ----------------------------- Make sure this process is running from user=www |
sub checkon_daemon { |
| my $wwwid=getpwnam('www'); |
my ($fh,$daemon,$maxsize,$send,$args)=@_; |
| if ($wwwid!=$<) { |
|
| print("User ID mismatch. This program must be run as user 'www'\n"); |
my $result; |
| $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
&log($fh,'<hr /><a name="'.$daemon.'" /><h2>'.$daemon.'</h2><h3>Log</h3><p style="white-space: pre;"><tt>'); |
| $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; |
printf("%-15s ",$daemon); |
| system("echo 'User ID mismatch. loncron must be run as user www.' |\ |
if ($fh) { |
| mailto $emailto -s '$subj' > /dev/null"); |
if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){ |
| exit 1; |
if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) { |
| } |
while (my $line=<DFH>) { |
| |
&log($fh,"$line"); |
| # ------------------------------------------------------------- Read hosts file |
if ($line=~/INFO/) { $notices++; } |
| { |
if ($line=~/WARNING/) { $notices++; } |
| my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab"); |
if ($line=~/CRITICAL/) { $warnings++; } |
| |
} |
| while (my $configline=<$config>) { |
close (DFH); |
| my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline); |
} |
| if ($id && $domain && $role && $name && $ip) { |
} |
| $hostname{$id}=$name; |
&log($fh,"</tt></p>"); |
| $hostdom{$id}=$domain; |
} |
| $hostip{$id}=$ip; |
|
| $hostrole{$id}=$role; |
my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid"; |
| if ($domdescr) { $domaindescription{$domain}=$domdescr; } |
|
| if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) { |
my $restartflag=1; |
| $libserv{$id}=$name; |
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 { |
} else { |
| if ($configline) { |
$errors++; |
| # &logthis("Skipping hosts.tab line -$configline-"); |
&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; |
| } |
} |
| |
|
| # ------------------------------------------------------ Read spare server file |
# --------------------------------------------------------------------- Machine |
| { |
sub log_machine_info { |
| my $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab"); |
my ($fh)=@_; |
| |
&log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>'); |
| while (my $configline=<$config>) { |
&log($fh,"<h3>loadavg</h3>"); |
| chomp($configline); |
|
| if (($configline) && ($configline ne $perlvar{'lonHostID'})) { |
my $cpucount; |
| $spareid{$configline}=1; |
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>"); |
| |
|
| # ---------------------------------------------------------------- Start report |
my @parts=split(/\s+/,$loadavg); |
| |
if ($parts[1]>$loadtarget{'error'}) { |
| |
$errors++; |
| |
} elsif ($parts[1]>$loadtarget{'warn'}) { |
| |
$warnings++; |
| |
} elsif ($parts[1]>$loadtarget{'note'}) { |
| |
$notices++; |
| |
} |
| |
|
| $statusdir="/home/httpd/html/lon-status"; |
&log($fh,"<h3>df</h3>"); |
| |
&log($fh,"<pre>"); |
| |
|
| $errors=0; |
open (DFH,"df|"); |
| $warnings=0; |
while (my $line=<DFH>) { |
| $notices=0; |
&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; |
| |
|
| |
open (PSH,"ps aux --cols 140 |"); |
| |
while (my $line=<PSH>) { |
| |
&log($fh,&encode_entities($line,'<>&"')); |
| |
$psproc++; |
| |
} |
| |
close (PSH); |
| |
&log($fh,"</pre>"); |
| |
|
| print $fh (<<ENDHEADERS); |
if ($psproc>200) { $notices++; } |
| <html> |
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"); |
| |
my %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="#lonhttpd">lonhttpd</a> |
<li><a href="#lonc">lonc</a></li> |
| <li><a href="#lonnet">lonnet</a> |
<li><a href="#lonnet">lonnet</a></li> |
| <li><a href="#connections">Connections</a> |
<li><a href="#connections">Connections</a></li> |
| <li><a href="#delayed">Delayed Messages</a> |
<li><a href="#bashconf">bash readline config</a></li> |
| <li><a href="#errcount">Error Count</a> |
<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 (sort(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 (sort(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 (sort(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>'); |
| $old=0; |
my $cleaned=0; |
| while ($fname=<$perlvar{'lonDaemons'}/tmp/*>) { |
my $active=0; |
| my ($dev,$ino,$mode,$nlink, |
if (-d $perlvar{'ltiIDsDir'}) { |
| $uid,$gid,$rdev,$size, |
while (my $fname=<$perlvar{'ltiIDsDir'}/*>) { |
| $atime,$mtime,$ctime, |
my ($dev,$ino,$mode,$nlink, |
| $blksize,$blocks)=stat($fname); |
$uid,$gid,$rdev,$size, |
| $now=time; |
$atime,$mtime,$ctime, |
| $since=$now-$mtime; |
$blksize,$blocks)=stat($fname); |
| if ($since>$perlvar{'lonExpire'}) { |
my $now=time; |
| $line=''; |
my $since=$now-$mtime; |
| if (open(PROBE,$fname)) { |
if ($since>$perlvar{'lonExpire'}) { |
| $line=<PROBE>; |
$cleaned++; |
| close(PROBE); |
&log($fh,"Unlinking $fname<br />"); |
| } |
unlink("$fname"); |
| unless ($line=~/^CHECKOUTTOKEN\&/) { |
} else { |
| $cleaned++; |
$active++; |
| unlink("$fname"); |
} |
| } else { |
} |
| if ($since>365*$perlvar{'lonExpire'}) { |
} |
| $cleaned++; |
&log($fh,"<p>Cleaned up ".$cleaned." old LTI session pointers.</p>"); |
| unlink("$fname"); |
&log($fh,"<h3>$active unexpired LTI session pointers</h3>"); |
| } else { $old++; } |
|
| } |
|
| } |
|
| |
|
| } |
} |
| print $fh "Cleaned up ".$cleaned." files (".$old." old checkout tokens)."; |
|
| |
|
| # ------------------------------------------------------------ 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 2; |
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 2; |
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 2; |
} 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 2; |
|
| } |
} |
| } 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"; |
# ------------------------------------------------------------ Delayed messages |
| |
sub check_delayed_msg { |
| |
my ($fh,$weightsref,$exclusionsref)=@_; |
| |
&log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>'); |
| |
print "Checking buffers.\n"; |
| |
|
| |
&log($fh,'<h3>Scanning Permanent Log</h3>'); |
| |
|
| my ($dev,$ino,$mode,$nlink, |
my $unsend=0; |
| $uid,$gid,$rdev,$size, |
my $ignored=0; |
| $atime,$mtime,$ctime, |
|
| $blksize,$blocks)=stat($fname); |
|
| |
|
| if ($size>40000) { |
my %hostname = &Apache::lonnet::all_hostnames(); |
| print $fh "Rotating logs ...<p>"; |
my $numhosts = scalar(keys(%hostname)); |
| rename("$fname.2","$fname.3"); |
my $checkbackwards = 0; |
| rename("$fname.1","$fname.2"); |
my $checkfrom = 0; |
| rename("$fname","$fname.1"); |
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). |
| |
# |
| |
|
| print $fh '<hr><a name="lond"><h2>lond</h2><h3>Log</h3><pre>'; |
my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r"); |
| print "lond\n"; |
if (defined($dfh)) { |
| |
while (my $line=<$dfh>) { |
| |
my ($time,$sdf,$rest)=split(/:/,$line,3); |
| |
if ($time < 1541185772) { |
| |
$checkbackwards = 1; |
| |
} |
| |
last; |
| |
} |
| |
undef $dfh; |
| |
} |
| |
|
| if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){ |
if ($checkbackwards) { |
| open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/lond.log|"); |
if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { |
| while ($line=<DFH>) { |
while(my $line=<BW>) { |
| print $fh "$line"; |
if ($line =~ /\QLondTransaction=HASH\E[^:]+:update:/) { |
| if ($line=~/INFO/) { $notices++; } |
($checkfrom) = split(/:/,$line,2); |
| if ($line=~/WARNING/) { $notices++; } |
last; |
| if ($line=~/CRITICAL/) { $warnings++; } |
} |
| }; |
} |
| close (DFH); |
close(BW); |
| } |
} |
| print $fh "</pre>"; |
} |
| |
$dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r"); |
| my $londfile="$perlvar{'lonDaemons'}/logs/lond.pid"; |
if (defined($dfh)) { |
| |
while (my $line=<$dfh>) { |
| $restartflag=1; |
my ($time,$sdf,$rest)=split(/:/,$line,3); |
| if (-e $londfile) { |
next unless (($sdf eq 'F') || ($sdf eq 'S') || ($sdf eq 'D')); |
| my $lfh=IO::File->new("$londfile"); |
next if (($checkfrom) && ($time <= $checkfrom)); |
| my $londpid=<$lfh>; |
my ($dserv,$dcmd); |
| chomp($londpid); |
if ($sdf eq 'S') { |
| if (kill 0 => $londpid) { |
my ($serva,$cmda,$servb,$cmdb) = split(/:/,$rest); |
| print $fh "<h3>lond at pid $londpid responding, sending USR1</h3>"; |
if ($cmda eq 'sethost') { |
| kill USR1 => $londpid; |
chomp($cmdb); |
| $restartflag=0; |
$dcmd = $cmdb; |
| } else { |
} else { |
| $errors++; |
$dcmd = $cmda; |
| print $fh "<h3>lond at pid $londpid not responding</h3>"; |
} |
| $restartflag=1; |
if (($serva =~ /^LondTransaction/) || ($serva eq '')) { |
| print $fh |
unless (($servb eq '') || ($servb =~ m{^/})) { |
| "<h3>Decided to clean up stale .pid file and restart lond</h3>"; |
$dserv = $servb; |
| } |
} |
| } |
} else { |
| if ($restartflag==1) { |
$dserv = $serva; |
| $errors++; |
} |
| print $fh '<br><font color="red">Killall lond: '. |
} else { |
| system('killall lond').' - '; |
($dserv,$dcmd) = split(/:/,$rest); |
| sleep 2; |
} |
| print $fh unlink($londfile).' - '.system('killall -9 lond'). |
if ($sdf eq 'F') { |
| '</font><br>'; |
my $local=localtime($time); |
| print $fh "<h3>lond not running, trying to start</h3>"; |
&log($fh,"<b>Failed: $time, $dserv, $dcmd</b><br />"); |
| system( |
$warnings++; |
| "$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors"); |
} |
| sleep 2; |
next if ((($dserv eq '') || ($dcmd eq '')) && ($sdf ne 'F')); |
| if (-e $londfile) { |
if ($sdf eq 'S') { |
| print $fh "Seems like it started ...<p>"; |
if ($dcmd eq 'update') { |
| my $lfh=IO::File->new("$londfile"); |
if ($hostname{$dserv}) { |
| my $londpid=<$lfh>; |
if ($exclusions{$serverhomes{$hostname{$dserv}}}) { |
| chomp($londpid); |
$ignored --; |
| sleep 2; |
} else { |
| if (kill 0 => $londpid) { |
$unsend --; |
| print $fh "<h3>lond at pid $londpid responding</h3>"; |
} |
| } else { |
} |
| $errors++; $errors++; |
if (exists($bymachine{$dserv})) { |
| print $fh "<h3>lond at pid $londpid not responding</h3>"; |
$bymachine{$dserv} --; |
| print $fh "Give it one more try ...<p>"; |
} else { |
| system( |
$bymachine{$dserv} = -1; |
| "$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors"); |
} |
| sleep 2; |
} else { |
| } |
if ($hostname{$dserv}) { |
| } else { |
$unsend --; |
| print $fh "Seems like that did not work!<p>"; |
} |
| $errors++; |
} |
| } |
} elsif ($sdf eq 'D') { |
| if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){ |
if ($dcmd eq 'update') { |
| print $fh "<p><pre>"; |
if ($hostname{$dserv}) { |
| open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lond.log|"); |
if ($exclusions{$serverhomes{$hostname{$dserv}}}) { |
| while ($line=<DFH>) { |
$ignored ++; |
| print $fh "$line"; |
} else { |
| if ($line=~/WARNING/) { $notices++; } |
$unsend ++; |
| if ($line=~/CRITICAL/) { $notices++; } |
} |
| }; |
} |
| |
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 ($unsend) { $simplestatus{'unsend'}=$unsend; } |
| |
&log($fh,"<h3>Outgoing Buffer</h3>\n<pre>"); |
| |
# list directory with delayed messages and remember offline servers |
| |
my %servers=(); |
| |
open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|"); |
| |
while (my $line=<DFH>) { |
| |
my ($server)=($line=~/\.(\w+)$/); |
| |
if ($server) { $servers{$server}=1; } |
| |
&log($fh,&encode_entities($line,'<>&"')); |
| |
} |
| |
&log($fh,"</pre>\n"); |
| 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"); |
| |
foreach (keys %simplestatus) { |
| if ($size>40000) { |
print $sfh $_.'='.$simplestatus{$_}.'&'; |
| print $fh "Rotating logs ...<p>"; |
} |
| rename("$fname.2","$fname.3"); |
print $sfh "\n"; |
| rename("$fname.1","$fname.2"); |
$sfh->close(); |
| rename("$fname","$fname.1"); |
|
| } |
|
| |
|
| &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 2; |
|
| 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 2; |
|
| if (-e $loncfile) { |
|
| print $fh "Seems like it started ...<p>"; |
|
| my $lfh=IO::File->new("$loncfile"); |
|
| my $loncpid=<$lfh>; |
|
| chomp($loncpid); |
|
| sleep 2; |
|
| 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 2; |
|
| } |
|
| } 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(); |
| |
} |
| |
} |
| |
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 ($size>40000) { |
if ($name ne '') { |
| print $fh "Rotating logs ...<p>"; |
if (ref($name_to_host{$name}) eq 'ARRAY') { |
| rename("$fname.2","$fname.3"); |
my $serverhomeID; |
| rename("$fname.1","$fname.2"); |
eval { |
| rename("$fname","$fname.1"); |
local $SIG{ ALRM } = sub { die "TIMEOUT" }; |
| } |
alarm(10); |
| |
$serverhomeID = |
| |
&Apache::lonnet::get_server_homeID($name,1,'loncron'); |
| &errout($fh); |
alarm(0); |
| # -------------------------------------------------------------------- lonhttpd |
}; |
| |
if ($@ && $@ =~ m/TIMEOUT/) { |
| print $fh '<hr><a name="lonhttpd"><h2>lonhttpd</h2><h3>Log</h3><pre>'; |
print "Time out while contacting server: $name\n"; |
| print "lonhttpd\n"; |
} |
| |
if ($serverhomeID ne '') { |
| if (-e "$perlvar{'lonDaemons'}/logs/lonhttpd.log"){ |
$output .= $name.':'.$serverhomeID."\n"; |
| open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/lonhttpd.log|"); |
} else { |
| while ($line=<DFH>) { |
$output .= $name.':'.$name_to_host{$name}->[0]."\n"; |
| print $fh "$line"; |
} |
| if ($line=~/INFO/) { $notices++; } |
} |
| if ($line=~/WARNING/) { $notices++; } |
} |
| if ($line=~/CRITICAL/) { $warnings++; } |
} |
| }; |
if ($output) { |
| close (DFH); |
if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { |
| } |
print $fh $output; |
| print $fh "</pre>"; |
close($fh); |
| |
&Apache::lonnet::load_serverhomeIDs(); |
| my $lonhttpdfile="$perlvar{'lonDaemons'}/logs/lonhttpd.pid"; |
} |
| |
} |
| $restartflag=1; |
return; |
| if (-e $lonhttpdfile) { |
|
| my $lfh=IO::File->new("$lonhttpdfile"); |
|
| my $lonhttpdpid=<$lfh>; |
|
| chomp($lonhttpdpid); |
|
| if (kill 0 => $lonhttpdpid) { |
|
| print $fh "<h3>lonhttpd at pid $lonhttpdpid responding</h3>"; |
|
| $restartflag=0; |
|
| } else { |
|
| $errors++; |
|
| print $fh "<h3>lonhttpd at pid $lonhttpdpid 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 lonhttpd</h3>"; |
|
| } |
|
| } |
|
| if ($restartflag==1) { |
|
| $errors++; |
|
| print $fh '<br><font color="red">Killall lonhttpd: '. |
|
| system('killall lonhttpd').' - '; |
|
| sleep 2; |
|
| print $fh unlink($lonhttpdfile).' - '.system('killall -9 lonhttpd'). |
|
| '</font><br>'; |
|
| print $fh "<h3>lonhttpd not running, trying to start</h3>"; |
|
| system( |
|
| "$perlvar{'lonDaemons'}/lonhttpd 2>>$perlvar{'lonDaemons'}/logs/lonhttpd_errors"); |
|
| sleep 2; |
|
| if (-e $lonhttpdfile) { |
|
| print $fh "Seems like it started ...<p>"; |
|
| my $lfh=IO::File->new("$lonhttpdfile"); |
|
| my $lonhttpdpid=<$lfh>; |
|
| chomp($lonhttpdpid); |
|
| sleep 2; |
|
| if (kill 0 => $lonhttpdpid) { |
|
| print $fh "<h3>lonhttpd at pid $lonhttpdpid responding</h3>"; |
|
| } else { |
|
| $errors++; $errors++; |
|
| print $fh "<h3>lonhttpd at pid $lonhttpdpid not responding</h3>"; |
|
| print $fh "Give it one more try ...<p>"; |
|
| system( |
|
| "$perlvar{'lonDaemons'}/lonhttpd 2>>$perlvar{'lonDaemons'}/logs/lonhttpd_errors"); |
|
| sleep 2; |
|
| } |
|
| } else { |
|
| print $fh "Seems like that did not work!<p>"; |
|
| $errors++; |
|
| } |
|
| if (-e "$perlvar{'lonDaemons'}/logs/lonhttpd.log") { |
|
| print $fh "<p><pre>"; |
|
| open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonhttpd.log|"); |
|
| while ($line=<DFH>) { |
|
| print $fh "$line"; |
|
| if ($line=~/WARNING/) { $notices++; } |
|
| if ($line=~/CRITICAL/) { $notices++; } |
|
| }; |
|
| close (DFH); |
|
| print $fh "</pre>"; |
|
| } |
|
| } |
} |
| |
|
| $fname="$perlvar{'lonDaemons'}/logs/lonhttpd.log"; |
sub write_checksums { |
| |
my $distro = &LONCAPA::distro(); |
| |
if ($distro) { |
| |
print "Retrieving file version and checksumming.\n"; |
| |
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; |
| |
} |
| |
|
| my ($dev,$ino,$mode,$nlink, |
sub write_hostips { |
| $uid,$gid,$rdev,$size, |
my $lontabdir = $perlvar{'lonTabDir'}; |
| $atime,$mtime,$ctime, |
my $defdom = $perlvar{'lonDefDomain'}; |
| $blksize,$blocks)=stat($fname); |
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); |
| |
} |
| |
} |
| |
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); |
| |
} |
| |
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; |
| |
} |
| |
|
| if ($size>40000) { |
sub clean_nosslverify { |
| print $fh "Rotating logs ...<p>"; |
my ($fh) = @_; |
| rename("$fname.2","$fname.3"); |
my %unlinked; |
| rename("$fname.1","$fname.2"); |
if (-d "$perlvar{'lonSockDir'}/nosslverify") { |
| rename("$fname","$fname.1"); |
if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) { |
| |
while (my $fname=readdir($dh)) { |
| |
next if ($fname =~ /^\.+$/); |
| |
if (unlink("/home/httpd/sockets/nosslverify/$fname")) { |
| |
&log($fh,"Unlinking $fname<br />"); |
| |
$unlinked{$fname} = 1; |
| |
} |
| |
} |
| |
closedir($dh); |
| |
} |
| |
} |
| |
&log($fh,"<p>Removed ".scalar(keys(%unlinked))." nosslverify clients</p>"); |
| |
return %unlinked; |
| |
} |
| |
sub clean_lonc_childpids { |
| |
my $childpiddir = "$perlvar{'lonDocRoot'}/lon-status/loncchld"; |
| |
if (-d $childpiddir) { |
| |
if (opendir(my $dh,$childpiddir)) { |
| |
while (my $fname=readdir($dh)) { |
| |
next if ($fname =~ /^\.+$/); |
| |
unlink("$childpiddir/$fname"); |
| |
} |
| |
closedir($dh); |
| |
} |
| |
} |
| } |
} |
| |
|
| |
sub write_connection_config { |
| &errout($fh); |
my ($domconf,%connectssl,%changes); |
| # ---------------------------------------------------------------------- lonnet |
$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 "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="lonnet"><h2>lonnet</h2><h3>Temp Log</h3><pre>'; |
sub get_domain_config { |
| print "lonnet\n"; |
my ($dom,$primlibserv,$isprimary,$url,%confhash); |
| if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){ |
$dom = $perlvar{'lonDefDomain'}; |
| open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|"); |
$primlibserv = &Apache::lonnet::domain($dom,'primary'); |
| while ($line=<DFH>) { |
if ($primlibserv eq $perlvar{'lonHostID'}) { |
| print $fh "$line"; |
$isprimary = 1; |
| }; |
} elsif ($primlibserv ne '') { |
| close (DFH); |
my $protocol = $Apache::lonnet::protocol{$primlibserv}; |
| } |
my $hostname = &Apache::lonnet::hostname($primlibserv); |
| print $fh "</pre><h3>Perm Log</h3><pre>"; |
unless ($protocol eq 'https') { |
| |
$protocol = 'http'; |
| if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { |
} |
| open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|"); |
$url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl?primary='.$primlibserv.'&format=raw'; |
| while ($line=<DFH>) { |
} |
| print $fh "$line"; |
if ($isprimary) { |
| }; |
my $lonusersdir = $perlvar{'lonUsersDir'}; |
| close (DFH); |
my $fname = $lonusersdir.'/'.$dom.'/configuration.db'; |
| } else { print $fh "No perm log\n" } |
if (-e $fname) { |
| |
my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER()); |
| $fname="$perlvar{'lonDaemons'}/logs/lonnet.log"; |
if (ref($dbref) eq 'HASH') { |
| |
foreach my $key (sort(keys(%{$dbref}))) { |
| my ($dev,$ino,$mode,$nlink, |
my $value = $dbref->{$key}; |
| $uid,$gid,$rdev,$size, |
if ($value =~ s/^__FROZEN__//) { |
| $atime,$mtime,$ctime, |
$value = thaw(&LONCAPA::unescape($value)); |
| $blksize,$blocks)=stat($fname); |
} else { |
| |
$value = &LONCAPA::unescape($value); |
| if ($size>40000) { |
} |
| print $fh "Rotating logs ...<p>"; |
$confhash{$key} = $value; |
| rename("$fname.2","$fname.3"); |
} |
| rename("$fname.1","$fname.2"); |
&LONCAPA::locking_hash_untie($dbref); |
| rename("$fname","$fname.1"); |
} |
| |
} |
| |
} 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 "</pre>"; |
sub write_hosttypes { |
| &errout($fh); |
my %intdom = &Apache::lonnet::all_host_intdom(); |
| # ----------------------------------------------------------------- Connections |
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 "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; |
| |
} |
| |
|
| print $fh '<hr><a name="connections"><h2>Connections</h2>'; |
sub update_revocation_list { |
| |
my ($result,$changed) = &Apache::lonnet::fetch_crl_pemfile(); |
| |
if ($result eq 'ok') { |
| |
print "Certificate Revocation List (from CA) updated.\n"; |
| |
} else { |
| |
print "Certificate Revocation List from (CA) not updated.\n"; |
| |
} |
| |
return $changed; |
| |
} |
| |
|
| print $fh "<table border=2>"; |
sub reset_nosslverify_pids { |
| foreach $tryserver (sort(keys(%hostname))) { |
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; |
| |
} |
| |
|
| $answer=reply("pong",$tryserver); |
sub get_permcount_settings { |
| if ($answer eq "$tryserver:$perlvar{'lonHostID'}") { |
my ($domconf) = @_; |
| $result="<b>ok</b>"; |
my ($defaults,$names) = &Apache::loncommon::lon_status_items(); |
| } else { |
my (%weights,$threshold,$sysmail,$reportstatus,%exclusions); |
| $result=$answer; |
foreach my $type ('E','W','N','U') { |
| $warnings++; |
$weights{$type} = $defaults->{$type}; |
| if ($answer eq 'con_lost') { $warnings++; } |
} |
| |
$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'}; |
| |
} |
| |
} |
| |
} |
| } |
} |
| print $fh "<tr><td>$tryserver</td><td>$result</td></tr>\n"; |
return ($threshold,$sysmail,$reportstatus,\%weights,\%exclusions); |
| |
} |
| |
|
| |
sub read_serverhomeIDs { |
| |
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; |
| } |
} |
| print $fh "</table>"; |
|
| |
|
| &errout($fh); |
sub check_bash_settings { |
| # ------------------------------------------------------------ Delayed messages |
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); |
| |
} |
| |
|
| print $fh '<hr><a name="delayed"><h2>Delayed Messages</h2>'; |
sub set_bracketed_paste_off { |
| print "buffers\n"; |
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; |
| |
|
![[BACK]](/icons/back.gif){kind=icon}
Return to loncron CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom