--- loncom/loncron 2024/07/10 04:11:41 1.103.2.15
+++ loncom/loncron 2020/01/11 22:37:19 1.121
@@ -2,7 +2,7 @@
# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# $Id: loncron,v 1.103.2.15 2024/07/10 04:11:41 raeburn Exp $
+# $Id: loncron,v 1.121 2020/01/11 22:37:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,21 +34,18 @@ use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
use LONCAPA::Checksumming;
use LONCAPA;
+use LONCAPA::LWPReq;
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 +78,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');
@@ -122,7 +119,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) { @@ -287,8 +272,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); @@ -310,7 +295,7 @@ sub start_logging { my %simplestatus=(); my $now=time; my $date=localtime($now); - + &log($fh,(< @@ -335,7 +320,6 @@ sub start_logging { lonc lonnet Connections -bash readline config Delayed Messages Error Count @@ -427,12 +411,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 +469,7 @@ sub recursive_clean_tmp { } } } elsif (ref($errors->{failopen}) eq 'ARRAY') { - push(@{$errors->{failopen}},$fname); + push(@{$errors->{failopen}},$fname); } } else { if (unlink($fname)) { @@ -511,38 +495,19 @@ 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)
"); @@ -556,7 +521,7 @@ sub clean_balanceIDs { my $cleaned=0; my $active=0; if (-d $perlvar{'lonBalanceDir'}) { - while (my $fname=<$perlvar{'lonBalanceDir'}/*.id>) { + while (my $fname=<$perlvar{'balanceDir'}/*.id>) { my ($dev,$ino,$mode,$nlink, $uid,$gid,$rdev,$size, $atime,$mtime,$ctime, @@ -602,6 +567,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)=@_; @@ -639,16 +632,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); @@ -779,14 +772,14 @@ sub check_delayed_msg { 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); + 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") { @@ -1018,7 +1011,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); }; @@ -1151,6 +1144,91 @@ sub write_hostips { return; } +sub clean_nosslverify { + my ($fh) = @_; + my %unlinked; + if (-d "$perlvar{'lonSockDir'}/nosslverify") { + if (opendir(my $dh,"$perlvar{'lonSockDir'}/nosslverify")) { + while (my $fname=readdir($dh)) { + next if ($fname =~ /^\.+$/); + if (unlink("/home/httpd/sockets/nosslverify/$fname")) { + &log($fh,"Unlinking $fname
"); + $unlinked{$fname} = 1; + } + } + closedir($dh); + } + } + &log($fh,"Removed ".scalar(keys(%unlinked))." nosslverify clients
"); + return %unlinked; +} +sub clean_lonc_childpids { + my $childpiddir = "$perlvar{'lonDocRoot'}/lon-status/loncchld"; + if (-d $childpiddir) { + if (opendir(my $dh,$childpiddir)) { + while (my $fname=readdir($dh)) { + next if ($fname =~ /^\.+$/); + unlink("$childpiddir/$fname"); + } + closedir($dh); + } + } +} + +sub write_connection_config { + my ($domconf,%connectssl,%changes); + $domconf = &get_domain_config(); + 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 (keys(%connectssl)) { + my %currconf; + if (open(my $fh,'<',"$perlvar{'lonTabDir'}/connectionrules.tab")) { + while (my $line = <$fh>) { + chomp($line); + my ($name,$value) = split(/=/,$line); + if ($value =~ /^(?:no|yes|req)$/) { + if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) { + $currconf{$name} = $value; + } + } + } + close($fh); + } + if (open(my $fh,'>',"$perlvar{'lonTabDir'}/connectionrules.tab")) { + my $count = 0; + foreach my $key (sort(keys(%connectssl))) { + print $fh "$key=$connectssl{$key}\n"; + if (exists($currconf{$key})) { + unless ($currconf{$key} eq $connectssl{$key}) { + $changes{$key} = 1; + } + } else { + $changes{$key} = 1; + } + $count ++; + } + close($fh); + 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 %changes; +} + sub get_domain_config { my ($dom,$primlibserv,$isprimary,$url,%confhash); $dom = $perlvar{'lonDefDomain'}; @@ -1184,10 +1262,8 @@ 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); + my $response=&LONCAPA::LWPReq::makerequest($primlibserv,$request,'',\%perlvar,5); unless ($response->is_error()) { my $content = $response->content; if ($content) { @@ -1208,6 +1284,121 @@ sub get_domain_config { return \%confhash; } +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'}}; + my %changes; + if (($dom ne '') && ($internetdom ne '')) { + if (keys(%hostdom)) { + my %currhosttypes; + if (open(my $fh,'<',"$perlvar{'lonTabDir'}/hosttypes.tab")) { + while (my $line = <$fh>) { + chomp($line); + my ($name,$value) = split(/:/,$line); + if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) { + $currhosttypes{$name} = $value; + } + } + close($fh); + } + 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"; + if (exists($currhosttypes{$lonid})) { + if ($type ne $currhosttypes{$lonid}) { + $changes{$lonid} = 1; + } + } else { + $changes{$lonid} = 1; + } + $count ++; + } + close($fh); + print "Completed writing host type data for $count hosts.\n"; + } + } else { + print "Writing of host types skipped - no hosts found.\n"; + } + } else { + print "Writing of host types skipped - could not determine this host's LON-CAPA domain or 'internet' domain.\n"; + } + return %changes; +} + +sub update_revocation_list { + my ($result,$changed) = &Apache::lonnet::fetch_crl_pemfile(); + if ($result eq 'ok') { + print "Certificate Revocation List (from CA) updated.\n"; + } else { + print "Certificate Revocation List from (CA) not updated.\n"; + } + return $changed; +} + +sub reset_nosslverify_pids { + my ($fh,%sslrem) = @_; + &checkon_daemon($fh,'lond',40000,'USR2'); + my $loncpidfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; + my $loncppid; + if ((-e $loncpidfile) && (open(my $pfh,'<',$loncpidfile))) { + $loncppid=<$pfh>; + chomp($loncppid); + close($pfh); + if ($loncppid =~ /^\d+$/) { + my %pids_by_host; + my $docdir = $perlvar{'lonDocRoot'}; + if (-d "$docdir/lon-status/loncchld") { + if (opendir(my $dh,"$docdir/lon-status/loncchld")) { + while (my $file = readdir($dh)) { + next if ($file =~ /^\./); + if (open(my $fh,'<',"$docdir/lon-status/loncchld/$file")) { + my $record = <$fh>; + chomp($record); + close($fh); + my ($remotehost,$authmode) = split(/:/,$record); + $pids_by_host{$remotehost}{$authmode}{$file} = 1; + } + } + closedir($dh); + if (keys(%pids_by_host)) { + foreach my $host (keys(%pids_by_host)) { + if ($sslrem{$host}) { + if (ref($pids_by_host{$host}) eq 'HASH') { + if (ref($pids_by_host{$host}{'insecure'}) eq 'HASH') { + if (keys(%{$pids_by_host{$host}{'insecure'}})) { + foreach my $pid (keys(%{$pids_by_host{$host}{'insecure'}})) { + if (open(PIPE,"ps -o ppid= -p $pid |")) { + my $ppid =; + chomp($ppid); + close(PIPE); + $ppid =~ s/(^\s+|\s+$)//g; + if (($ppid == $loncppid) && (kill 0 => $pid)) { + kill QUIT => $pid; + } + } + } + } + } + } + } + } + } + } + } + } + } + return; +} + sub get_permcount_settings { my ($domconf) = @_; my ($defaults,$names) = &Apache::loncommon::lon_status_items(); @@ -1264,98 +1455,6 @@ sub read_serverhomeIDs { return %server; } -sub check_bash_settings { - my $distro = &LONCAPA::distro(); - my ($check_bracketed_paste,$bracketed_warning); - if ($distro =~ /^debian(\d+)$/) { - if ($1 >= 12) { - $check_bracketed_paste = 1; - } - } elsif ($distro =~ /^ubuntu(\d+)$/) { - if ($1 >= 22) { - $check_bracketed_paste = 1; - } - } elsif ($distro =~ /^(?:redhat|oracle|alma|rocky|centos-stream)(\d+)$/) { - if ($1 >= 9) { - $check_bracketed_paste = 1; - } - } elsif ($distro =~ /^fedora(\d+)/) { - if ($1 >= 34) { - $check_bracketed_paste = 1; - } - } - if ($check_bracketed_paste) { - if (open(PIPE,"bind -V 2>&1 | grep enable-bracketed-paste |")) { - my $info = ; - chomp($info); - my ($bracketed) = ($info =~ /^\Qenable-bracketed-paste\E\s+is\s+set\s+to\s+\W(on|off)\W$/); - close(PIPE); - if ($bracketed eq 'on') { - $bracketed_warning = 1; - } - } else { - print "Unable to check if bracketed paste is set to off for www user's shell\n"; - } - } - return ($bracketed_warning,$check_bracketed_paste); -} - -sub set_bracketed_paste_off { - my $bash_www_cnf = '/home/www/.inputrc'; - my $result; - if (!-e $bash_www_cnf) { - system("touch $bash_www_cnf"); - if (open(my $cfh,'>',$bash_www_cnf)) { - print $cfh "set enable-bracketed-paste off\n"; - close($cfh); - $result = "Updated $bash_www_cnf"; - } 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); - if (open(my $cfh,'<',$bash_www_cnf)) { - while (my $line=<$cfh>) { - chomp($line); - if ($line =~ /^\s*set\s+enable\-bracketed\-paste\s+(off|on)\s*$/) { - if ($1 eq 'off') { - $bracketed_paste_off = 1; - } else { - $bracketed_paste_on = 1; - } - } else { - push(@preserve,$line); - } - } - close($cfh); - if ($bracketed_paste_on || !$bracketed_paste_off) { - if (open(my $cfh,'>',$bash_www_cnf)) { - print $cfh "set enable-bracketed-paste off\n"; - if (@preserve) { - foreach my $entry (@preserve) { - print $cfh "$entry\n"; - } - } - 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'"; - } - } else { - $result = "Could not open $bash_www_cnf to check if a value is included for 'enable-bracketed-paste'."; - } - } - return $result; -} - sub send_mail { my ($sysmail,$reportstatus) = @_; my $defdom = $perlvar{'lonDefDomain'}; @@ -1446,10 +1545,9 @@ 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"); @@ -1460,7 +1558,7 @@ sub main () { my $wwwid=getpwnam('www'); if ($wwwid!=$<) { print("User ID mismatch. This program must be run as user 'www'.\n"); - my $emailto="$perlvar{'lonAdmEMail'} $perlvar{'lonSysEMail'}"; + my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; my $subj="LON: $perlvar{'lonHostID'} User ID mismatch"; system("echo 'User ID mismatch. loncron must be run as user www.' |". " mail -s '$subj' $emailto > /dev/null"); @@ -1488,7 +1586,7 @@ sub main () { &Apache::lonnet::get_iphost(1,$nomemcache); } -# ----------------------------------------- Force firewall update for lond port +# ----------------------------------------- Force firewall update for lond port if ((!$justcheckdaemons) && (!$justreload)) { my $now = time; @@ -1503,7 +1601,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); } @@ -1515,7 +1613,7 @@ sub main () { $warnings=0; $notices=0; - + my $fh; if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) { $fh=&start_logging(); @@ -1525,6 +1623,7 @@ sub main () { &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); @@ -1540,6 +1639,10 @@ sub main () { &checkon_daemon($fh,'lonr',40000); } if ($justreload) { + &clean_nosslverify($fh); + &write_connection_config(); + &write_hosttypes(); + &update_revocation_list(); &checkon_daemon($fh,'lond',40000,'USR2'); &checkon_daemon($fh,'lonc',40000,'USR2'); } @@ -1547,32 +1650,25 @@ sub main () { &test_connections($fh); } if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) { - my ($bracketed_warning,$check_bracketed_paste) = &check_bash_settings(); - if ($check_bracketed_paste) { - &log($fh,' bash readline config
Bracketed Paste
'. - 'Distros using bash readline library 8.1 or later need bracketed paste disabled for www, so R commands sent to lon daemon will be processed.
'); - if ($bracketed_warning) { - 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); - &log_simplestatus(); &write_loncaparevs(); &write_serverhomeIDs(); &write_checksums(); &write_hostips(); + my %sslrem = &clean_nosslverify($fh); + my %conchgs = &write_connection_config(); + my %hosttypechgs = &write_hosttypes(); + my $hadcrlchg = &update_revocation_list(); + if ((keys(%conchgs) > 0) || (keys(%hosttypechgs) > 0) || + $hadcrlchg || (keys(%sslrem) > 0)) { + &checkon_daemon($fh,'lond',40000,'USR2'); + &reset_nosslverify_pids($fh,%sslrem); + } + &finish_logging($fh,$weightsref); + &log_simplestatus(); if ($totalcount>$threshold && !$noemail) { &send_mail($sysmail,$reportstatus); } } }