--- loncom/loncron 2004/05/11 19:15:03 1.47 +++ loncom/loncron 2019/07/18 18:28:40 1.119 @@ -2,7 +2,7 @@ # Housekeeping program, started by cron, loncontrol and loncron.pl # -# $Id: loncron,v 1.47 2004/05/11 19:15:03 albertel Exp $ +# $Id: loncron,v 1.119 2019/07/18 18:28:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,34 +28,30 @@ # $|=1; +use strict; use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; +use LONCAPA::Checksumming; +use LONCAPA; +use LONCAPA::LWPReq; +use Apache::lonnet; +use Apache::loncommon; use IO::File; use IO::Socket; -use strict; +use HTML::Entities; +use Getopt::Long; +use GDBM_File; +use Storable qw(thaw); +use File::ReadBackwards; +use File::Copy; #globals use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount); my $statusdir="/home/httpd/html/lon-status"; -# -------------------------------------------------- Non-critical communication -sub reply { - my ($cmd,$server)=@_; - my $peerfile="$perlvar{'lonSockDir'}/$server"; - my $client=IO::Socket::UNIX->new(Peer =>"$peerfile", - Type => SOCK_STREAM, - Timeout => 10) - or return "con_lost"; - print $client "$cmd\n"; - my $answer=<$client>; - chomp($answer); - if (!$answer) { $answer="con_lost"; } - return $answer; -} - # --------------------------------------------------------- Output error status sub log { @@ -66,56 +62,74 @@ sub log { sub errout { my $fh=shift; &log($fh,(< +
-
Notices$notices
Warnings$warnings
Errors$errors

Top

+

Top

