--- loncom/loncron 2021/01/30 21:26:04 1.125 +++ loncom/loncron 2024/10/24 20:50:05 1.135 @@ -2,7 +2,7 @@ # Housekeeping program, started by cron, loncontrol and loncron.pl # -# $Id: loncron,v 1.125 2021/01/30 21:26:04 raeburn Exp $ +# $Id: loncron,v 1.135 2024/10/24 20:50:05 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -42,7 +42,7 @@ 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; @@ -231,6 +231,21 @@ sub log_machine_info { &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); @@ -238,11 +253,11 @@ sub log_machine_info { &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++; } @@ -294,7 +309,7 @@ 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); @@ -322,6 +337,7 @@ sub start_logging {
  • lonc
  • lonnet
  • Connections
    • +
  • bash readline config
  • Delayed Messages
  • Error Count
    • @@ -982,11 +998,13 @@ 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(); } - print $sfh "\n"; - $sfh->close(); } sub write_loncaparevs { @@ -1012,10 +1030,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; @@ -1048,10 +1068,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; @@ -1112,6 +1134,8 @@ sub write_hostips { } close($fh); chmod(0644,$newfile); + } else { + print "Could not write to $lontabdir/currhostips.tab\n"; } } if (keys(%prevhosts) && keys(%currhosts)) { @@ -1137,6 +1161,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); @@ -1240,6 +1266,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"; @@ -1345,6 +1373,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"; @@ -1476,6 +1506,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'}; @@ -1498,7 +1680,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 .= $_; } @@ -1580,7 +1762,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"); @@ -1614,7 +1796,7 @@ sub main () { 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"; @@ -1672,6 +1854,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);