--- loncom/loncron 2024/10/24 22:24:26 1.103.2.17 +++ loncom/loncron 2017/02/28 05:42:06 1.104 @@ -2,7 +2,7 @@ # Housekeeping program, started by cron, loncontrol and loncron.pl # -# $Id: loncron,v 1.103.2.17 2024/10/24 22:24:26 raeburn Exp $ +# $Id: loncron,v 1.104 2017/02/28 05:42:06 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,18 +37,12 @@ use LONCAPA; use Apache::lonnet; use Apache::loncommon; -use LWP::UserAgent(); -use HTTP::Request(); use IO::File; use IO::Socket; use HTML::Entities; use Getopt::Long; -use GDBM_File qw(GDBM_READER); +use GDBM_File; use Storable qw(thaw); -use File::ReadBackwards; -use File::Copy; -use Sys::Hostname::FQDN(); - #globals use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount); @@ -81,14 +75,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,23 +113,20 @@ sub checkon_daemon { my $result; &log($fh,'

'.$daemon.'

Log

'); printf("%-15s ",$daemon); - if ($fh) { - if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){ - if (open(DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|")) { - while (my $line=) { - &log($fh,"$line"); - if ($line=~/INFO/) { $notices++; } - if ($line=~/WARNING/) { $notices++; } - if ($line=~/CRITICAL/) { $warnings++; } - } - close (DFH); - } - } - &log($fh,"

