loncom/loncron - diff

Return to loncron CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/loncron between versions 1.116 and 1.137

version 1.116, 2018/12/22 20:05:16	version 1.137, 2024/12/25 02:32:47
Line 42 use IO::File;	Line 42 use IO::File;
use IO::Socket;	use IO::Socket;
use HTML::Entities;	use HTML::Entities;
use Getopt::Long;	use Getopt::Long;
use GDBM_File;	use GDBM_File qw(GDBM_READER);
use Storable qw(thaw);	use Storable qw(thaw);
use File::ReadBackwards;	use File::ReadBackwards;
	use File::Copy;
	use Sys::Hostname::FQDN();

#globals	#globals
use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);	use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount);

Line 77 sub rotate_logfile {	Line 80 sub rotate_logfile {
rename("$file.2","$file.3");	rename("$file.2","$file.3");
rename("$file.1","$file.2");	rename("$file.1","$file.2");
rename("$file","$file.1");	rename("$file","$file.1");
}	}
}	}

sub start_daemon {	sub start_daemon {
my ($fh,$daemon,$pidfile,$args) = @_;	my ($fh,$daemon,$pidfile,$args) = @_;
my $progname=$daemon;	my $progname=$daemon;
if ($daemon eq 'lonc') {	if ($daemon eq 'lonc') {
$progname='loncnew';	$progname='loncnew';
}	}
my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";	my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors";
&rotate_logfile($error_fname,$fh,'error logs');	&rotate_logfile($error_fname,$fh,'error logs');
Line 118 sub checkon_daemon {	Line 121 sub checkon_daemon {
if ($fh) {	if ($fh) {
if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){	if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
if (open(DFH,"tail -n25 $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");	&log($fh,"$line");
if ($line=~/INFO/) { $notices++; }	if ($line=~/INFO/) { $notices++; }
if ($line=~/WARNING/) { $notices++; }	if ($line=~/WARNING/) { $notices++; }
Line 129 sub checkon_daemon {	Line 132 sub checkon_daemon {
}	}
&log($fh,"</tt></p>");	&log($fh,"</tt></p>");
}	}

my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";	my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid";

my $restartflag=1;	my $restartflag=1;
my $daemonpid;	my $daemonpid;
if (-e $pidfile) {	if (-e $pidfile) {
Line 203 sub checkon_daemon {	Line 206 sub checkon_daemon {
if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){	if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
&log($fh,"<p><pre>");	&log($fh,"<p><pre>");
if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log\|")) {	if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log\|")) {
while (my $line=<DFH>) {	while (my $line=<DFH>) {
&log($fh,"$line");	&log($fh,"$line");
if ($line=~/WARNING/) { $notices++; }	if ($line=~/WARNING/) { $notices++; }
if ($line=~/CRITICAL/) { $notices++; }	if ($line=~/CRITICAL/) { $notices++; }
Line 214 sub checkon_daemon {	Line 217 sub checkon_daemon {
}	}
}	}
}	}

my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";	my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log";
&rotate_logfile($fname,$fh,'logs');	&rotate_logfile($fname,$fh,'logs');

Line 227 sub log_machine_info {	Line 230 sub log_machine_info {
my ($fh)=@_;	my ($fh)=@_;
&log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');	&log($fh,'<hr /><a name="machine" /><h2>Machine Information</h2>');
&log($fh,"<h3>loadavg</h3>");	&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");	open (LOADAVGH,"/proc/loadavg");
my $loadavg=<LOADAVGH>;	my $loadavg=<LOADAVGH>;
close (LOADAVGH);	close (LOADAVGH);

&log($fh,"<tt>$loadavg</tt>");	&log($fh,"<tt>$loadavg</tt>");

my @parts=split(/\s+/,$loadavg);	my @parts=split(/\s+/,$loadavg);
if ($parts[1]>4.0) {	if ($parts[1]>$loadtarget{'error'}) {
$errors++;	$errors++;
} elsif ($parts[1]>2.0) {	} elsif ($parts[1]>$loadtarget{'warn'}) {
$warnings++;	$warnings++;
} elsif ($parts[1]>1.0) {	} elsif ($parts[1]>$loadtarget{'note'}) {
$notices++;	$notices++;
}	}

Line 247 sub log_machine_info {	Line 265 sub log_machine_info {
&log($fh,"<pre>");	&log($fh,"<pre>");

open (DFH,"df\|");	open (DFH,"df\|");
while (my $line=<DFH>) {	while (my $line=<DFH>) {
&log($fh,&encode_entities($line,'<>&"'));	&log($fh,&encode_entities($line,'<>&"'));
@parts=split(/\s+/,$line);	@parts=split(/\s+/,$line);
my $usage=$parts[4];	my $usage=$parts[4];
$usage=~s/\W//g;	$usage=~s/\W//g;
if ($usage>90) {	if ($usage>90) {
$warnings++;	$warnings++;
$notices++;	$notices++;
} elsif ($usage>80) {	} elsif ($usage>80) {
$warnings++;	$warnings++;
} elsif ($usage>60) {	} elsif ($usage>60) {
Line 271 sub log_machine_info {	Line 289 sub log_machine_info {
my $psproc=0;	my $psproc=0;

open (PSH,"ps aux --cols 140 \|");	open (PSH,"ps aux --cols 140 \|");
while (my $line=<PSH>) {	while (my $line=<PSH>) {
&log($fh,&encode_entities($line,'<>&"'));	&log($fh,&encode_entities($line,'<>&"'));
$psproc++;	$psproc++;
}	}
close (PSH);	close (PSH);
Line 291 sub log_machine_info {	Line 309 sub log_machine_info {

sub start_logging {	sub start_logging {
my $fh=IO::File->new(">$statusdir/newstatus.html");	my $fh=IO::File->new(">$statusdir/newstatus.html");
my %simplestatus=();	%simplestatus=();
my $now=time;	my $now=time;
my $date=localtime($now);	my $date=localtime($now);


&log($fh,(<<ENDHEADERS));	&log($fh,(<<ENDHEADERS));
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
Line 319 sub start_logging {	Line 337 sub start_logging {
<li><a href="#lonc">lonc</a></li>	<li><a href="#lonc">lonc</a></li>
<li><a href="#lonnet">lonnet</a></li>	<li><a href="#lonnet">lonnet</a></li>
<li><a href="#connections">Connections</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="#delayed">Delayed Messages</a></li>
<li><a href="#errcount">Error Count</a></li>	<li><a href="#errcount">Error Count</a></li>
</ol>	</ol>
Line 407 sub recursive_clean_tmp {	Line 426 sub recursive_clean_tmp {
} else {	} else {
$innerdir = $subdir.'/'.$file;	$innerdir = $subdir.'/'.$file;
}	}
($cleaned,$old,$removed) =	($cleaned,$old,$removed) =
&recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);	&recursive_clean_tmp($innerdir,$cleaned,$old,$removed,$errors);
my @doms = &Apache::lonnet::current_machine_domains();	my @doms = &Apache::lonnet::current_machine_domains();

if (open(my $dirhandle,$fname)) {	if (open(my $dirhandle,$fname)) {
unless (($innerdir eq 'helprequests') \|\|	unless (($innerdir eq 'helprequests') \|\|
(($innerdir =~ /^addcourse/) && ($innerdir !~ m{/\d+$}))) {	(($innerdir =~ /^addcourse/) && ($innerdir !~ m{/\d+$}))) {
my @contents = grep {!/^\.\.?$/} readdir($dirhandle);	my @contents = grep {!/^\.\.?$/} readdir($dirhandle);
join('&&',@contents)."\n";	join('&&',@contents)."\n";
if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {	if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {
closedir($dirhandle);	closedir($dirhandle);
if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {	if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {
Line 453 sub recursive_clean_tmp {	Line 472 sub recursive_clean_tmp {
if ($line=~/^CHECKOUTTOKEN\&/) {	if ($line=~/^CHECKOUTTOKEN\&/) {
if ($since>365*$perlvar{'lonExpire'}) {	if ($since>365*$perlvar{'lonExpire'}) {
if (unlink($fname)) {	if (unlink($fname)) {
$cleaned++;	$cleaned++;
} elsif (ref($errors->{file}) eq 'ARRAY') {	} elsif (ref($errors->{file}) eq 'ARRAY') {
push(@{$errors->{file}},$fname);	push(@{$errors->{file}},$fname);
}	}
Line 468 sub recursive_clean_tmp {	Line 487 sub recursive_clean_tmp {
}	}
}	}
} elsif (ref($errors->{failopen}) eq 'ARRAY') {	} elsif (ref($errors->{failopen}) eq 'ARRAY') {
push(@{$errors->{failopen}},$fname);	push(@{$errors->{failopen}},$fname);
}	}
} else {	} else {
if (unlink($fname)) {	if (unlink($fname)) {
Line 494 sub clean_lonIDs {	Line 513 sub clean_lonIDs {
my $cleaned=0;	my $cleaned=0;
my $active=0;	my $active=0;
while (my $fname=<$perlvar{'lonIDsDir'}/*>) {	while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
my ($dev,$ino,$mode,$nlink,	my $now=time;
$uid,$gid,$rdev,$size,	if (-l $fname) {
$atime,$mtime,$ctime,	my $linkfname = readlink($fname);
$blksize,$blocks)=stat($fname);	if (-f $linkfname) {
my $now=time;	if ($linkfname =~ m{^$perlvar{'lonIDsDir'}/[^/]+\.id$}) {
my $since=$now-$mtime;	my @data = stat($linkfname);
if ($since>$perlvar{'lonExpire'}) {	my $mtime = $data[9];
$cleaned++;	my $since=$now-$mtime;
&log($fh,"Unlinking $fname<br />");	if ($since>$perlvar{'lonExpire'}) {
unlink("$fname");	if (unlink($linkfname)) {
} else {	$cleaned++;
$active++;	&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,"<p>Cleaned up ".$cleaned." stale session token(s).</p>");
&log($fh,"<h3>$active open session(s)</h3>");	&log($fh,"<h3>$active open session(s)</h3>");
Line 520 sub clean_balanceIDs {	Line 558 sub clean_balanceIDs {
my $cleaned=0;	my $cleaned=0;
my $active=0;	my $active=0;
if (-d $perlvar{'lonBalanceDir'}) {	if (-d $perlvar{'lonBalanceDir'}) {
while (my $fname=<$perlvar{'balanceDir'}/*.id>) {	while (my $fname=<$perlvar{'lonBalanceDir'}/*.id>) {
my ($dev,$ino,$mode,$nlink,	my ($dev,$ino,$mode,$nlink,
$uid,$gid,$rdev,$size,	$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,	$atime,$mtime,$ctime,
Line 566 sub clean_webDAV_sessionIDs {	Line 604 sub clean_webDAV_sessionIDs {
}	}
}	}

	# ------------------------------------------------------------ clean out ltiIDs

	sub clean_ltiIDs {
	my ($fh)=@_;
	&log($fh,'<hr /><a name="ltisessions" /><h2>LTI Session Pointers</h2>');
	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<br />");
	unlink("$fname");
	} else {
	$active++;
	}
	}
	}
	&log($fh,"<p>Cleaned up ".$cleaned." old LTI session pointers.</p>");
	&log($fh,"<h3>$active unexpired LTI session pointers</h3>");
	}

# ----------------------------------------------------------- clean out sockets	# ----------------------------------------------------------- clean out sockets
sub clean_sockets {	sub clean_sockets {
my ($fh)=@_;	my ($fh)=@_;
my $cleaned=0;	my $cleaned=0;
opendir(SOCKETS,$perlvar{'lonSockDir'});	opendir(SOCKETS,$perlvar{'lonSockDir'});
while (my $fname=readdir(SOCKETS)) {	while (my $fname=readdir(SOCKETS)) {
next if (-d $fname	next if (-d $fname
\|\| $fname=~/(mysqlsock\|maximasock\|rsock\|\Q$perlvar{'lonSockDir'}\E)/);	\|\| $fname=~/(mysqlsock\|maximasock\|rsock\|\Q$perlvar{'lonSockDir'}\E)/);
$cleaned++;	$cleaned++;
&log($fh,"Unlinking $fname<br />");	&log($fh,"Unlinking $fname<br />");
Line 603 sub rotate_lonnet_logs {	Line 669 sub rotate_lonnet_logs {
print "Checking logs.\n";	print "Checking logs.\n";
if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){	if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
open (DFH,"tail -n50 $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,'<>&"'));	&log($fh,&encode_entities($line,'<>&"'));
}	}
close (DFH);	close (DFH);
}	}
&log($fh,"</pre><h3>Perm Log</h3><pre>");	&log($fh,"</pre><h3>Perm Log</h3><pre>");

if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {	if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
open(DFH,"tail -n10 $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,'<>&"'));	&log($fh,&encode_entities($line,'<>&"'));
}	}
close (DFH);	close (DFH);
Line 679 sub check_delayed_msg {	Line 745 sub check_delayed_msg {
my ($fh,$weightsref,$exclusionsref)=@_;	my ($fh,$weightsref,$exclusionsref)=@_;
&log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');	&log($fh,'<hr /><a name="delayed" /><h2>Delayed Messages</h2>');
print "Checking buffers.\n";	print "Checking buffers.\n";

&log($fh,'<h3>Scanning Permanent Log</h3>');	&log($fh,'<h3>Scanning Permanent Log</h3>');

my $unsend=0;	my $unsend=0;
Line 750 sub check_delayed_msg {	Line 816 sub check_delayed_msg {
last;	last;
}	}
undef $dfh;	undef $dfh;
}	}

if ($checkbackwards) {	if ($checkbackwards) {
if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {	if (tie *BW, 'File::ReadBackwards', "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
Line 930 sub finish_logging {	Line 996 sub finish_logging {

sub log_simplestatus {	sub log_simplestatus {
rename("$statusdir/newstatus.html","$statusdir/index.html");	rename("$statusdir/newstatus.html","$statusdir/index.html");

my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");	my $sfh=IO::File->new(">$statusdir/loncron_simple.txt");
foreach (keys %simplestatus) {	if (defined($sfh)) {
print $sfh $_.'='.$simplestatus{$_}.'&';	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 {	sub write_loncaparevs {
Line 954 sub write_loncaparevs {	Line 1024 sub write_loncaparevs {
alarm(0);	alarm(0);
};	};
if ($@ && $@ =~ m/TIMEOUT/) {	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.\-]+$/) {	if ($loncaparev =~ /^[\w.\-]+$/) {
$output .= $id.':'.$loncaparev."\n";	$output .= $id.':'.$loncaparev."\n";
Line 962 sub write_loncaparevs {	Line 1032 sub write_loncaparevs {
}	}
}	}
if ($output) {	if ($output) {
if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {	if (open(my $fh,'>',"$perlvar{'lonTabDir'}/loncaparevs.tab")) {
print $fh $output;	print $fh $output;
close($fh);	close($fh);
&Apache::lonnet::load_loncaparevs();	&Apache::lonnet::load_loncaparevs();
	} else {
	print "Could not write to $perlvar{'lonTabDir'}/loncaparevs.tab\n";
}	}
}	}
return;	return;
Line 982 sub write_serverhomeIDs {	Line 1054 sub write_serverhomeIDs {
eval {	eval {
local $SIG{ ALRM } = sub { die "TIMEOUT" };	local $SIG{ ALRM } = sub { die "TIMEOUT" };
alarm(10);	alarm(10);
$serverhomeID =	$serverhomeID =
&Apache::lonnet::get_server_homeID($name,1,'loncron');	&Apache::lonnet::get_server_homeID($name,1,'loncron');
alarm(0);	alarm(0);
};	};
if ($@ && $@ =~ m/TIMEOUT/) {	if ($@ && $@ =~ m/TIMEOUT/) {
print "Time out while contacting server: $name\n";	print "Time out while contacting server: $name\n";
}	}
if ($serverhomeID ne '') {	if ($serverhomeID ne '') {
$output .= $name.':'.$serverhomeID."\n";	$output .= $name.':'.$serverhomeID."\n";
Line 998 sub write_serverhomeIDs {	Line 1070 sub write_serverhomeIDs {
}	}
}	}
if ($output) {	if ($output) {
if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {	if (open(my $fh,'>',"$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
print $fh $output;	print $fh $output;
close($fh);	close($fh);
&Apache::lonnet::load_serverhomeIDs();	&Apache::lonnet::load_serverhomeIDs();
	} else {
	print "Could not write to $perlvar{'lonTabDir'}/serverhomeIDs.tab\n";
}	}
}	}
return;	return;
Line 1022 sub write_checksums {	Line 1096 sub write_checksums {
}	}
print "File version retrieved and checksumming completed for $numchksums files.\n";	print "File version retrieved and checksumming completed for $numchksums files.\n";
} else {	} 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;
	}

	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);
	} else {
	print "Could not write to $lontabdir/currhostips.tab\n";
	}
	}
	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);
	} else {
	print "Could not write to $perlvar{'lonDaemons'}/logs/hostip.log\n";
	}
	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;	return;
}	}

sub clean_nosslverify {	sub clean_nosslverify {
my ($fh) = @_;	my ($fh) = @_;
my %unlinked;	my %unlinked;
if (-d "$perlvar{'lonSockDir'}/nosslverify") {	if (-d "$perlvar{'lonSockDir'}/nosslverify") {
if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) {	if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) {
while (my $fname=readdir($dh)) {	while (my $fname=readdir($dh)) {
Line 1074 sub write_connection_config {	Line 1240 sub write_connection_config {
}	}
}	}
if (keys(%connectssl)) {	if (keys(%connectssl)) {
my %currconf;	my %currconf;
if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) {	if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
chomp($line);	chomp($line);
Line 1089 sub write_connection_config {	Line 1255 sub write_connection_config {
}	}
if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) {	if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) {
my $count = 0;	my $count = 0;
foreach my $key (sort(keys(%connectssl))) {	foreach my $key (sort(keys(%connectssl))) {
print $fh "$key=$connectssl{$key}\n";	print $fh "$key=$connectssl{$key}\n";
if (exists($currconf{$key})) {	if (exists($currconf{$key})) {
unless ($currconf{$key} eq $connectssl{$key}) {	unless ($currconf{$key} eq $connectssl{$key}) {
Line 1102 sub write_connection_config {	Line 1268 sub write_connection_config {
}	}
close($fh);	close($fh);
print "Completed writing SSL options for lonc/lond for $count items.\n";	print "Completed writing SSL options for lonc/lond for $count items.\n";
	} else {
	print "Could not write to $perlvar{'lonTabDir'}/connectionrules.tab\n";
}	}
} else {	} else {
print "Writing of SSL options skipped - no connection rules in domain configuration.\n";	print "Writing of SSL options skipped - no connection rules in domain configuration.\n";
Line 1191 sub write_hosttypes {	Line 1359 sub write_hosttypes {
foreach my $lonid (sort(keys(%hostdom))) {	foreach my $lonid (sort(keys(%hostdom))) {
my $type = 'other';	my $type = 'other';
if ($hostdom{$lonid} eq $dom) {	if ($hostdom{$lonid} eq $dom) {
$type = 'dom';	$type = 'dom';
} elsif ($intdom{$lonid} eq $internetdom) {	} elsif ($intdom{$lonid} eq $internetdom) {
$type = 'intdom';	$type = 'intdom';
}	}
Line 1207 sub write_hosttypes {	Line 1375 sub write_hosttypes {
}	}
close($fh);	close($fh);
print "Completed writing host type data for $count hosts.\n";	print "Completed writing host type data for $count hosts.\n";
	} else {
	print "Could not write to $perlvar{'lonTabDir'}/hosttypes.tab\n";
}	}
} else {	} else {
print "Writing of host types skipped - no hosts found.\n";	print "Writing of host types skipped - no hosts found.\n";
Line 1338 sub read_serverhomeIDs {	Line 1508 sub read_serverhomeIDs {
return %server;	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 <<'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 =~ /^\sset\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 {	sub send_mail {
my ($sysmail,$reportstatus) = @_;	my ($sysmail,$reportstatus) = @_;
my $defdom = $perlvar{'lonDefDomain'};	my $defdom = $perlvar{'lonDefDomain'};
Line 1360 sub send_mail {	Line 1682 sub send_mail {
"Subject: ".$subj."\n".	"Subject: ".$subj."\n".
"Content-type: text/html\; charset=UTF-8\n".	"Content-type: text/html\; charset=UTF-8\n".
"MIME-Version: 1.0\n\n";	"MIME-Version: 1.0\n\n";
if (open(my $fh,"<$statusdir/index.html")) {	if (open(my $fh,'<',"$statusdir/index.html")) {
while (<$fh>) {	while (<$fh>) {
$loncronmail .= $_;	$loncronmail .= $_;
}	}
Line 1383 sub usage {	Line 1705 sub usage {
loncron - housekeeping program that checks up on various parts of LON-CAPA	loncron - housekeeping program that checks up on various parts of LON-CAPA

Options:	Options:
--help Display	--help Display
--noemail Do not send the status email	--noemail Do not send the status email
--justcheckconnections Only check the current status of the lonc/d	--justcheckconnections Only check the current status of the lonc/d
connections, do not send emails do not	connections, do not send emails do not
Line 1397 Options:	Line 1719 Options:
do not send emails do not	do not send emails do not
check if the daemons are running, do not	check if the daemons are running, do not
generate lon-status	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	USAGE
}	}

# ================================================================ Main Program	# ================================================================ Main Program
sub main () {	sub main () {
my ($help,$justcheckdaemons,$noemail,$justcheckconnections,	my ($help,$justcheckdaemons,$noemail,$justcheckconnections,
$justreload);	$justreload,$justiptables);
&GetOptions("help" => \$help,	&GetOptions("help" => \$help,
"justcheckdaemons" => \$justcheckdaemons,	"justcheckdaemons" => \$justcheckdaemons,
"noemail" => \$noemail,	"noemail" => \$noemail,
"justcheckconnections" => \$justcheckconnections,	"justcheckconnections" => \$justcheckconnections,
"justreload" => \$justreload	"justreload" => \$justreload,
	"justiptables" => \$justiptables
);	);
if ($help) { &usage(); return; }	if ($help) { &usage(); return; }
# --------------------------------- Read loncapa_apache.conf and loncapa.conf	# --------------------------------- Read loncapa_apache.conf and loncapa.conf
Line 1424 sub main () {	Line 1750 sub main () {
if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {	if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
print("Unconfigured machine.\n");	print("Unconfigured machine.\n");
my $emailto=$perlvar{'lonSysEMail'};	my $emailto=$perlvar{'lonSysEMail'};
my $hostname=`/bin/hostname`;	my $hostname = Sys::Hostname::FQDN::fqdn();
chop $hostname;	$hostname=~s/\.+/./g;
$hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell	$hostname=~s/\-+/-/g;
	$hostname=~s/[^\w\.-]//g; # make sure is safe to pass through shell
my $subj="LON: Unconfigured machine $hostname";	my $subj="LON: Unconfigured machine $hostname";
system("echo 'Unconfigured machine $hostname.' \|".	system("echo 'Unconfigured machine $hostname.' \|".
" mail -s '$subj' $emailto > /dev/null");	" mail -s '$subj' $emailto > /dev/null");
Line 1437 sub main () {	Line 1764 sub main () {
my $wwwid=getpwnam('www');	my $wwwid=getpwnam('www');
if ($wwwid!=$<) {	if ($wwwid!=$<) {
print("User ID mismatch. This program must be run as user 'www'.\n");	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";	my $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
system("echo 'User ID mismatch. loncron must be run as user www.' \|".	system("echo 'User ID mismatch. loncron must be run as user www.' \|".
" mail -s '$subj' $emailto > /dev/null");	" mail -s '$subj' $emailto > /dev/null");
Line 1459 sub main () {	Line 1786 sub main () {
}	}
}	}
}	}
&Apache::lonnet::load_hosts_tab(1,$nomemcache);	if (!$justiptables) {
&Apache::lonnet::load_domain_tab(1,$nomemcache);	&Apache::lonnet::load_hosts_tab(1,$nomemcache);
&Apache::lonnet::get_iphost(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)) {	if ((!$justcheckdaemons) && (!$justreload)) {
my $now = time;	my $now = time;
my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'.	my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'.
$now.$$.int(rand(10000));	$now.$$.int(rand(10000));
if (open(my $fh,">$tmpfile")) {	if (open(my $fh,'>',"$tmpfile")) {
my %iphosts = &Apache::lonnet::get_iphost();	my %iphosts = &Apache::lonnet::get_iphost();
foreach my $key (keys(%iphosts)) {	foreach my $key (keys(%iphosts)) {
print $fh "$key\n";	print $fh "$key\n";
Line 1478 sub main () {	Line 1807 sub main () {
if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) {	if (&LONCAPA::try_to_lock('/tmp/lock_lciptables')) {
my $execpath = $perlvar{'lonDaemons'}.'/lciptables';	my $execpath = $perlvar{'lonDaemons'}.'/lciptables';
system("$execpath $tmpfile");	system("$execpath $tmpfile");
unlink('/tmp/lock_lciptables'); # Remove the lock file.	unlink('/tmp/lock_lciptables'); # Remove the lock file.
}	}
unlink($tmpfile);	unlink($tmpfile);
}	}
Line 1490 sub main () {	Line 1819 sub main () {
$warnings=0;	$warnings=0;
$notices=0;	$notices=0;


my $fh;	my $fh;
if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {	if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {
$fh=&start_logging();	$fh=&start_logging();

&log_machine_info($fh);	&log_machine_info($fh);
Line 1500 sub main () {	Line 1829 sub main () {
&clean_lonIDs($fh);	&clean_lonIDs($fh);
&clean_balanceIDs($fh);	&clean_balanceIDs($fh);
&clean_webDAV_sessionIDs($fh);	&clean_webDAV_sessionIDs($fh);
	&clean_ltiIDs($fh);
&check_httpd_logs($fh);	&check_httpd_logs($fh);
&rotate_lonnet_logs($fh);	&rotate_lonnet_logs($fh);
&rotate_other_logs($fh);	&rotate_other_logs($fh);
}	}
if (!$justcheckconnections && !$justreload) {	if (!$justcheckconnections && !$justreload && !$justiptables) {
&checkon_daemon($fh,'lonmemcached',40000);	&checkon_daemon($fh,'lonmemcached',40000);
&checkon_daemon($fh,'lonsql',200000);	&checkon_daemon($fh,'lonsql',200000);
if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {	if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {
Line 1518 sub main () {	Line 1848 sub main () {
&clean_nosslverify($fh);	&clean_nosslverify($fh);
&write_connection_config();	&write_connection_config();
&write_hosttypes();	&write_hosttypes();
&update_revocation_list();	&update_revocation_list();
&checkon_daemon($fh,'lond',40000,'USR2');	&checkon_daemon($fh,'lond',40000,'USR2');
&checkon_daemon($fh,'lonc',40000,'USR2');	&checkon_daemon($fh,'lonc',40000,'USR2');
}	}
if ($justcheckconnections) {	if ($justcheckconnections) {
&test_connections($fh);	&test_connections($fh);
}	}
if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {	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 $domconf = &get_domain_config();
my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) =	my ($threshold,$sysmail,$reportstatus,$weightsref,$exclusionsref) =
&get_permcount_settings($domconf);	&get_permcount_settings($domconf);
Line 1533 sub main () {	Line 1889 sub main () {
&write_loncaparevs();	&write_loncaparevs();
&write_serverhomeIDs();	&write_serverhomeIDs();
&write_checksums();	&write_checksums();
	&write_hostips();
my %sslrem = &clean_nosslverify($fh);	my %sslrem = &clean_nosslverify($fh);
my %conchgs = &write_connection_config();	my %conchgs = &write_connection_config();
my %hosttypechgs = &write_hosttypes();	my %hosttypechgs = &write_hosttypes();

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.116
changed lines
	Added in v.1.137