ENDERROUT } +sub rotate_logfile { + my ($file,$fh,$description) = @_; + my $size=(stat($file))[7]; + if ($size>40000) { + &log($fh,"

Rotating $description ...

"); + rename("$file.2","$file.3"); + rename("$file.1","$file.2"); + rename("$file","$file.1"); + } +} + sub start_daemon { - my ($fh,$daemon,$pidfile) = @_; + my ($fh,$daemon,$pidfile,$args) = @_; my $progname=$daemon; - if ($daemon eq 'lonc' && $ARGV[0] eq 'new') { + if ($daemon eq 'lonc') { $progname='loncnew'; - print "new "; } - system("$perlvar{'lonDaemons'}/$progname 2>>$perlvar{'lonDaemons'}/logs/${daemon}_errors"); - sleep 2; + my $error_fname="$perlvar{'lonDaemons'}/logs/${daemon}_errors"; + &rotate_logfile($error_fname,$fh,'error logs'); + if ($daemon eq 'lonc') { + &clean_sockets($fh); + } + system("$perlvar{'lonDaemons'}/$progname 2>$perlvar{'lonDaemons'}/logs/${daemon}_errors"); + sleep 1; if (-e $pidfile) { - &log($fh,"Seems like it started ...

"); + &log($fh,"

Seems like it started ...

"); my $lfh=IO::File->new("$pidfile"); my $daemonpid=<$lfh>; chomp($daemonpid); - sleep 2; - if (kill 0 => $daemonpid) { + if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) { return 1; } else { return 0; } } - &log($fh,"Seems like that did not work!

"); + &log($fh,"

Seems like that did not work!

"); $errors++; return 0; } sub checkon_daemon { - my ($fh,$daemon,$maxsize,$sendusr1)=@_; + my ($fh,$daemon,$maxsize,$send,$args)=@_; - &log($fh,'

'.$daemon.'

Log

');
-    printf("%-10s ",$daemon);
-    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);
+    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,"
");
     }
-    &log($fh,"
"); my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid"; @@ -125,13 +139,20 @@ sub checkon_daemon { my $lfh=IO::File->new("$pidfile"); $daemonpid=<$lfh>; chomp($daemonpid); - if (kill 0 => $daemonpid) { + if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) { &log($fh,"

$daemon at pid $daemonpid responding"); - if ($sendusr1) { &log($fh,", sending USR1"); } + if ($send) { &log($fh,", sending $send"); } &log($fh,"

"); - if ($sendusr1) { kill USR1 => $daemonpid; } + if ($send eq 'USR1') { kill USR1 => $daemonpid; } + if ($send eq 'USR2') { kill USR2 => $daemonpid; } $restartflag=0; - print "running\n"; + if ($send eq 'USR2') { + $result = 'reloaded'; + print "reloaded\n"; + } else { + $result = 'running'; + print "running\n"; + } } else { $errors++; &log($fh,"

$daemon at pid $daemonpid not responding

"); @@ -142,70 +163,70 @@ sub checkon_daemon { if ($restartflag==1) { $simplestatus{$daemon}='off'; $errors++; - &log($fh,'
Killall '.$daemon.': '. - `killall $daemon 2>&1`.' - '); - sleep 2; + my $kadaemon=$daemon; + if ($kadaemon eq 'lonmemcached') { $kadaemon='memcached'; } + &log($fh,'
Killall '.$daemon.': '. + `killall $kadaemon 2>&1`.' - '); + sleep 1; &log($fh,unlink($pidfile).' - '. - `killall -9 $daemon 2>&1`. - '
'); + `killall -9 $kadaemon 2>&1`. + '
'); + if ($kadaemon eq 'loncnew') { + &clean_lonc_childpids(); + } &log($fh,"

$daemon not running, trying to start

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

$daemon at pid $daemonpid responding

"); $simplestatus{$daemon}='restarted'; + $result = 'started'; print "started\n"; } else { $errors++; &log($fh,"

$daemon at pid $daemonpid not responding

"); - &log($fh,"Give it one more try ...

"); + &log($fh,"

Give it one more try ...

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

$daemon at pid $daemonpid responding

"); $simplestatus{$daemon}='restarted'; + $result = 'started'; print "started\n"; } else { + $result = 'failed'; print " failed\n"; $simplestatus{$daemon}='failed'; $errors++; $errors++; &log($fh,"

$daemon at pid $daemonpid not responding

"); - &log($fh,"Unable to start $daemon

"); + &log($fh,"

Unable to start $daemon

"); } } - - 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,"
"); + 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,"

"); + } } } my $fname="$perlvar{'lonDaemons'}/logs/$daemon.log"; - - my ($dev,$ino,$mode,$nlink, - $uid,$gid,$rdev,$size, - $atime,$mtime,$ctime, - $blksize,$blocks)=stat($fname); - - if ($size>$maxsize) { - &log($fh,"Rotating logs ...

"); - rename("$fname.2","$fname.3"); - rename("$fname.1","$fname.2"); - rename("$fname","$fname.1"); - } + &rotate_logfile($fname,$fh,'logs'); &errout($fh); + return $result; } # --------------------------------------------------------------------- Machine sub log_machine_info { my ($fh)=@_; - &log($fh,'

Machine Information

'); + &log($fh,'

Machine Information

'); &log($fh,"

loadavg

"); open (LOADAVGH,"/proc/loadavg"); @@ -228,7 +249,7 @@ sub log_machine_info { open (DFH,"df|"); while (my $line=) { - &log($fh,"$line"); + &log($fh,&encode_entities($line,'<>&"')); @parts=split(/\s+/,$line); my $usage=$parts[4]; $usage=~s/\W//g; @@ -250,9 +271,9 @@ sub log_machine_info { &log($fh,"
");
     my $psproc=0;
 
-    open (PSH,"ps -aux --cols 140 |");
+    open (PSH,"ps aux --cols 140 |");
     while (my $line=) { 
-	&log($fh,"$line"); 
+	&log($fh,&encode_entities($line,'<>&"')); 
 	$psproc++;
     }
     close (PSH);
@@ -261,11 +282,15 @@ sub log_machine_info {
     if ($psproc>200) { $notices++; }
     if ($psproc>250) { $notices++; }
 
+    &log($fh,"
distprobe
");
+    &log($fh,"
");
+    &log($fh,&encode_entities(&LONCAPA::distro(),'<>&"'));
+    &log($fh,"
");
+
     &errout($fh);
 }
 
 sub start_logging {
-    my ($hostdom,$hostrole,$hostname,$spareid)=@_;
     my $fh=IO::File->new(">$statusdir/newstatus.html");
     my %simplestatus=();
     my $now=time;
@@ -273,91 +298,200 @@ sub start_logging {
     
 
     &log($fh,(<
+
+
 
 LON Status Report $perlvar{'lonHostID'}
+
 
 
-
+
 
LON Status Report $perlvar{'lonHostID'}

 
$date ($now)

 
    
-
  1. Configuration
-
  2. Machine Information
-
  3. Temporary Files
-
  4. Session Tokens
-
  5. httpd
-
  6. lonsql
-
  7. lond
-
  8. lonc
-
  9. lonhttpd
-
  10. lonnet
-
  11. Connections
-
  12. Delayed Messages
-
  13. Error Coindex.html.unt
+
  14. Configuration
    15. 
+
  15. Machine Information
    16. 
+
  16. Temporary Files
    17. 
+
  17. Session Tokens
    18. 
+
  18. WebDAV Session Tokens
    19. 
+
  19. httpd
    20. 
+
  20. lonsql
    21. 
+
  21. lond
    22. 
+
  22. lonc
    23. 
+
  23. lonnet
    24. 
+
  24. Connections
    25. 
+
  25. Delayed Messages
    26. 
+
  26. Error Count
    27. 
 

-

-
+

+
 
Configuration

 
PerlVars

-
+

 ENDHEADERS
 
     foreach my $varname (sort(keys(%perlvar))) {
-	&log($fh,"\n");
+	&log($fh,"\n");
     }
-    &log($fh,"
$varname$perlvar{$varname}
$varname".
+	     &encode_entities($perlvar{$varname},'<>&"')."
Hosts
");
-    foreach my $id (sort(keys(%{$hostname}))) {
+    &log($fh,"
Hosts
");
+    my %hostname = &Apache::lonnet::all_hostnames();
+    foreach my $id (sort(keys(%hostname))) {
+	my $role = (&Apache::lonnet::is_library($id) ? 'library'
+		                                     : 'access');
 	&log($fh,
-	    "\n");
-    }
-    &log($fh,"
$id".$hostdom->{$id}.
-	    "".$hostrole->{$id}.
-	    "".$hostname->{$id}."
Spare Hosts
    ");
-    foreach my $id (sort(keys(%{$spareid}))) {
-	&log($fh,"
  1. $id\n");
+	    "$id".&Apache::lonnet::host_domain($id).
+	    "".$role.
+	    "".&Apache::lonnet::hostname($id)."\n");
+    }
+    &log($fh,"
    Spare Hosts
    ");
+    if (keys(%Apache::lonnet::spareid) > 0) {
+        &log($fh,"
      ");
+        foreach my $type (sort(keys(%Apache::lonnet::spareid))) {
+	    &log($fh,"
    • $type\n
        ");
+	    foreach my $id (@{ $Apache::lonnet::spareid{$type} }) {
+	        &log($fh,"
      1. $id
        2. \n");
+	    }
+	    &log($fh,"
      \n
      • \n");
+        }
+        &log($fh,"
    \n");
+    } else {
+        &log($fh,"No spare hosts specified
    \n");
     }
-    &log($fh,"
\n");
     return $fh;
 }
 
 # --------------------------------------------------------------- clean out tmp
 sub clean_tmp {
     my ($fh)=@_;
-    &log($fh,'
Temporary Files
');
-    my $cleaned=0;
-    my $old=0;
-    while (my $fname=<$perlvar{'lonDaemons'}/tmp/*>) {
-	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'}) {
-	    my $line='';
-	    if (open(PROBE,$fname)) {
-		$line=;
-		close(PROBE);
-	    }
-	    unless ($line=~/^CHECKOUTTOKEN\&/) {
-		$cleaned++;
-		unlink("$fname");
-	    } else {
-		if ($since>365*$perlvar{'lonExpire'}) {
-		    $cleaned++;
-		    unlink("$fname");
-		} else { $old++; }
-	    }
-	}
+    &log($fh,'
Temporary Files
');
+    my ($cleaned,$old,$removed) = (0,0,0);
+    my %errors = (
+                     dir       => [],
+                     file      => [],
+                     failopen  => [],
+                 );
+    my %error_titles = (
+                         dir       => 'failed to remove empty directory:',
+                         file      => 'failed to unlike stale file',
+                         failopen  => 'failed to open file or directory'
+                       );
+    ($cleaned,$old,$removed) = &recursive_clean_tmp('',$cleaned,$old,$removed,\%errors);
+    &log($fh,"Cleaned up: ".$cleaned." files; removed: $removed empty directories; (found: $old old checkout tokens)");
+    foreach my $key (sort(keys(%errors))) {
+        if (ref($errors{$key}) eq 'ARRAY') {
+            if (@{$errors{$key}} > 0) {
+                &log($fh,"Error during cleanup ($error_titles{$key}):
  • ".
+                     join('
  • ',@{$errors{$key}}).'

');
+            }
+        }
     }
-    &log($fh,"Cleaned up ".$cleaned." files (".$old." old checkout tokens).");
+}
+
+sub recursive_clean_tmp {
+    my ($subdir,$cleaned,$old,$removed,$errors) = @_;
+    my $base = "$perlvar{'lonDaemons'}/tmp";
+    my $path = $base;
+    next if ($subdir =~ m{\.\./});
+    next unless (ref($errors) eq 'HASH');
+    unless ($subdir eq '') {
+        $path .= '/'.$subdir;
+    }
+    if (opendir(my $dh,"$path")) {
+        while (my $file = readdir($dh)) {
+            next if ($file =~ /^\.\.?$/);
+            my $fname = "$path/$file";
+            if (-d $fname) {
+                my $innerdir;
+                if ($subdir eq '') {
+                    $innerdir = $file;
+                } else {
+                    $innerdir = $subdir.'/'.$file;
+                }
+                ($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";    
+                        if (scalar(grep {!/^\.\.?$/} readdir($dirhandle)) == 0) {
+                            closedir($dirhandle);
+                            if ($fname =~ m{^\Q$perlvar{'lonDaemons'}\E/tmp/}) {
+                                if (rmdir($fname)) {
+                                    $removed ++;
+                                } elsif (ref($errors->{dir}) eq 'ARRAY') {
+                                    push(@{$errors->{dir}},$fname);
+                                }
+                            }
+                        }
+                    } else {
+                        closedir($dirhandle);
+                    }
+                }
+            } else {
+                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'}) {
+                    if ($subdir eq '') {
+                        my $line='';
+                        if ($fname =~ /\.db$/) {
+                            if (unlink($fname)) {
+                                $cleaned++;
+                            } elsif (ref($errors->{file}) eq 'ARRAY') {
+                                push(@{$errors->{file}},$fname);
+                            }
+                        } elsif (open(PROBE,$fname)) {
+                            my $line='';
+                            $line=;
+                            close(PROBE);
+                            if ($line=~/^CHECKOUTTOKEN\&/) {
+                                if ($since>365*$perlvar{'lonExpire'}) {
+                                    if (unlink($fname)) {
+                                        $cleaned++; 
+                                    } elsif (ref($errors->{file}) eq 'ARRAY') {
+                                        push(@{$errors->{file}},$fname);
+                                    }
+                                } else {
+                                    $old++;
+                                }
+                            } else {
+                                if (unlink($fname)) {
+                                    $cleaned++;
+                                } elsif (ref($errors->{file}) eq 'ARRAY') {
+                                    push(@{$errors->{file}},$fname);
+                                }
+                            }
+                        } elsif (ref($errors->{failopen}) eq 'ARRAY') {
+                            push(@{$errors->{failopen}},$fname); 
+                        }
+                    } else {
+                        if (unlink($fname)) {
+                            $cleaned++;
+                        } elsif (ref($errors->{file}) eq 'ARRAY') {
+                            push(@{$errors->{file}},$fname);
+                        }
+                    }
+                }
+            }
+        }
+        closedir($dh);
+    } elsif (ref($errors->{failopen}) eq 'ARRAY') {
+        push(@{$errors->{failopen}},$path);
+    }
+    return ($cleaned,$old,$removed);
 }
 
 # ------------------------------------------------------------ clean out lonIDs
 sub clean_lonIDs {
     my ($fh)=@_;
-    &log($fh,'
Session Tokens
');
+    &log($fh,'
Session Tokens
');
     my $cleaned=0;
     my $active=0;
     while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
@@ -369,48 +503,137 @@ sub clean_lonIDs {
 	my $since=$now-$mtime;
 	if ($since>$perlvar{'lonExpire'}) {
 	    $cleaned++;
-	    &log($fh,"Unlinking $fname
");
+	    &log($fh,"Unlinking $fname
");
 	    unlink("$fname");
 	} else {
 	    $active++;
 	}
     }
-    &log($fh,"
Cleaned up ".$cleaned." stale session token(s).");
+    &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{'balanceDir'}/*.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)=@_;
+    if ($perlvar{'lonRole'} eq 'library') {
+        &log($fh,'
WebDAV Session Tokens
');
+        my $cleaned=0;
+        my $active=0;
+        my $now = time;
+        if (-d $perlvar{'lonDAVsessDir'}) {
+            while (my $fname=<$perlvar{'lonDAVsessDir'}/*>) {
+                my @stats = stat($fname);
+                my $since=$now-$stats[9];
+                if ($since>$perlvar{'lonExpire'}) {
+                    $cleaned++;
+                    &log($fh,"Unlinking $fname
");
+                    unlink("$fname");
+                } else {
+                    $active++;
+                }
+            }
+            &log($fh,"
Cleaned up ".$cleaned." stale webDAV session token(s).
");
+            &log($fh,"
$active open webDAV session(s)
");
+        }
+    }
+}
+
+# ------------------------------------------------------------ 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)=@_;
+    my $cleaned=0;
+    opendir(SOCKETS,$perlvar{'lonSockDir'});
+    while (my $fname=readdir(SOCKETS)) {
+	next if (-d $fname 
+		 || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
+	$cleaned++;
+	&log($fh,"Unlinking $fname
");
+	unlink("/home/httpd/sockets/$fname");
+    }
+    &log($fh,"
Cleaned up ".$cleaned." stale sockets.
");
+}
+
 
 # ----------------------------------------------------------------------- httpd
 sub check_httpd_logs {
     my ($fh)=@_;
-    &log($fh,'
httpd
Access Log
');
-    
-    open (DFH,"tail -n25 /etc/httpd/logs/access_log|");
-    while (my $line=) { &log($fh,"$line") };
-    close (DFH);
-	
-    &log($fh,"
Error Log
");
-	
-    open (DFH,"tail -n25 /etc/httpd/logs/error_log|");
-    while (my $line=) { 
-	&log($fh,"$line");
-	if ($line=~/\[error\]/) { $notices++; } 
+    if (open(PIPE,"./lchttpdlogs|")) {
+        while (my $line=) {
+            &log($fh,$line);
+            if ($line=~/\[error\]/) { $notices++; }
+        }
+        close(PIPE);
     }
-    close (DFH);
-    &log($fh,"
");
     &errout($fh);
 }
 
 # ---------------------------------------------------------------------- lonnet
 
-sub rotate_logs {
+sub rotate_lonnet_logs {
     my ($fh)=@_;
-    &log($fh,'
lonnet
Temp Log
');
-    print "checking logs\n";
+    &log($fh,'
lonnet
Temp Log
');
+    print "Checking logs.\n";
     if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
 	open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
 	while (my $line=) { 
-	    &log($fh,"$line");
+	    &log($fh,&encode_entities($line,'<>&"'));
 	}
 	close (DFH);
     }
@@ -419,100 +642,313 @@ sub rotate_logs {
     if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
 	open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
 	while (my $line=) { 
-	    &log($fh,"$line");
+	    &log($fh,&encode_entities($line,'<>&"'));
 	}
 	close (DFH);
     } else { &log($fh,"No perm log\n") }
 
     my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
-
-    my ($dev,$ino,$mode,$nlink,
-	$uid,$gid,$rdev,$size,
-	$atime,$mtime,$ctime,
-	$blksize,$blocks)=stat($fname);
-
-    if ($size>40000) {
-	&log($fh,"Rotating logs ...
");
-	rename("$fname.2","$fname.3");
-	rename("$fname.1","$fname.2");
-	rename("$fname","$fname.1");
-    }
+    &rotate_logfile($fname,$fh,'lonnet log');
 
     &log($fh,"
");
     &errout($fh);
 }
 
+sub rotate_other_logs {
+    my ($fh) = @_;
+    my %logs = (
+                  autoenroll          => 'Auto Enroll log',
+                  autocreate          => 'Create Course log',
+                  searchcat           => 'Search Cataloguing log',
+                  autoupdate          => 'Auto Update log',
+                  refreshcourseids_db => 'Refresh CourseIDs db log',
+               );
+    foreach my $item (keys(%logs)) {
+        my $fname=$perlvar{'lonDaemons'}.'/logs/'.$item.'.log';
+        &rotate_logfile($fname,$fh,$logs{$item});
+    }
+}
+
 # ----------------------------------------------------------------- Connections
 sub test_connections {
-    my ($fh,$hostname)=@_;
-    &log($fh,'
Connections
');
-    print "testing connections\n";
-    &log($fh,"");
-    foreach my $tryserver (sort(keys(%{$hostname}))) {
+    my ($fh)=@_;
+    &log($fh,'
Connections
');
+    print "Testing connections.\n";
+    &log($fh,"
");
+    my ($good,$bad)=(0,0);
+    my %hostname = &Apache::lonnet::all_hostnames();
+    foreach my $tryserver (sort(keys(%hostname))) {
 	print(".");
 	my $result;
-	my $answer=reply("pong",$tryserver);
+	my $answer=&Apache::lonnet::reply("ping",$tryserver);
 	if ($answer eq "$tryserver:$perlvar{'lonHostID'}") {
 	    $result="ok";
+	    $good++;
 	} else {
 	    $result=$answer;
 	    $warnings++;
-	    if ($answer eq 'con_lost') { $warnings++; }
+	    if ($answer eq 'con_lost') {
+		$bad++;
+		$warnings++;
+	    } else {
+		$good++; #self connection
+	    }
 	}
 	if ($answer =~ /con_lost/) { print(" $tryserver down\n"); }
 	&log($fh,"\n");
     }
     &log($fh,"
$tryserver$result
");
-
+    print "\n$good good, $bad bad connections\n";
     &errout($fh);
 }
 
 
 # ------------------------------------------------------------ Delayed messages
 sub check_delayed_msg {
-    my ($fh)=@_;
-    &log($fh,'
Delayed Messages
');
-    print "checking buffers\n";
+    my ($fh,$weightsref,$exclusionsref)=@_;
+    &log($fh,'
Delayed Messages
');
+    print "Checking buffers.\n";
     
     &log($fh,'
Scanning Permanent Log
');
 
     my $unsend=0;
+    my $ignored=0;
 
-    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++; }
+    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();
+        }
     }
 
-    &log($fh,"Total unsend messages: $unsend
\n");
-    $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; }
-    &log($fh,"
Outgoing Buffer
");
-
+    &log($fh,"
Outgoing Buffer
\n
");
+# list directory with delayed messages and remember offline servers
+    my %servers=();
     open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|");
-    while (my $line=) { 
-	&log($fh,"$line
");
+    while (my $line=) {
+        my ($server)=($line=~/\.(\w+)$/);
+        if ($server) { $servers{$server}=1; }
+	&log($fh,&encode_entities($line,'<>&"'));
     }
+    &log($fh,"
\n");
     close (DFH);
+# 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))) {
+        if ($hostname{$tryserver} || !$numhosts) {
+            my $answer;
+            eval {
+                local $SIG{ ALRM } = sub { die "TIMEOUT" };
+                alarm(20);
+                $answer = &Apache::lonnet::reply("pong",$tryserver);
+                alarm(0);
+            };
+            if ($@ && $@ =~ m/TIMEOUT/) {
+                &log($fh,"Attempted pong to $tryserver timed out
");
+                print "Time out while contacting: $tryserver for pong.\n";
+            } else {
+                &log($fh,"Pong to $tryserver: $answer
");
+            }
+        } else {
+            &log($fh,"$tryserver has delayed messages, but is not part of the cluster -- skipping 'Pong'.
");
+        }
+    }
 }
 
 sub finish_logging {
-    my ($fh)=@_;
-    &log($fh,"\n");
-    $totalcount=$notices+4*$warnings+100*$errors;
+    my ($fh,$weightsref)=@_;
+    my %weights;
+    if (ref($weightsref) eq 'HASH') {
+        %weights = %{$weightsref};
+    }
+    &log($fh,"\n");
+    $totalcount=($weights{'N'}*$notices)+($weights{'W'}*$warnings)+($weights{'E'}*$errors);
     &errout($fh);
     &log($fh,"
Total Error Count: $totalcount
");
     my $now=time;
     my $date=localtime($now);
-    &log($fh,"
$date ($now)\n");
-    print "lon-status webpage updated\n";
+    &log($fh,"
$date ($now)\n");
+    print "lon-status webpage updated.\n";
     $fh->close();
 
     if ($errors) { $simplestatus{'errors'}=$errors; }
@@ -522,7 +958,7 @@ sub finish_logging {
 }
 
 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");
     foreach (keys %simplestatus) {
@@ -532,25 +968,578 @@ sub log_simplestatus {
     $sfh->close();
 }
 
+sub write_loncaparevs {
+    print "Retrieving LON-CAPA version information.\n";
+    my %hostname = &Apache::lonnet::all_hostnames();
+    my $output;
+    foreach my $id (sort(keys(%hostname))) {
+        if ($id ne '') {
+            my $loncaparev;
+            eval {
+                local $SIG{ ALRM } = sub { die "TIMEOUT" };
+                alarm(10);
+                $loncaparev =
+                    &Apache::lonnet::get_server_loncaparev('',$id,1,'loncron');
+                alarm(0);
+            };
+            if ($@ && $@ =~ m/TIMEOUT/) {
+                print "Time out while contacting lonHost: $id for version.\n";   
+            }
+            if ($loncaparev =~ /^[\w.\-]+$/) {
+                $output .= $id.':'.$loncaparev."\n";
+            }
+        }
+    }
+    if ($output) {
+        if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+            print $fh $output;
+            close($fh);
+            &Apache::lonnet::load_loncaparevs();
+        }
+    }
+    return;
+}
+
+sub write_serverhomeIDs {
+    print "Retrieving LON-CAPA lonHostID information.\n";
+    my %name_to_host = &Apache::lonnet::all_names();
+    my $output;
+    foreach my $name (sort(keys(%name_to_host))) {
+        if ($name ne '') {
+            if (ref($name_to_host{$name}) eq 'ARRAY') {
+                my $serverhomeID;
+                eval {
+                    local $SIG{ ALRM } = sub { die "TIMEOUT" };
+                    alarm(10);
+                    $serverhomeID = 
+                        &Apache::lonnet::get_server_homeID($name,1,'loncron');
+                    alarm(0);
+                };
+                if ($@ && $@ =~ m/TIMEOUT/) {
+                    print "Time out while contacting server: $name\n"; 
+                }
+                if ($serverhomeID ne '') {
+                    $output .= $name.':'.$serverhomeID."\n";
+                } else {
+                    $output .= $name.':'.$name_to_host{$name}->[0]."\n";
+                }
+            }
+        }
+    }
+    if ($output) {
+        if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+            print $fh $output;
+            close($fh);
+            &Apache::lonnet::load_serverhomeIDs();
+        }
+    }
+    return;
+}
+
+sub write_checksums {
+    my $distro = &LONCAPA::distro();
+    if ($distro) {
+        print "Retrieving file version and checksumming.\n";
+        my $numchksums = 0;
+        my ($chksumsref,$versionsref) =
+            &LONCAPA::Checksumming::get_checksums($distro,$perlvar{'lonDaemons'},
+                                                  $perlvar{'lonLib'},
+                                                  $perlvar{'lonIncludes'},
+                                                  $perlvar{'lonTabDir'});
+        if (ref($chksumsref) eq 'HASH') {
+            $numchksums = scalar(keys(%{$chksumsref}));
+        }
+        print "File version retrieved and checksumming completed for $numchksums files.\n";
+    } else {
+        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);
+        }
+    }
+    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; 
+    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'};
+    $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';
+        if (-e $fname) {
+            my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
+            if (ref($dbref) eq 'HASH') {
+                foreach my $key (sort(keys(%{$dbref}))) {
+                    my $value = $dbref->{$key};
+                    if ($value =~ s/^__FROZEN__//) {
+                        $value = thaw(&LONCAPA::unescape($value));
+                    } else {
+                        $value = &LONCAPA::unescape($value);
+                    }
+                    $confhash{$key} = $value;
+                }
+                &LONCAPA::locking_hash_untie($dbref);
+            }
+        }
+    } else {
+        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);
+                    if ($value =~ s/^__FROZEN__//) {
+                        $value = thaw(&LONCAPA::unescape($value));
+                    } else {
+                        $value = &LONCAPA::unescape($value);
+                    }
+                    $confhash{$what}=$value;
+                }
+            }
+        }
+    }
+    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();
+    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 send_mail {
-    print "sending mail\n";
-    my $emailto="$perlvar{'lonAdmEMail'}";
-    if ($totalcount>1000) {
+    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)) {
 	$emailto.=",$perlvar{'lonSysEMail'}";
     }
-    my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices"; 
-    system("metasend -b -t $emailto -s '$subj' -f $statusdir/index.html -m text/html");
+    my $from;
+    my $hostname=`/bin/hostname`;
+    chop($hostname);
+    $hostname=~s/[^\w\.]//g;
+    if ($hostname) {
+        $from = 'www@'.$hostname;
+    }
+    my $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices";
+    my $loncronmail = "To: $emailto\n".
+                      "From: $from\n".
+                      "Subject: ".$subj."\n".
+                      "Content-type: text/html\; charset=UTF-8\n".
+                      "MIME-Version: 1.0\n\n";
+    if (open(my $fh,"<$statusdir/index.html")) {
+        while (<$fh>) {
+            $loncronmail .= $_;
+        }
+        close($fh);
+    } else {
+        $loncronmail .= "Failed to read from http://$hostname/lon-status/index.html\n";
+    }
+    $loncronmail .= "\n\n";
+    if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) {
+        print $mailh $loncronmail;
+        close($mailh);
+        print "Sending mail.\n";
+    } else {
+        print "Sending mail failed.\n";
+    }
+}
+
+sub usage {
+    print(< \$help,
+		"justcheckdaemons"     => \$justcheckdaemons,
+		"noemail"              => \$noemail,
+		"justcheckconnections" => \$justcheckconnections,
+		"justreload"           => \$justreload,
+                "justiptables"         => \$justiptables
+		);
+    if ($help) { &usage(); return; }
 # --------------------------------- Read loncapa_apache.conf and loncapa.conf
     my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
     %perlvar=%{$perlvarref};
     undef $perlvarref;
     delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed
     delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed
-
+    chdir($perlvar{'lonDaemons'});
 # --------------------------------------- Make sure that LON-CAPA is configured
 # I only test for one thing here (lonHostID).  This is just a safeguard.
     if ('{[[[[lonHostID]]]]}' eq $perlvar{'lonHostID'}) {
@@ -560,50 +1549,63 @@ sub main () {
 	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.' |\
- mailto $emailto -s '$subj' > /dev/null");
+	system("echo 'Unconfigured machine $hostname.' |".
+               " mail -s '$subj' $emailto > /dev/null");
 	exit 1;
     }
 
 # ----------------------------- Make sure this process is running from user=www
     my $wwwid=getpwnam('www');
     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 $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;
     }
 
-# ------------------------------------------------------------- Read hosts file
-    my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab");
-    
-    my (%hostname,%hostdom,%hostrole,%spareid);
-    while (my $configline=<$config>) {
-	my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
-	if ($id && $domain && $role && $name && $ip) {
-	    $hostname{$id}=$name;
-	    $hostdom{$id}=$domain;
-	    $hostrole{$id}=$role;
-	} else {
-	    if ($configline) {
-#		&logthis("Skipping hosts.tab line -$configline-");
-	    }
-	}
-    }
-    undef $config;
-
-# ------------------------------------------------------ Read spare server file
-    $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab");
-    
-    while (my $configline=<$config>) {
-	chomp($configline);
-	if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
-	    $spareid{$configline}=1;
-	}
+# -------------------------------------------- Force reload of host information
+    my $nomemcache;
+    if ($justcheckdaemons) {
+        $nomemcache=1;
+        my $memcachepidfile="$perlvar{'lonDaemons'}/logs/memcached.pid";
+        my $memcachepid;
+        if (-e $memcachepidfile) {
+            my $memfh=IO::File->new($memcachepidfile);
+            $memcachepid=<$memfh>;
+            chomp($memcachepid);
+            if ($memcachepid =~ /^\d+$/ && kill 0 => $memcachepid) {
+                undef($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  
+
+    if ((!$justcheckdaemons) && (!$justreload)) {
+        my $now = time;
+        my $tmpfile = $perlvar{'lonDaemons'}.'/tmp/lciptables_iphost_'.
+                      $now.$$.int(rand(10000));
+        if (open(my $fh,">$tmpfile")) {
+            my %iphosts = &Apache::lonnet::get_iphost();
+            foreach my $key (keys(%iphosts)) {
+                print $fh "$key\n";
+            }
+            close($fh);
+            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($tmpfile);
+        }
     }
-    undef $config;
 
 # ---------------------------------------------------------------- Start report
 
@@ -611,33 +1613,66 @@ sub main () {
     $warnings=0;
     $notices=0;
 
-    my $fh=&start_logging(\%hostdom,\%hostrole,\%hostname,\%spareid);
-
-    &log_machine_info($fh);
-    &clean_tmp($fh);
-    &clean_lonIDs($fh);
-    &check_httpd_logs($fh);
-    &checkon_daemon($fh,'lonsql',200000);
-    &checkon_daemon($fh,'lond',40000,1);
-    &checkon_daemon($fh,'lonc',40000,1);
-    &checkon_daemon($fh,'lonhttpd',40000);
-    
-    &test_connections($fh,\%hostname);
-    &check_delayed_msg($fh);
-
-    &finish_logging($fh);
-    &log_simplestatus();
 	
-    if ($totalcount>200) { &send_mail(); }
+    my $fh;
+    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 && !$justiptables) {
+	&checkon_daemon($fh,'lonmemcached',40000);
+	&checkon_daemon($fh,'lonsql',200000);
+	if ( &checkon_daemon($fh,'lond',40000,'USR1') eq 'running') {
+	    &checkon_daemon($fh,'lond',40000,'USR2');
+	}
+	&checkon_daemon($fh,'lonc',40000,'USR1');
+        &checkon_daemon($fh,'lonmaxima',40000);
+        &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');
+    }
+    if ($justcheckconnections) {
+	&test_connections($fh);
+    }
+    if (!$justcheckdaemons && !$justcheckconnections && !$justreload && !$justiptables) {
+        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();
+        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); }
+    }
 }
 
 &main();
 1;
 
-
-
-
-
-
-
-


500 Internal Server Error


Internal Server Error


The server encountered an internal error or
misconfiguration and was unable to complete
your request.


Please contact the server administrator at 
 root@localhost to inform them of the time this error occurred,
 and the actions you performed just before this error.


More information about this error may be available
in the server error log.