--- loncom/loncron 2020/05/06 13:34:22 1.122
+++ loncom/loncron 2024/12/25 02:32:47 1.137
@@ -2,7 +2,7 @@
# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# $Id: loncron,v 1.122 2020/05/06 13:34:22 raeburn Exp $
+# $Id: loncron,v 1.137 2024/12/25 02:32:47 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=
"); if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) { - while (my $line=) { + while (my $line= ) { &log($fh,"$line"); if ($line=~/WARNING/) { $notices++; } if ($line=~/CRITICAL/) { $notices++; } @@ -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,' Machine Information
'); &log($fh,"loadavg
"); - + + my $cpucount; + if (open(PIPE,"lscpu |grep '^CPU(s)' 2>&1 |")) { + my $info =; + 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= ; close (LOADAVGH); - + &log($fh,"$loadavg"); - + 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," "); open (DFH,"df|"); - while (my $line=) { - &log($fh,&encode_entities($line,'<>&"')); + while (my $line= ) { + &log($fh,&encode_entities($line,'<>&"')); @parts=split(/\s+/,$line); my $usage=$parts[4]; $usage=~s/\W//g; - if ($usage>90) { + if ($usage>90) { $warnings++; - $notices++; + $notices++; } elsif ($usage>80) { $warnings++; } elsif ($usage>60) { @@ -272,8 +289,8 @@ sub log_machine_info { my $psproc=0; open (PSH,"ps aux --cols 140 |"); - while (my $line= ) { - &log($fh,&encode_entities($line,'<>&"')); + while (my $line= ) { + &log($fh,&encode_entities($line,'<>&"')); $psproc++; } close (PSH); @@ -292,10 +309,10 @@ sub log_machine_info { sub start_logging { my $fh=IO::File->new(">$statusdir/newstatus.html"); - my %simplestatus=(); + %simplestatus=(); my $now=time; my $date=localtime($now); - + &log($fh,(< @@ -320,6 +337,7 @@ sub start_logging { lonc lonnet Connections +bash readline config Delayed Messages Error Count @@ -408,15 +426,15 @@ sub recursive_clean_tmp { } else { $innerdir = $subdir.'/'.$file; } - ($cleaned,$old,$removed) = + ($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/}) { @@ -454,7 +472,7 @@ sub recursive_clean_tmp { if ($line=~/^CHECKOUTTOKEN\&/) { if ($since>365*$perlvar{'lonExpire'}) { if (unlink($fname)) { - $cleaned++; + $cleaned++; } elsif (ref($errors->{file}) eq 'ARRAY') { push(@{$errors->{file}},$fname); } @@ -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)) { @@ -540,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, @@ -620,7 +638,7 @@ sub clean_sockets { my $cleaned=0; opendir(SOCKETS,$perlvar{'lonSockDir'}); while (my $fname=readdir(SOCKETS)) { - next if (-d $fname + next if (-d $fname || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/); $cleaned++; &log($fh,"Unlinking $fname
"); @@ -651,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=) { + while (my $line= ) { &log($fh,&encode_entities($line,'<>&"')); } close (DFH); } &log($fh," Perm Log
"); - + if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|"); - while (my $line=) { + while (my $line= ) { &log($fh,&encode_entities($line,'<>&"')); } close (DFH); @@ -727,7 +745,7 @@ sub check_delayed_msg { my ($fh,$weightsref,$exclusionsref)=@_; &log($fh,' Delayed Messages
'); print "Checking buffers.\n"; - + &log($fh,'Scanning Permanent Log
'); my $unsend=0; @@ -798,7 +816,7 @@ sub check_delayed_msg { last; } undef $dfh; - } + } if ($checkbackwards) { if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { @@ -978,13 +996,17 @@ sub finish_logging { sub log_simplestatus { rename("$statusdir/newstatus.html","$statusdir/index.html"); - + my $sfh=IO::File->new(">$statusdir/loncron_simple.txt"); - foreach (keys %simplestatus) { - print $sfh $_.'='.$simplestatus{$_}.'&'; + if (defined($sfh)) { + foreach my $key (keys(%simplestatus)) { + print $sfh $key.'='.$simplestatus{$key}.'&'; + } + print $sfh "\n"; + $sfh->close(); + } else { + print "Could not write to $statusdir/loncron_simple.txt\n"; } - print $sfh "\n"; - $sfh->close(); } sub write_loncaparevs { @@ -1002,7 +1024,7 @@ sub write_loncaparevs { alarm(0); }; if ($@ && $@ =~ m/TIMEOUT/) { - print "Time out while contacting lonHost: $id for version.\n"; + print "Time out while contacting lonHost: $id for version.\n"; } if ($loncaparev =~ /^[\w.\-]+$/) { $output .= $id.':'.$loncaparev."\n"; @@ -1010,10 +1032,12 @@ sub write_loncaparevs { } } if ($output) { - if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) { + if (open(my $fh,'>',"$perlvar{'lonTabDir'}/loncaparevs.tab")) { print $fh $output; close($fh); &Apache::lonnet::load_loncaparevs(); + } else { + print "Could not write to $perlvar{'lonTabDir'}/loncaparevs.tab\n"; } } return; @@ -1030,12 +1054,12 @@ sub write_serverhomeIDs { eval { local $SIG{ ALRM } = sub { die "TIMEOUT" }; alarm(10); - $serverhomeID = + $serverhomeID = &Apache::lonnet::get_server_homeID($name,1,'loncron'); alarm(0); }; if ($@ && $@ =~ m/TIMEOUT/) { - print "Time out while contacting server: $name\n"; + print "Time out while contacting server: $name\n"; } if ($serverhomeID ne '') { $output .= $name.':'.$serverhomeID."\n"; @@ -1046,10 +1070,12 @@ sub write_serverhomeIDs { } } if ($output) { - if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { + if (open(my $fh,'>',"$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { print $fh $output; close($fh); &Apache::lonnet::load_serverhomeIDs(); + } else { + print "Could not write to $perlvar{'lonTabDir'}/serverhomeIDs.tab\n"; } } return; @@ -1070,7 +1096,7 @@ sub write_checksums { } 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"; + print "File version retrieval and checksumming skipped - could not determine Linux distro.\n"; } return; } @@ -1110,6 +1136,8 @@ sub write_hostips { } close($fh); chmod(0644,$newfile); + } else { + print "Could not write to $lontabdir/currhostips.tab\n"; } } if (keys(%prevhosts) && keys(%currhosts)) { @@ -1135,6 +1163,8 @@ sub write_hostips { } print $fh "\n*******************\n\n"; close($fh); + } else { + print "Could not write to $perlvar{'lonDaemons'}/logs/hostip.log\n"; } my $emailto = &Apache::loncommon::build_recipient_list(undef, 'hostipmail',$defdom); @@ -1165,7 +1195,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)) { @@ -1210,7 +1240,7 @@ sub write_connection_config { } } if (keys(%connectssl)) { - my %currconf; + my %currconf; if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) { while (my $line = <$fh>) { chomp($line); @@ -1225,7 +1255,7 @@ sub write_connection_config { } if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) { my $count = 0; - foreach my $key (sort(keys(%connectssl))) { + foreach my $key (sort(keys(%connectssl))) { print $fh "$key=$connectssl{$key}\n"; if (exists($currconf{$key})) { unless ($currconf{$key} eq $connectssl{$key}) { @@ -1238,6 +1268,8 @@ sub write_connection_config { } close($fh); print "Completed writing SSL options for lonc/lond for $count items.\n"; + } else { + print "Could not write to $perlvar{'lonTabDir'}/connectionrules.tab\n"; } } else { print "Writing of SSL options skipped - no connection rules in domain configuration.\n"; @@ -1327,7 +1359,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'; } @@ -1343,6 +1375,8 @@ sub write_hosttypes { } close($fh); print "Completed writing host type data for $count hosts.\n"; + } else { + print "Could not write to $perlvar{'lonTabDir'}/hosttypes.tab\n"; } } else { print "Writing of host types skipped - no hosts found.\n"; @@ -1474,6 +1508,158 @@ 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 =; + chomp($info); + my ($bracketed) = ($info =~ /^\Qenable-bracketed-paste\E\s+is\s+set\s+to\s+\W(on|off)\W$/); + close(PIPE); + if ($bracketed eq 'on') { + $bracketed_warning = 1; + } + } else { + print "Unable to check if bracketed paste is set to off for www user's shell\n"; + } + } + return ($bracketed_warning,$check_bracketed_paste); +} + +sub set_bracketed_paste_off { + my $bash_www_cnf = '/home/www/.inputrc'; + my $result; + if (!-e $bash_www_cnf) { + system("touch $bash_www_cnf"); + if (open(my $cfh,'>',$bash_www_cnf)) { + print $cfh <<'END'; +$if R + set enable-bracketed-paste off +$endif + +$if maxima + set enable-bracketed-paste off +$endif +END + close($cfh); + $result = "Updated $bash_www_cnf so enable-bracketed-paste is off for R bash shell"; + } else { + $result = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'"; + } + my $wwwuid = getpwnam('www'); + my $wwwgid = getgrnam('www'); + if ($wwwuid!=$<) { + chown($wwwuid,$wwwgid,$bash_www_cnf); + } + } else { + my (%bracketed_paste_on,%bracketed_paste_off,@preserve,$condition); + $condition = ''; + if (open(my $cfh,'<',$bash_www_cnf)) { + while (my $line=<$cfh>) { + chomp($line); + if ($line =~ /^\$if\s+(\w+)\s*$/) { + if ($1 eq 'R') { + $condition = 'r'; + } elsif ($1 eq 'maxima') { + $condition = 'maxima'; + } else { + $condition = 'other'; + } + } elsif ($line =~ /^\$endif\s*$/) { + $condition = ''; + } + if ($line =~ /^\s*set\s+enable\-bracketed\-paste\s+(off|on)\s*$/) { + if ($1 eq 'off') { + if ($condition ne '') { + $bracketed_paste_off{$condition} = 1; + } else { + $bracketed_paste_off{all} = 1; + } + push(@preserve,$line); + } else { + if ($condition ne '') { + $bracketed_paste_on{$condition} = 1; + if (($condition eq 'r') || ($condition eq 'maxima')) { + push(@preserve,' set enable-bracketed-paste off'); + } else { + push(@preserve,$line); + } + } else { + $bracketed_paste_on{all} = 1; + push(@preserve,$line); + } + } + } else { + push(@preserve,$line); + } + } + close($cfh); + } else { + $result = "Could not open $bash_www_cnf to check if a value is included for 'enable-bracketed-paste'."; + } + if (($bracketed_paste_on{r} || $bracketed_paste_on{maxima}) || + (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r}) && + !exists($bracketed_paste_off{maxima}) && !exists($bracketed_paste_on{maxima}))) { + if (open(my $cfh,'>',$bash_www_cnf)) { + if (@preserve) { + foreach my $entry (@preserve) { + print $cfh "$entry\n"; + } + if (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r})) { +print $cfh <<'END'; +$if R + set enable-bracketed-paste off +$endif +END + } + if (!exists($bracketed_paste_off{r}) && !exists($bracketed_paste_on{r})) { +print $cfh <<'END'; +$if maxima + set enable-bracketed-paste off +$endif +END + } + } else { +print $cfh <<'END'; +$if R + set enable-bracketed-paste off +$endif + +$if maxima + set enable-bracketed-paste off +$endif +END + } + close($cfh); + $result = "Updated $bash_www_cnf"; + } else { + $result = "Could not open $bash_www_cnf to add 'set enable-bracketed-paste to off'"; + } + } else { + $result = "No action needed; $bash_www_cnf already includes 'set enable-bracketed-paste to off'"; + } + } + return $result; +} + sub send_mail { my ($sysmail,$reportstatus) = @_; my $defdom = $perlvar{'lonDefDomain'}; @@ -1496,7 +1682,7 @@ sub send_mail { "Subject: ".$subj."\n". "Content-type: text/html\; charset=UTF-8\n". "MIME-Version: 1.0\n\n"; - if (open(my $fh,"<$statusdir/index.html")) { + if (open(my $fh,'<',"$statusdir/index.html")) { while (<$fh>) { $loncronmail .= $_; } @@ -1519,7 +1705,7 @@ sub usage { loncron - housekeeping program that checks up on various parts of LON-CAPA Options: - --help Display + --help Display --noemail Do not send the status email --justcheckconnections Only check the current status of the lonc/d connections, do not send emails do not @@ -1564,9 +1750,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"); @@ -1577,7 +1764,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"); @@ -1605,13 +1792,13 @@ 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; my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'. $now.$$.int(rand(10000)); - if (open(my $fh,">$tmpfile")) { + if (open(my $fh,'>',"$tmpfile")) { my %iphosts = &Apache::lonnet::get_iphost(); foreach my $key (keys(%iphosts)) { print $fh "$key\n"; @@ -1620,7 +1807,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); } @@ -1632,7 +1819,7 @@ sub main () { $warnings=0; $notices=0; - + my $fh; if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) { $fh=&start_logging(); @@ -1661,7 +1848,7 @@ sub main () { &clean_nosslverify($fh); &write_connection_config(); &write_hosttypes(); - &update_revocation_list(); + &update_revocation_list(); &checkon_daemon($fh,'lond',40000,'USR2'); &checkon_daemon($fh,'lonc',40000,'USR2'); } @@ -1669,6 +1856,32 @@ 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,' bash readline config
Bracketed Paste
'. + '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.
'); + 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,''.$bash_update.'
'."\n"); + } + } else { + &log($fh,'No action needed; /home/www/.inputrc already set.
'."\n"); + } + } else { + &log($fh,'bash readline config
Bracketed Paste
'. + 'No action needed for distros using pre-8.1 bash readline library
'."\n"); + } my $domconf = &get_domain_config(); my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) = &get_permcount_settings($domconf);