--- loncom/loncron	2009/02/11 15:19:57	1.78
+++ loncom/loncron	2010/08/21 22:23:05	1.87
@@ -2,7 +2,7 @@
 
 # Housekeeping program, started by cron, loncontrol and loncron.pl
 #
-# $Id: loncron,v 1.78 2009/02/11 15:19:57 raeburn Exp $
+# $Id: loncron,v 1.87 2010/08/21 22:23:05 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,6 +33,7 @@ use strict;
 use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;
 use Apache::lonnet;
+use Apache::loncommon;
 
 use IO::File;
 use IO::Socket;
@@ -346,33 +347,127 @@ ENDHEADERS
 sub clean_tmp {
     my ($fh)=@_;
     &log($fh,'<hr /><a name="tmp" /><h2>Temporary Files</h2>');
-    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=<PROBE>;
-		close(PROBE);
-	    }
-	    unless ($line=~/^CHECKOUTTOKEN\&/) {
-		$cleaned++;
-		unlink("$fname");
-	    } else {
-		if ($since>365*$perlvar{'lonExpire'}) {
-		    $cleaned++;
-		    unlink("$fname");
-		} else { $old++; }
-	    }
-	}
+    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}):<ul><li>".
+                     join('</li><li><tt>',@{$errors{$key}}).'</tt></li></ul><br />');
+            }
+        }
+    }
+}
+
+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=<PROBE>;
+                            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
@@ -407,7 +502,7 @@ sub clean_sockets {
     opendir(SOCKETS,$perlvar{'lonSockDir'});
     while (my $fname=readdir(SOCKETS)) {
 	next if (-d $fname 
-		 || $fname=~/(mysqlsock|maximasock|\Q$perlvar{'lonSockDir'}\E)/);
+		 || $fname=~/(mysqlsock|maximasock|rsock|\Q$perlvar{'lonSockDir'}\E)/);
 	$cleaned++;
 	&log($fh,"Unlinking $fname<br />");
 	unlink("/home/httpd/sockets/$fname");
@@ -469,12 +564,17 @@ sub rotate_lonnet_logs {
 
 sub rotate_other_logs {
     my ($fh) = @_;
-    my $fname="$perlvar{'lonDaemons'}/logs/autoenroll.log";
-    &rotate_logfile($fname,$fh,'Auto Enroll log');
-    $fname="$perlvar{'lonDaemons'}/logs/autocreate.log";
-    &rotate_logfile($fname,$fh,'Create Course log');
-    $fname="$perlvar{'lonDaemons'}/logs/searchcat.log";
-    &rotate_logfile($fname,$fh,'Search Cataloguing log');
+    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
@@ -585,10 +685,46 @@ sub log_simplestatus {
     $sfh->close();
 }
 
+sub write_loncaparevs {
+    if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+        my %hostname = &Apache::lonnet::all_hostnames();
+        foreach my $id (sort(keys(%hostname))) {
+            if ($id ne '') {
+                my $loncaparev = &Apache::lonnet::get_server_loncaparev('',$id,1,'loncron');
+                if ($loncaparev =~ /^[\w.\-]+$/) {
+                    print $fh $id.':'.$loncaparev."\n";
+                }
+            }
+        }
+        close($fh);
+    }
+    return;
+}
+
+sub write_serverhomeIDs {
+    if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+        my %name_to_host = &Apache::lonnet::all_names();
+        foreach my $name (sort(keys(%name_to_host))) {
+            if ($name ne '') {
+                if (ref($name_to_host{$name}) eq 'ARRAY') {
+                    my $serverhomeID = &Apache::lonnet::get_server_homeID($name,1,'loncron');
+                    if ($serverhomeID ne '') {
+                        print $fh $name.':'.$serverhomeID."\n";
+                    } else {
+                        print $fh $name.':'.$name_to_host{$name}->[0]."\n";
+                    }
+                }
+            }
+        }
+        close($fh);
+    }
+    return;
+}
+
 sub send_mail {
     print "sending mail\n";
-    my $defdom = $perlvar->{'lonDefDomain'};
-    my $origmail = $perlvar->{'lonAdmEMail'};
+    my $defdom = $perlvar{'lonDefDomain'};
+    my $origmail = $perlvar{'lonAdmEMail'};
     my $emailto = &Apache::loncommon::build_recipient_list(undef,
                                    'lonstatusmail',$defdom,$origmail);
     if ($totalcount>2500) {
@@ -673,6 +809,24 @@ sub main () {
     &Apache::lonnet::load_domain_tab(1);
     &Apache::lonnet::get_iphost(1);
 
+# ----------------------------------------- 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);
+            my $execpath = $perlvar{'lonDaemons'}.'/lciptables';
+            system("$execpath $tmpfile");
+            unlink($fh);
+        }
+    }
+
 # ---------------------------------------------------------------- Start report
 
     $errors=0;
@@ -699,6 +853,7 @@ sub main () {
 	}
 	&checkon_daemon($fh,'lonc',40000,'USR1');
         &checkon_daemon($fh,'lonmaxima',40000);
+        &checkon_daemon($fh,'lonr',40000);
     }
     if ($justreload) {
 	&checkon_daemon($fh,'lond',40000,'USR2');
@@ -711,6 +866,8 @@ sub main () {
 	&check_delayed_msg($fh);
 	&finish_logging($fh);
 	&log_simplestatus();
+        &write_loncaparevs();
+        &write_serverhomeIDs();
 	
 	if ($totalcount>200 && !$noemail) { &send_mail(); }
     }