--- loncom/loncron 2004/05/11 19:15:03 1.47 +++ loncom/loncron 2015/09/20 18:31:21 1.103 @@ -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.103 2015/09/20 18:31:21 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -28,34 +28,25 @@ # $|=1; +use strict; use lib '/home/httpd/lib/perl/'; use LONCAPA::Configuration; +use LONCAPA::Checksumming; +use LONCAPA; +use Apache::lonnet; +use Apache::loncommon; use IO::File; use IO::Socket; -use strict; +use HTML::Entities; +use Getopt::Long; #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,45 +57,60 @@ 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);
+    my $result;
+    &log($fh,'
'.$daemon.'
Log
');
+    printf("%-15s ",$daemon);
     if (-e "$perlvar{'lonDaemons'}/logs/$daemon.log"){
 	open (DFH,"tail -n25 $perlvar{'lonDaemons'}/logs/$daemon.log|");
 	while (my $line=) { 
@@ -115,7 +121,7 @@ sub checkon_daemon {
 	};
 	close (DFH);
     }
-    &log($fh,"
"); + &log($fh,"

"); my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid"; @@ -125,13 +131,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,33 +155,38 @@ 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`. + '
'); &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

"); } } @@ -181,31 +199,21 @@ sub checkon_daemon { if ($line=~/CRITICAL/) { $notices++; } }; close (DFH); - &log($fh,""); + &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 +236,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 +258,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 +269,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 +285,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}}).'

');
+            }
+        }
+    }
+}
+
+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);
     }
-    &log($fh,"Cleaned up ".$cleaned." files (".$old." old checkout tokens).");
+    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 +490,81 @@ 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 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 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,51 +573,63 @@ 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);
 }
 
@@ -471,8 +637,8 @@ sub test_connections {
 # ------------------------------------------------------------ Delayed messages
 sub check_delayed_msg {
     my ($fh)=@_;
-    &log($fh,'
Delayed Messages
');
-    print "checking buffers\n";
+    &log($fh,'
Delayed Messages
');
+    print "Checking buffers.\n";
     
     &log($fh,'
Scanning Permanent Log
');
 
@@ -483,36 +649,65 @@ sub check_delayed_msg {
 	my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line);
 	if ($sdf eq 'F') { 
 	    my $local=localtime($time);
-	    &log($fh,"Failed: $time, $dserv, $dcmd
");
+	    &log($fh,"Failed: $time, $dserv, $dcmd
");
 	    $warnings++;
 	}
 	if ($sdf eq 'S') { $unsend--; }
 	if ($sdf eq 'D') { $unsend++; }
     }
 
-    &log($fh,"Total unsend messages: $unsend
\n");
-    $warnings=$warnings+5*$unsend;
+    &log($fh,"
Total unsend messages: $unsend
\n");
+    if ($unsend > 0) {
+        $warnings=$warnings+5*$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);
+    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))) {
+        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");
+    &log($fh,"\n");
     $totalcount=$notices+4*$warnings+100*$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 +717,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 +727,174 @@ 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 send_mail {
-    print "sending mail\n";
-    my $emailto="$perlvar{'lonAdmEMail'}";
-    if ($totalcount>1000) {
+    my $defdom = $perlvar{'lonDefDomain'};
+    my $origmail = $perlvar{'lonAdmEMail'};
+    my $emailto = &Apache::loncommon::build_recipient_list(undef,
+                                   'lonstatusmail',$defdom,$origmail);
+    if ($totalcount>2500) {
 	$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
+		);
+    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'}) {
@@ -568,42 +912,53 @@ sub main () {
 # ----------------------------- 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.' |\
+	system("echo 'User ID mismatch. loncron must be run as user www.' |\
  mailto $emailto -s '$subj' > /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);
+            }
+        }
+    }
+    &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 +966,47 @@ 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) {
+	$fh=&start_logging();
+
+	&log_machine_info($fh);
+	&clean_tmp($fh);
+	&clean_lonIDs($fh);
+        &clean_webDAV_sessionIDs($fh);
+	&check_httpd_logs($fh);
+	&rotate_lonnet_logs($fh);
+	&rotate_other_logs($fh);
+    }
+    if (!$justcheckconnections && !$justreload) {
+	&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) {
+	&checkon_daemon($fh,'lond',40000,'USR2');
+	&checkon_daemon($fh,'lonc',40000,'USR2');
+    }
+    if ($justcheckconnections) {
+	&test_connections($fh);
+    }
+    if (!$justcheckdaemons && !$justcheckconnections && !$justreload) {
+	&check_delayed_msg($fh);
+	&finish_logging($fh);
+	&log_simplestatus();
+        &write_loncaparevs();
+        &write_serverhomeIDs();
+	&write_checksums();
+	if ($totalcount>200 && !$noemail) { &send_mail(); }
+    }
 }
 
 &main();
 1;
 
-
-
-
-
-
-
-