--- loncom/loncron 2020/01/11 21:54:31 1.120
+++ loncom/loncron 2024/07/10 04:10:35 1.131
@@ -2,7 +2,7 @@
# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# $Id: loncron,v 1.120 2020/01/11 21:54:31 raeburn Exp $
+# $Id: loncron,v 1.131 2024/07/10 04:10:35 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -42,10 +42,12 @@ use IO::File;
use IO::Socket;
use HTML::Entities;
use Getopt::Long;
-use GDBM_File;
+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);
@@ -78,14 +80,14 @@ sub rotate_logfile {
rename("$file.2","$file.3");
rename("$file.1","$file.2");
rename("$file","$file.1");
- }
+ }
}
sub start_daemon {
my ($fh,$daemon,$pidfile,$args) = @_;
my $progname=$daemon;
if ($daemon eq 'lonc') {
- $progname='loncnew';
+ $progname='loncnew';
}
my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
&rotate_logfile($error_fname,$fh,'error logs');
@@ -119,7 +121,7 @@ sub checkon_daemon {
if ($fh) {
if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
- while (my $line=<DFH>) {
+ while (my $line=<DFH>) {
&log($fh,"$line");
if ($line=~/INFO/) { $notices++; }
if ($line=~/WARNING/) { $notices++; }
@@ -130,9 +132,9 @@ sub checkon_daemon {
}
&log($fh,"</tt></p>");
}
-
+
my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";
-
+
my $restartflag=1;
my $daemonpid;
if (-e $pidfile) {
@@ -215,7 +217,7 @@ sub checkon_daemon {
}
}
}
-
+
my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
&rotate_logfile($fname,$fh,'logs');
@@ -228,19 +230,34 @@ 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>");
-
+
my @parts=split(/\s+/,$loadavg);
- if ($parts[1]>4.0) {
+ if ($parts[1]>$loadtarget{'error'}) {
$errors++;
- } elsif ($parts[1]>2.0) {
+ } elsif ($parts[1]>$loadtarget{'warn'}) {
$warnings++;
- } elsif ($parts[1]>1.0) {
+ } elsif ($parts[1]>$loadtarget{'note'}) {
$notices++;
}
@@ -248,14 +265,14 @@ sub log_machine_info {
&log($fh,"<pre>");
open (DFH,"df|");
- while (my $line=<DFH>) {
- &log($fh,&encode_entities($line,'<>&"'));
+ while (my $line=<DFH>) {
+ &log($fh,&encode_entities($line,'<>&"'));
@parts=split(/\s+/,$line);
my $usage=$parts[4];
$usage=~s/\W//g;
- if ($usage>90) {
+ if ($usage>90) {
$warnings++;
- $notices++;
+ $notices++;
} elsif ($usage>80) {
$warnings++;
} elsif ($usage>60) {
@@ -272,8 +289,8 @@ sub log_machine_info {
my $psproc=0;
open (PSH,"ps aux --cols 140 |");
- while (my $line=<PSH>) {
- &log($fh,&encode_entities($line,'<>&"'));
+ while (my $line=<PSH>) {
+ &log($fh,&encode_entities($line,'<>&"'));
$psproc++;
}
close (PSH);
@@ -295,7 +312,7 @@ sub start_logging {
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">
@@ -320,6 +337,7 @@ sub start_logging {
<li><a href="#lonc">lonc</a></li>
<li><a href="#lonnet">lonnet</a></li>
<li><a href="#connections">Connections</a></li>
+<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>
@@ -411,12 +429,12 @@ sub recursive_clean_tmp {
($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";
+ join('&&',@contents)."\n";
if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {
closedir($dirhandle);
if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {
@@ -469,7 +487,7 @@ sub recursive_clean_tmp {
}
}
} elsif (ref($errors->{failopen}) eq 'ARRAY') {
- push(@{$errors->{failopen}},$fname);
+ push(@{$errors->{failopen}},$fname);
}
} else {
if (unlink($fname)) {
@@ -495,19 +513,38 @@ sub clean_lonIDs {
my $cleaned=0;
my $active=0;
while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
- my ($dev,$ino,$mode,$nlink,
- $uid,$gid,$rdev,$size,
- $atime,$mtime,$ctime,
- $blksize,$blocks)=stat($fname);
- my $now=time;
- my $since=$now-$mtime;
- if ($since>$perlvar{'lonExpire'}) {
- $cleaned++;
- &log($fh,"Unlinking $fname<br />");
- unlink("$fname");
- } else {
- $active++;
- }
+ my $now=time;
+ if (-l $fname) {
+ my $linkfname = readlink($fname);
+ if (-f $linkfname) {
+ if ($linkfname =~ m{^$perlvar{'lonIDsDir'}/[^/]+\.id$}) {
+ my @data = stat($linkfname);
+ my $mtime = $data[9];
+ my $since=$now-$mtime;
+ if ($since>$perlvar{'lonExpire'}) {
+ if (unlink($linkfname)) {
+ $cleaned++;
+ &log($fh,"Unlinking $linkfname<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>");
@@ -521,7 +558,7 @@ sub clean_balanceIDs {
my $cleaned=0;
my $active=0;
if (-d $perlvar{'lonBalanceDir'}) {
- while (my $fname=<$perlvar{'balanceDir'}/*.id>) {
+ while (my $fname=<$perlvar{'lonBalanceDir'}/*.id>) {
my ($dev,$ino,$mode,$nlink,
$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,
@@ -632,16 +669,16 @@ sub rotate_lonnet_logs {
print "Checking logs.\n";
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
- while (my $line=<DFH>) {
+ while (my $line=<DFH>) {
&log($fh,&encode_entities($line,'<>&"'));
}
close (DFH);
}
&log($fh,"</pre><h3>Perm Log</h3><pre>");
-
+
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
- while (my $line=<DFH>) {
+ while (my $line=<DFH>) {
&log($fh,&encode_entities($line,'<>&"'));
}
close (DFH);
@@ -1011,7 +1048,7 @@ sub write_serverhomeIDs {
eval {
local $SIG{ ALRM } = sub { die "TIMEOUT" };
alarm(10);
- $serverhomeID =
+ $serverhomeID =
&Apache::lonnet::get_server_homeID($name,1,'loncron');
alarm(0);
};
@@ -1096,12 +1133,12 @@ sub write_hostips {
if (keys(%prevhosts) && keys(%currhosts)) {
foreach my $key (keys(%prevhosts)) {
unless ($currhosts{$key} eq $prevhosts{$key}) {
- $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key}.' |';
+ $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key};
}
}
foreach my $key (keys(%currhosts)) {
unless ($currhosts{$key} eq $prevhosts{$key}) {
- $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key}.' |';
+ $ipchange{$key} = $prevhosts{$key}.' | '.$currhosts{$key};
}
}
}
@@ -1109,10 +1146,10 @@ sub write_hostips {
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";
+ "| Hostname | Previous IP | New IP |\n".
+ " --------------------------------- \n";
foreach my $hostname (sort(keys(%ipchange))) {
- print $fh "$hostname | $ipchange{$hostname}\n";
+ print $fh "| $hostname | $ipchange{$hostname} |\n";
}
print $fh "\n*******************\n\n";
close($fh);
@@ -1127,10 +1164,10 @@ sub write_hostips {
"MIME-Version: 1.0\n\n".
"Host/IP changes\n".
" \n".
- "Hostname | Previous IP | New IP |\n".
- "--------------------------------\n";
+ "| Hostname | Previous IP | New IP |\n".
+ " --------------------------------- \n";
foreach my $hostname (sort(keys(%ipchange))) {
- $chgmail .= "$hostname | $ipchange{$hostname}\n";
+ $chgmail .= "| $hostname | $ipchange{$hostname} |\n";
}
$chgmail .= "\n\n";
if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) {
@@ -1146,7 +1183,7 @@ sub write_hostips {
sub clean_nosslverify {
my ($fh) = @_;
- my %unlinked;
+ my %unlinked;
if (-d "$perlvar{'lonSockDir'}/nosslverify") {
if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) {
while (my $fname=readdir($dh)) {
@@ -1308,7 +1345,7 @@ sub write_hosttypes {
foreach my $lonid (sort(keys(%hostdom))) {
my $type = 'other';
if ($hostdom{$lonid} eq $dom) {
- $type = 'dom';
+ $type = 'dom';
} elsif ($intdom{$lonid} eq $internetdom) {
$type = 'intdom';
}
@@ -1455,6 +1492,98 @@ sub read_serverhomeIDs {
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 "set enable-bracketed-paste off\n";
+ close($cfh);
+ $result = "Updated $bash_www_cnf";
+ } 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);
+ if (open(my $cfh,'<',$bash_www_cnf)) {
+ while (my $line=<$cfh>) {
+ chomp($line);
+ if ($line =~ /^\s*set\s+enable\-bracketed\-paste\s+(off|on)\s*$/) {
+ if ($1 eq 'off') {
+ $bracketed_paste_off = 1;
+ } else {
+ $bracketed_paste_on = 1;
+ }
+ } else {
+ push(@preserve,$line);
+ }
+ }
+ close($cfh);
+ if ($bracketed_paste_on || !$bracketed_paste_off) {
+ if (open(my $cfh,'>',$bash_www_cnf)) {
+ print $cfh "set enable-bracketed-paste off\n";
+ if (@preserve) {
+ foreach my $entry (@preserve) {
+ print $cfh "$entry\n";
+ }
+ }
+ 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'";
+ }
+ } else {
+ $result = "Could not open $bash_www_cnf to check if a value is included for 'enable-bracketed-paste'.";
+ }
+ }
+ return $result;
+}
+
sub send_mail {
my ($sysmail,$reportstatus) = @_;
my $defdom = $perlvar{'lonDefDomain'};
@@ -1545,9 +1674,10 @@ sub main () {
if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
print("Unconfigured machine.\n");
my $emailto=$perlvar{'lonSysEMail'};
- my $hostname=`/bin/hostname`;
- chop $hostname;
- $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell
+ 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");
@@ -1558,7 +1688,7 @@ sub main () {
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 $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");
@@ -1586,7 +1716,7 @@ sub main () {
&Apache::lonnet::get_iphost(1,$nomemcache);
}
-# ----------------------------------------- Force firewall update for lond port
+# ----------------------------------------- Force firewall update for lond port
if ((!$justcheckdaemons) && (!$justreload)) {
my $now = time;
@@ -1601,7 +1731,7 @@ sub main () {
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('/tmp/lock_lciptables'); # Remove the lock file.
}
unlink($tmpfile);
}
@@ -1613,7 +1743,7 @@ sub main () {
$warnings=0;
$notices=0;
-
+
my $fh;
if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {
$fh=&start_logging();
@@ -1650,6 +1780,22 @@ sub main () {
&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 www, so R commands sent to lon daemon will be processed.</p>');
+ if ($bracketed_warning) {
+ 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);