"); + if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){ + open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|"); + while (my $line=) { + &log($fh,"$line"); + if ($line=~/INFO/) { $notices++; } + if ($line=~/WARNING/) { $notices++; } + if ($line=~/CRITICAL/) { $warnings++; } + }; + close (DFH); } - + &log($fh,"

"); + my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid"; - + my $restartflag=1; my $daemonpid; if (-e $pidfile) { @@ -175,7 +166,7 @@ sub checkon_daemon { `killall -9 $kadaemon 2>&1`. '
'); &log($fh,"

$daemon not running, trying to start

"); - + if (&start_daemon($fh,$daemon,$pidfile,$args)) { &log($fh,"

$daemon at pid $daemonpid responding

"); $simplestatus{$daemon}='restarted'; @@ -200,22 +191,20 @@ sub checkon_daemon { &log($fh,"

Unable to start $daemon

"); } } - if ($fh) { - if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){ - &log($fh,"

");
-	        if (open(DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|")) {
-	            while (my $line=) { 
-		        &log($fh,"$line");
-		        if ($line=~/WARNING/) { $notices++; }
-		        if ($line=~/CRITICAL/) { $notices++; }
-	            }
-	            close (DFH);
-                }
-	        &log($fh,"

"); - } - } - } + if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){ + &log($fh,"

");
+	    open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/$daemon.log|");
+	    while (my $line=) { 
+		&log($fh,"$line");
+		if ($line=~/WARNING/) { $notices++; }
+		if ($line=~/CRITICAL/) { $notices++; }
+	    };
+	    close (DFH);
+	    &log($fh,"

"); + } + } + my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log"; &rotate_logfile($fname,$fh,'logs'); @@ -228,34 +217,19 @@ 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]>$loadtarget{'error'}) { + if ($parts[1]>4.0) { $errors++; - } elsif ($parts[1]>$loadtarget{'warn'}) { + } elsif ($parts[1]>2.0) { $warnings++; - } elsif ($parts[1]>$loadtarget{'note'}) { + } elsif ($parts[1]>1.0) { $notices++; } @@ -263,14 +237,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) {
@@ -287,8 +261,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);
@@ -307,10 +281,10 @@ sub log_machine_info {
 
 sub start_logging {
     my $fh=IO::File->new(">$statusdir/newstatus.html");
-    %simplestatus=();
+    my %simplestatus=();
     my $now=time;
     my $date=localtime($now);
-
+    
 
     &log($fh,(<
@@ -335,7 +309,6 @@ sub start_logging {
 
  • lonc
  • lonnet
  • Connections
  • -
  • bash readline config
  • Delayed Messages
  • Error Count
  • @@ -427,12 +400,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/}) { @@ -485,7 +458,7 @@ sub recursive_clean_tmp { } } } elsif (ref($errors->{failopen}) eq 'ARRAY') { - push(@{$errors->{failopen}},$fname); + push(@{$errors->{failopen}},$fname); } } else { if (unlink($fname)) { @@ -511,71 +484,24 @@ sub clean_lonIDs { my $cleaned=0; my $active=0; while (my $fname=<$perlvar{'lonIDsDir'}/*>) { - 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++; - } - } + 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 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)=@_; @@ -639,16 +565,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);
    @@ -712,199 +638,29 @@ sub test_connections {
     
     # ------------------------------------------------------------ Delayed messages
     sub check_delayed_msg {
    -    my ($fh,$weightsref,$exclusionsref)=@_;
    +    my ($fh)=@_;
         &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 $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(); - } - } -# -# 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; + my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log"); + while (my $line=<$dfh>) { + my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line); + 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++; } } - 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; - } + &log($fh,"

    Total unsend messages: $unsend

    \n"); + if ($unsend > 0) { + $warnings=$warnings+5*$unsend; } if ($unsend) { $simplestatus{'unsend'}=$unsend; } @@ -919,6 +675,8 @@ sub check_delayed_msg { } &log($fh,"
    \n"); close (DFH); + my %hostname = &Apache::lonnet::all_hostnames(); + my $numhosts = scalar(keys(%hostname)); # pong to all servers that have delayed messages # this will trigger a reverse connection, which should flush the buffers foreach my $tryserver (sort(keys(%servers))) { @@ -943,13 +701,9 @@ sub check_delayed_msg { } sub finish_logging { - my ($fh,$weightsref)=@_; - my %weights; - if (ref($weightsref) eq 'HASH') { - %weights = %{$weightsref}; - } + my ($fh)=@_; &log($fh,"\n"); - $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors); + $totalcount=$notices+4*$warnings+100*$errors; &errout($fh); &log($fh,"

    Total Error Count: $totalcount

    "); my $now=time; @@ -968,15 +722,11 @@ sub log_simplestatus { rename("$statusdir/newstatus.html","$statusdir/index.html"); my $sfh=IO::File->new(">$statusdir/loncron_simple.txt"); - 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"; + foreach (keys %simplestatus) { + print $sfh $_.'='.$simplestatus{$_}.'&'; } + print $sfh "\n"; + $sfh->close(); } sub write_loncaparevs { @@ -1002,12 +752,10 @@ 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; @@ -1024,7 +772,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); }; @@ -1040,12 +788,10 @@ 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; @@ -1071,112 +817,54 @@ 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); - } else { - print "Could not write to $lontabdir/currhostips.tab\n"; +sub write_connection_config { + my ($isprimary,$domconf,$url,%connectssl); + 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'; } - 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}; + my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary, + $url); + if (ref($domconf) eq 'HASH') { + if (ref($domconf->{'ssl'}) eq 'HASH') { + foreach my $connect ('connto','connfrom') { + if (ref($domconf->{'ssl'}->{$connect}) eq 'HASH') { + my ($sslreq,$sslnoreq,$currsetting); + my %contypes; + foreach my $type ('dom','intdom','other') { + $connectssl{$connect.'_'.$type} = $domconf->{'ssl'}->{$connect}->{$type}; + } + } } } - } - 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"; + if (keys(%connectssl)) { + if (open(my $fh,">$perlvar{'lonTabDir'}/connectionrules.tab")) { + my $count = 0; + foreach my $key (sort(keys(%connectssl))) { + print $fh "$key=$connectssl{$key}\n"; + $count ++; } - 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"; - } + print "Completed writing SSL options for lonc/lond for $count items.\n"; } + } else { + print "Writing of SSL options skipped - no connection rules in domain configuration.\n"; } + } else { + print "Retrieval of SSL options for lonc/lond skipped - no configuration data available for domain.\n"; } - return; } sub get_domain_config { - 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'; - } + my ($dom,$primlibserv,$isprimary,$url) = @_; + my %confhash; if ($isprimary) { my $lonusersdir = $perlvar{'lonUsersDir'}; my $fname = $lonusersdir.'/'.$dom.'/configuration.db'; @@ -1196,14 +884,14 @@ sub get_domain_config { } } } else { - my $ua=new LWP::UserAgent; - $ua->timeout(5); - my $request=new HTTP::Request('GET',$url); - my $response=$ua->request($request); - unless ($response->is_error()) { - my $content = $response->content; - if ($content) { - my @pairs=split(/\&/,$content); + if (open(PIPE,"wget --no-check-certificate '$url?primary=$primlibserv&format=raw' |")) { + my $config = ''; + while () { + $config .= $_; + } + close(PIPE); + if ($config) { + my @pairs=split(/\&/,$config); foreach my $item (@pairs) { my ($key,$value)=split(/=/,$item,2); my $what = &LONCAPA::unescape($key); @@ -1220,221 +908,42 @@ sub get_domain_config { return \%confhash; } -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}; - } +sub write_hosttypes { + my %intdom = &Apache::lonnet::all_host_intdom(); + my %hostdom = &Apache::lonnet::all_host_domain(); + my $dom = $hostdom{$perlvar{'lonHostID'}}; + my $internetdom = $intdom{$perlvar{'lonHostID'}}; + if (($dom ne '') && ($internetdom ne '')) { + if (keys(%hostdom)) { + if (open(my $fh,">$perlvar{'lonTabDir'}/hosttypes.tab")) { + my $count = 0; + foreach my $lonid (sort(keys(%hostdom))) { + my $type = 'other'; + if ($hostdom{$lonid} eq $dom) { + $type = 'dom'; + } elsif ($intdom{$lonid} eq $internetdom) { + $type = 'intdom'; } + print $fh "$lonid:$type\n"; + $count ++; } - 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; + close($fh); + print "Completed writing host type data for $count hosts.\n"; } } 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); + print "Writing of host types skipped - no hosts found.\n"; } } 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'"; - } + print "Writing of host types skipped - could not determine this host's LON-CAPA domain or 'internet' domain.\n"; } - 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>$sysmail) && ($reportstatus)) { + if ($totalcount>2500) { $emailto.=",$perlvar{'lonSysEMail'}"; } my $from; @@ -1450,7 +959,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 .= $_; } @@ -1487,23 +996,19 @@ 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,$justiptables); + $justreload); &GetOptions("help" => \$help, "justcheckdaemons" => \$justcheckdaemons, "noemail" => \$noemail, "justcheckconnections" => \$justcheckconnections, - "justreload" => \$justreload, - "justiptables" => \$justiptables + "justreload" => \$justreload ); if ($help) { &usage(); return; } # --------------------------------- Read loncapa_apache.conf and loncapa.conf @@ -1518,13 +1023,12 @@ sub main () { if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) { print("Unconfigured machine.\n"); my $emailto=$perlvar{'lonSysEMail'}; - 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 $hostname=`/bin/hostname`; + chop $hostname; + $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"); + system("echo 'Unconfigured machine $hostname.' |\ + mailto $emailto -s '$subj' > /dev/null"); exit 1; } @@ -1532,10 +1036,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.' |". - " mail -s '$subj' $emailto > /dev/null"); + system("echo 'User ID mismatch. loncron must be run as user www.' |\ + mailto $emailto -s '$subj' > /dev/null"); exit 1; } @@ -1554,19 +1058,17 @@ sub main () { } } } - if (!$justiptables) { - &Apache::lonnet::load_hosts_tab(1,$nomemcache); - &Apache::lonnet::load_domain_tab(1,$nomemcache); - &Apache::lonnet::get_iphost(1,$nomemcache); - } + &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; 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"; @@ -1575,7 +1077,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); } @@ -1587,21 +1089,20 @@ sub main () { $warnings=0; $notices=0; - + my $fh; - if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) { + if (!$justcheckdaemons && !$justcheckconnections && !$justreload) { $fh=&start_logging(); &log_machine_info($fh); &clean_tmp($fh); &clean_lonIDs($fh); - &clean_balanceIDs($fh); &clean_webDAV_sessionIDs($fh); &check_httpd_logs($fh); &rotate_lonnet_logs($fh); &rotate_other_logs($fh); } - if (!$justcheckconnections && !$justreload && !$justiptables) { + if (!$justcheckconnections && !$justreload) { &checkon_daemon($fh,'lonmemcached',40000); &checkon_daemon($fh,'lonsql',200000); if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') { @@ -1612,50 +1113,24 @@ sub main () { &checkon_daemon($fh,'lonr',40000); } if ($justreload) { + &write_connection_config(); + &write_hosttypes(); &checkon_daemon($fh,'lond',40000,'USR2'); &checkon_daemon($fh,'lonc',40000,'USR2'); } if ($justcheckconnections) { &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); - &check_delayed_msg($fh,$weightsref,$exclusionsref); - &finish_logging($fh,$weightsref); + if (!$justcheckdaemons && !$justcheckconnections && !$justreload) { + &check_delayed_msg($fh); + &finish_logging($fh); &log_simplestatus(); &write_loncaparevs(); &write_serverhomeIDs(); &write_checksums(); - &write_hostips(); - if ($totalcount>$threshold && !$noemail) { &send_mail($sysmail,$reportstatus); } + &write_connection_config(); + &write_hosttypes(); + if ($totalcount>200 && !$noemail) { &send_mail(); } } }