--- loncom/loncron 2018/10/25 03:27:22 1.110
+++ loncom/loncron 2024/07/28 12:47:31 1.132
@@ -2,7 +2,7 @@
# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# $Id: loncron,v 1.110 2018/10/25 03:27:22 raeburn Exp $
+# $Id: loncron,v 1.132 2024/07/28 12:47:31 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,6 +34,7 @@ use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use LONCAPA::Checksumming;
use LONCAPA;
+use LONCAPA::LWPReq;
use Apache::lonnet;
use Apache::loncommon;
@@ -41,8 +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);
@@ -75,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');
@@ -116,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=
"); 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) { @@ -269,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,7 +312,7 @@ sub start_logging { my %simplestatus=(); my $now=time; my $date=localtime($now); - + &log($fh,(< @@ -317,6 +337,7 @@ sub start_logging { lonc lonnet Connections +bash readline config Delayed Messages Error Count @@ -408,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/}) { @@ -466,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)) { @@ -492,24 +513,71 @@ 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
"); - 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
"); + 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
"); + } + } else { + $active++; + } + } } &log($fh,"Cleaned up ".$cleaned." stale session token(s).
"); &log($fh,"$active open session(s)
"); } +# -------------------------------------------------------- clean out balanceIDs + +sub clean_balanceIDs { + my ($fh)=@_; + &log($fh,'Session Tokens
'); + my $cleaned=0; + my $active=0; + if (-d $perlvar{'lonBalanceDir'}) { + while (my $fname=<$perlvar{'lonBalanceDir'}/*.id>) { + 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
"); + unlink("$fname"); + } else { + $active++; + } + } + } + &log($fh,"Cleaned up ".$cleaned." stale balancer files
"); + &log($fh,"$active unexpired balancer files
"); +} + # ------------------------------------------------ clean out webDAV Session IDs sub clean_webDAV_sessionIDs { my ($fh)=@_; @@ -536,6 +604,34 @@ sub clean_webDAV_sessionIDs { } } +# ------------------------------------------------------------ clean out ltiIDs + +sub clean_ltiIDs { + my ($fh)=@_; + &log($fh,'LTI Session Pointers
'); + my $cleaned=0; + my $active=0; + if (-d $perlvar{'ltiIDsDir'}) { + while (my $fname=<$perlvar{'ltiIDsDir'}/*>) { + 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
"); + unlink("$fname"); + } else { + $active++; + } + } + } + &log($fh,"Cleaned up ".$cleaned." old LTI session pointers.
"); + &log($fh,"$active unexpired LTI session pointers
"); +} + # ----------------------------------------------------------- clean out sockets sub clean_sockets { my ($fh)=@_; @@ -573,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,"
"); - + 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); @@ -646,35 +742,199 @@ sub test_connections { # ------------------------------------------------------------ Delayed messages sub check_delayed_msg { - my ($fh)=@_; + my ($fh,$weightsref,$exclusionsref)=@_; &log($fh,' Delayed Messages
'); print "Checking buffers.\n"; &log($fh,'Scanning Permanent Log
'); my $unsend=0; + my $ignored=0; my %hostname = &Apache::lonnet::all_hostnames(); my $numhosts = scalar(keys(%hostname)); - - my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log"); - while (my $line=<$dfh>) { - my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line); - if ($numhosts) { - next unless ($hostname{$dserv}); - } - if ($sdf eq 'F') { - my $local=localtime($time); - &log($fh,"Failed: $time, $dserv, $dcmd
"); - $warnings++; - } - if ($sdf eq 'S') { $unsend--; } - if ($sdf eq 'D') { $unsend++; } + my $checkbackwards = 0; + my $checkfrom = 0; + my $checkexcluded = 0; + my (%bymachine,%weights,%exclusions,%serverhomes); + if (ref($weightsref) eq 'HASH') { + %weights = %{$weightsref}; + } + if (ref($exclusionsref) eq 'HASH') { + %exclusions = %{$exclusionsref}; + if (keys(%exclusions)) { + $checkexcluded = 1; + %serverhomes = &read_serverhomeIDs(); + } } - &log($fh,"Total unsend messages: $unsend
\n"); - if ($unsend > 0) { - $warnings=$warnings+5*$unsend; +# +# For LON-CAPA 1.2.0 to 2.1.3 (release dates: 8/31/2004 and 3/31/2006) any +# entry logged in lonnet.perm.log for completion of a delayed (critical) +# transaction lacked the hostID for the remote node to which the command +# to be completed was sent. +# +# Because of this, exclusion of items in lonnet.perm.log for nodes which are +# no longer part of the cluster from adding to the overall "unsend" count +# needs additional effort besides the changes made in loncron rev. 1.105. +# +# For "S" (completion) events logging in LON-CAPA 1.2.0 through 2.1.3 included +# "LondTransaction=HASH(hexadecimal)->getClient() :$cmd, where the hexadecimal +# is a memory location, and $cmd is the command sent to the remote node. +# +# Starting with 2.2.0 (released 8/21/2006) logging for "S" (completion) events +# had sethost:$host_id:$cmd after LondTransaction=HASH(hexadecimal)->getClient() +# +# Starting with 2.4.1 (released 6/13/2007) logging for "S" replaced echoing the +# getClient() call with the result of the Transaction->getClient() call itself +# undef for completion of delivery of a delayed message. +# +# The net effect of these changes is that lonnet.perm.log is now accessed three +# times: (a) oldest record is checked, if earlier than release date for 2.5.0 +# then (b) file is read backwards, with timestamp recorded for most recent +# instance of logged "S" event for "update" command without "sethost:$host_id:" +# then (c) file is read forward with records ignored which predate the timestamp +# recorded in (b), if one was found. +# +# In (c), when calculating the unsend total, i.e., the difference between delayed +# transactions ("D") and sent transactions ("S"), transactions are ignored if the +# target node is no longer in the cluster, and also (for "update" commands), if +# the target node is in the list of nodes excluded from the count, in the domain +# configuration for this machine's default domain. The idea here is to remove +# delayed "update" commands for nodes for which inbound access to port 5663, +# is blocked, but are still part of the LON-CAPA network, (i.e., they can still +# replicate content from other nodes). +# + + my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r"); + if (defined($dfh)) { + while (my $line=<$dfh>) { + my ($time,$sdf,$rest)=split(/:/,$line,3); + if ($time < 1541185772) { + $checkbackwards = 1; + } + last; + } + undef $dfh; + } + + if ($checkbackwards) { + if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") { + while(my $line=) { + if ($line =~ /\QLondTransaction=HASH\E[^:]+:update:/) { + ($checkfrom) = split(/:/,$line,2); + last; + } + } + close(BW); + } + } + $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log","r"); + if (defined($dfh)) { + while (my $line=<$dfh>) { + my ($time,$sdf,$rest)=split(/:/,$line,3); + next unless (($sdf eq 'F') || ($sdf eq 'S') || ($sdf eq 'D')); + next if (($checkfrom) && ($time <= $checkfrom)); + my ($dserv,$dcmd); + if ($sdf eq 'S') { + my ($serva,$cmda,$servb,$cmdb) = split(/:/,$rest); + if ($cmda eq 'sethost') { + chomp($cmdb); + $dcmd = $cmdb; + } else { + $dcmd = $cmda; + } + if (($serva =~ /^LondTransaction/) || ($serva eq '')) { + unless (($servb eq '') || ($servb =~ m{^/})) { + $dserv = $servb; + } + } else { + $dserv = $serva; + } + } else { + ($dserv,$dcmd) = split(/:/,$rest); + } + if ($sdf eq 'F') { + my $local=localtime($time); + &log($fh,"Failed: $time, $dserv, $dcmd
"); + $warnings++; + } + next if ((($dserv eq '') || ($dcmd eq '')) && ($sdf ne 'F')); + if ($sdf eq 'S') { + if ($dcmd eq 'update') { + if ($hostname{$dserv}) { + if ($exclusions{$serverhomes{$hostname{$dserv}}}) { + $ignored --; + } else { + $unsend --; + } + } + if (exists($bymachine{$dserv})) { + $bymachine{$dserv} --; + } else { + $bymachine{$dserv} = -1; + } + } else { + if ($hostname{$dserv}) { + $unsend --; + } + } + } elsif ($sdf eq 'D') { + if ($dcmd eq 'update') { + if ($hostname{$dserv}) { + if ($exclusions{$serverhomes{$hostname{$dserv}}}) { + $ignored ++; + } else { + $unsend ++; + } + } + if (exists($bymachine{$dserv})) { + $bymachine{$dserv} ++; + } else { + $bymachine{$dserv} = 1; + } + } else { + if ($hostname{$dserv}) { + $unsend ++; + } + } + } + } + undef $dfh; + my $nodest = 0; + my $retired = 0; + my %active; + if (keys(%bymachine)) { + unless ($checkexcluded) { + %serverhomes = &read_serverhomeIDs(); + } + foreach my $key (keys(%bymachine)) { + if ($bymachine{$key} > 0) { + if ($hostname{$key}) { + $active{$serverhomes{$hostname{$key}}} += $bymachine{$key}; + } else { + $retired ++; + $nodest += $bymachine{$key}; + } + } + } + } + if (keys(%active)) { + &log($fh,"Unsend messages by node, active (undegraded) nodes in cluster
\n"); + foreach my $key (sort(keys(%active))) { + &log($fh,&encode_entities("$key => $active{$key}",'<>&"')."\n"); + } + } + &log($fh,"Total unsend messages: $unsend for ".scalar(keys(%active))." active (undegraded) nodes in cluster.
\n"); + if (keys(%exclusions) > 0) { + &log($fh,"Total incomplete updates $ignored for ".scalar(keys(%exclusions))." degraded nodes in cluster.
\n"); + } + if ($retired) { + &log($fh,"Total unsent $nodest for $retired nodes no longer in cluster.
\n"); + } + if ($unsend > 0) { + $warnings=$warnings+$weights{'U'}*$unsend; + } } if ($unsend) { $simplestatus{'unsend'}=$unsend; } @@ -713,9 +973,13 @@ sub check_delayed_msg { } sub finish_logging { - my ($fh)=@_; + my ($fh,$weightsref)=@_; + my %weights; + if (ref($weightsref) eq 'HASH') { + %weights = %{$weightsref}; + } &log($fh,"\n"); - $totalcount=$notices+4*$warnings+100*$errors; + $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors); &errout($fh); &log($fh,"Total Error Count: $totalcount
"); my $now=time; @@ -784,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); }; @@ -829,9 +1093,97 @@ sub write_checksums { return; } +sub write_hostips { + my $lontabdir = $perlvar{'lonTabDir'}; + my $defdom = $perlvar{'lonDefDomain'}; + my $lonhost = $perlvar{'lonHostID'}; + my $newfile = "$lontabdir/currhostips.tab"; + my $oldfile = "$lontabdir/prevhostips.tab"; + my (%prevhosts,%currhosts,%ipchange); + if ((-e $newfile) && (-s $newfile)) { + move($newfile,$oldfile); + chmod(0644,$oldfile); + if (open(my $fh,'<',$oldfile)) { + while (my $line=<$fh>) { + chomp($line); + if ($line =~ /^([^:]+):([\d.]+)$/) { + $prevhosts{$1} = $2; + } + } + close($fh); + } + } + my ($ip_info,$cached) = + &Apache::lonnet::is_cached_new('iphost','iphost'); + if (!$cached) { + &Apache::lonnet::get_iphost(); + ($ip_info,$cached) = + &Apache::lonnet::is_cached_new('iphost','iphost'); + } + if (ref($ip_info) eq 'ARRAY') { + %currhosts = %{$ip_info->[1]}; + if (open(my $fh,'>',$newfile)) { + foreach my $key (keys(%currhosts)) { + print $fh "$key:$currhosts{$key}\n"; + } + close($fh); + chmod(0644,$newfile); + } + } + 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; +} + 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)) { @@ -861,20 +1213,8 @@ sub clean_lonc_childpids { } sub write_connection_config { - my ($isprimary,$domconf,$url,%connectssl,%changes); - my $primaryLibServer = &Apache::lonnet::domain($perlvar{'lonDefDomain'},'primary'); - if ($primaryLibServer eq $perlvar{'lonHostID'}) { - $isprimary = 1; - } elsif ($primaryLibServer ne '') { - my $protocol = $Apache::lonnet::protocol{$primaryLibServer}; - my $hostname = &Apache::lonnet::hostname($primaryLibServer); - unless ($protocol eq 'https') { - $protocol = 'http'; - } - $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl'; - } - my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary, - $url); + my ($domconf,%connectssl,%changes); + $domconf = &get_domain_config(); if (ref($domconf) eq 'HASH') { if (ref($domconf->{'ssl'}) eq 'HASH') { foreach my $connect ('connto','connfrom') { @@ -927,8 +1267,19 @@ sub write_connection_config { } sub get_domain_config { - my ($dom,$primlibserv,$isprimary,$url) = @_; - my %confhash; + my ($dom,$primlibserv,$isprimary,$url,%confhash); + $dom = $perlvar{'lonDefDomain'}; + $primlibserv = &Apache::lonnet::domain($dom,'primary'); + if ($primlibserv eq $perlvar{'lonHostID'}) { + $isprimary = 1; + } elsif ($primlibserv ne '') { + my $protocol = $Apache::lonnet::protocol{$primlibserv}; + my $hostname = &Apache::lonnet::hostname($primlibserv); + unless ($protocol eq 'https') { + $protocol = 'http'; + } + $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl?primary='.$primlibserv.'&format=raw'; + } if ($isprimary) { my $lonusersdir = $perlvar{'lonUsersDir'}; my $fname = $lonusersdir.'/'.$dom.'/configuration.db'; @@ -948,14 +1299,12 @@ sub get_domain_config { } } } else { - if (open(PIPE,"wget --no-check-certificate '$url?primary=$primlibserv&format=raw' |")) { - my $config = ''; - while () { - $config .= $_; - } - close(PIPE); - if ($config) { - my @pairs=split(/\&/,$config); + 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); @@ -996,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'; } @@ -1087,12 +1436,222 @@ sub reset_nosslverify_pids { return; } +sub get_permcount_settings { + my ($domconf) = @_; + my ($defaults,$names) = &Apache::loncommon::lon_status_items(); + my (%weights,$threshold,$sysmail,$reportstatus,%exclusions); + foreach my $type ('E','W','N','U') { + $weights{$type} = $defaults->{$type}; + } + $threshold = $defaults->{'threshold'}; + $sysmail = $defaults->{'sysmail'}; + $reportstatus = 1; + if (ref($domconf) eq 'HASH') { + if (ref($domconf->{'contacts'}) eq 'HASH') { + if ($domconf->{'contacts'}{'reportstatus'} == 0) { + $reportstatus = 0; + } + if (ref($domconf->{'contacts'}{'lonstatus'}) eq 'HASH') { + if (ref($domconf->{'contacts'}{'lonstatus'}{weights}) eq 'HASH') { + foreach my $type ('E','W','N','U') { + if (exists($domconf->{'contacts'}{'lonstatus'}{weights}{$type})) { + $weights{$type} = $domconf->{'contacts'}{'lonstatus'}{weights}{$type}; + } + } + } + if (ref($domconf->{'contacts'}{'lonstatus'}{'excluded'}) eq 'ARRAY') { + my @excluded = @{$domconf->{'contacts'}{'lonstatus'}{'excluded'}}; + if (@excluded) { + map { $exclusions{$_} = 1; } @excluded; + } + } + if (exists($domconf->{'contacts'}{'lonstatus'}{'threshold'})) { + $threshold = $domconf->{'contacts'}{'lonstatus'}{'threshold'}; + } + if (exists($domconf->{'contacts'}{'lonstatus'}{'sysmail'})) { + $sysmail = $domconf->{'contacts'}{'lonstatus'}{'sysmail'}; + } + } + } + } + return ($threshold,$sysmail,$reportstatus,\%weights,\%exclusions); +} + +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; +} + +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'}; my $origmail = $perlvar{'lonAdmEMail'}; my $emailto = &Apache::loncommon::build_recipient_list(undef, 'lonstatusmail',$defdom,$origmail); - if ($totalcount>2500) { + if (($totalcount>$sysmail) && ($reportstatus)) { $emailto.=",$perlvar{'lonSysEMail'}"; } my $from; @@ -1145,19 +1704,23 @@ Options: do not send emails do not check if the daemons are running, do not generate lon-status - + --justiptables Only update the dynamic iptables rules for the + lond port; do not send emails, do not + check if the daemons are running, do not + generate lon-status USAGE } # ================================================================ Main Program sub main () { my ($help,$justcheckdaemons,$noemail,$justcheckconnections, - $justreload); + $justreload,$justiptables); &GetOptions("help" => \$help, "justcheckdaemons" => \$justcheckdaemons, "noemail" => \$noemail, "justcheckconnections" => \$justcheckconnections, - "justreload" => \$justreload + "justreload" => \$justreload, + "justiptables" => \$justiptables ); if ($help) { &usage(); return; } # --------------------------------- Read loncapa_apache.conf and loncapa.conf @@ -1172,12 +1735,13 @@ 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.' |\ - mailto $emailto -s '$subj' > /dev/null"); + system("echo 'Unconfigured machine $hostname.' |". + " mail -s '$subj' $emailto > /dev/null"); exit 1; } @@ -1185,10 +1749,10 @@ 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.' |\ - mailto $emailto -s '$subj' > /dev/null"); + system("echo 'User ID mismatch. loncron must be run as user www.' |". + " mail -s '$subj' $emailto > /dev/null"); exit 1; } @@ -1207,11 +1771,13 @@ sub main () { } } } - &Apache::lonnet::load_hosts_tab(1,$nomemcache); - &Apache::lonnet::load_domain_tab(1,$nomemcache); - &Apache::lonnet::get_iphost(1,$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 +# ----------------------------------------- Force firewall update for lond port if ((!$justcheckdaemons) && (!$justreload)) { my $now = time; @@ -1226,7 +1792,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); } @@ -1238,20 +1804,22 @@ sub main () { $warnings=0; $notices=0; - + my $fh; - if (!$justcheckdaemons && !$justcheckconnections && !$justreload) { + 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) { + if (!$justcheckconnections && !$justreload && !$justiptables) { &checkon_daemon($fh,'lonmemcached',40000); &checkon_daemon($fh,'lonsql',200000); if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') { @@ -1272,12 +1840,41 @@ sub main () { if ($justcheckconnections) { &test_connections($fh); } - if (!$justcheckdaemons && !$justcheckconnections && !$justreload) { - &check_delayed_msg($fh); - &log_simplestatus(); + 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); + &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(); @@ -1287,8 +1884,9 @@ sub main () { &checkon_daemon($fh,'lond',40000,'USR2'); &reset_nosslverify_pids($fh,%sslrem); } - &finish_logging($fh); - if ($totalcount>200 && !$noemail) { &send_mail(); } + &finish_logging($fh,$weightsref); + &log_simplestatus(); + if ($totalcount>$threshold && !$noemail) { &send_mail($sysmail,$reportstatus); } } }