--- loncom/loncron 2001/04/21 15:22:37 1.20 +++ loncom/loncron 2018/10/25 03:27:22 1.110 @@ -1,693 +1,1297 @@ #!/usr/bin/perl -# The LearningOnline Network -# Housekeeping program, started by cron +# Housekeeping program, started by cron, loncontrol and loncron.pl # -# (TCP networking package -# 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30, -# 7/1,7/2,7/9,7/10,7/12 Gerd Kortemeyer) +# $Id: loncron,v 1.110 2018/10/25 03:27:22 raeburn Exp $ # -# 7/14,7/15,7/19,7/21,7/22,11/18, -# 2/8 Gerd Kortemeyer -# 12/6/2000,12/8 Scott Harrison -# 12/23 Gerd Kortemeyer -# 1/10/2001, 2/12/, 2/26, 3/15, 04/11, 04/21 Scott Harrison +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# + +$|=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 HTML::Entities; +use Getopt::Long; +use GDBM_File; +use Storable qw(thaw); +#globals +use vars qw (%perlvar %simplestatus $errors $warnings $notices $totalcount); + +my $statusdir="/home/httpd/html/lon-status"; -my $qflag=0; -if (@ARGV) { - my $arg=shift @ARGV; - $qflag=1 if $arg eq 'quick'; -} - -# -------------------------------------------------- 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 { + my $fh=shift; + if ($fh) { print $fh @_ } +} + sub errout { my $fh=shift; - print $fh (< + &log($fh,(< -
Notices$notices
Warnings$warnings
Errors$errors

Top

+

Top

ENDERROUT } -# ================================================================ Main Program +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"); + } +} -# ------------------------------------------------------------ Read access.conf -{ - my $config=IO::File->new("/etc/httpd/conf/access.conf"); - - while (my $configline=<$config>) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - $perlvar{$varname}=$varvalue; - } +sub start_daemon { + my ($fh,$daemon,$pidfile,$args) = @_; + my $progname=$daemon; + if ($daemon eq 'lonc') { + $progname='loncnew'; } - delete $perlvar{'lonReceipt'}; # remove since sensitive and not needed - delete $perlvar{'lonSqlAccess'}; # remove since sensitive and not needed + 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 ...

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

Seems like that did not work!

"); + $errors++; + return 0; } -# --------------------------------------- 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'}) { - print("Unconfigured machine.\n"); - $emailto=$perlvar{'lonSysEMail'}; - $hostname=`/bin/hostname`; - chop $hostname; - $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell - $subj="LON: Unconfigured machine $hostname"; - system("echo 'Unconfigured machine $hostname.' |\ - mailto $emailto -s '$subj' > /dev/null"); - exit 1; -} +sub checkon_daemon { + my ($fh,$daemon,$maxsize,$send,$args)=@_; -# ----------------------------- 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"); - $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; - $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"); - exit 1; -} + 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,"

"); + } + + my $pidfile="$perlvar{'lonDaemons'}/logs/$daemon.pid"; + + my $restartflag=1; + my $daemonpid; + if (-e $pidfile) { + my $lfh=IO::File->new("$pidfile"); + $daemonpid=<$lfh>; + chomp($daemonpid); + if ($daemonpid =~ /^\d+$/ && kill 0 => $daemonpid) { + &log($fh,"

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

"); + if ($send eq 'USR1') { kill USR1 => $daemonpid; } + if ($send eq 'USR2') { kill USR2 => $daemonpid; } + $restartflag=0; + 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

"); + $restartflag=1; + &log($fh,"

Decided to clean up stale .pid file and restart $daemon

"); + } + } + if ($restartflag==1) { + $simplestatus{$daemon}='off'; + $errors++; + 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 $kadaemon 2>&1`. + '
'); + if ($kadaemon eq 'loncnew') { + &clean_lonc_childpids(); + } + &log($fh,"

$daemon not running, trying to start

"); -# ------------------------------------------------------------- Read hosts file -{ - my $config=IO::File->new("$perlvar{'lonTabDir'}/hosts.tab"); - - while (my $configline=<$config>) { - my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); - $hostname{$id}=$name; - $hostdom{$id}=$domain; - $hostrole{$id}=$role; - $hostip{$id}=$ip; - if (($role eq 'library') && ($id ne $perlvar{'lonHostID'})) { - $libserv{$id}=$name; - } + 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 ...

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

"); + } + } + 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"; + &rotate_logfile($fname,$fh,'logs'); + + &errout($fh); + return $result; } -# ------------------------------------------------------ Read spare server file -{ - my $config=IO::File->new("$perlvar{'lonTabDir'}/spare.tab"); - - while (my $configline=<$config>) { - chomp($configline); - if (($configline) && ($configline ne $perlvar{'lonHostID'})) { - $spareid{$configline}=1; - } +# --------------------------------------------------------------------- Machine +sub log_machine_info { + my ($fh)=@_; + &log($fh,'

Machine Information

'); + &log($fh,"

loadavg

"); + + open (LOADAVGH,"/proc/loadavg"); + my $loadavg=; + close (LOADAVGH); + + &log($fh,"$loadavg"); + + my @parts=split(/\s+/,$loadavg); + if ($parts[1]>4.0) { + $errors++; + } elsif ($parts[1]>2.0) { + $warnings++; + } elsif ($parts[1]>1.0) { + $notices++; } -} -# ---------------------------------------------------------------- Start report + &log($fh,"

df

"); + &log($fh,"
");
+
+    open (DFH,"df|");
+    while (my $line=) { 
+	&log($fh,&encode_entities($line,'<>&"')); 
+	@parts=split(/\s+/,$line);
+	my $usage=$parts[4];
+	$usage=~s/\W//g;
+	if ($usage>90) { 
+	    $warnings++;
+	    $notices++; 
+	} elsif ($usage>80) {
+	    $warnings++;
+	} elsif ($usage>60) {
+	    $notices++;
+	}
+	if ($usage>95) { $warnings++; $warnings++; $simplestatus{'diskfull'}++; }
+    }
+    close (DFH);
+    &log($fh,"
"); -$statusdir="/home/httpd/html/lon-status"; -$errors=0; -$warnings=0; -$notices=0; + &log($fh,"

ps

"); + &log($fh,"
");
+    my $psproc=0;
 
-$now=time;
-$date=localtime($now);
+    open (PSH,"ps aux --cols 140 |");
+    while (my $line=) { 
+	&log($fh,&encode_entities($line,'<>&"')); 
+	$psproc++;
+    }
+    close (PSH);
+    &log($fh,"
"); + + if ($psproc>200) { $notices++; } + if ($psproc>250) { $notices++; } -{ -my $fh=IO::File->new(">$statusdir/newstatus.html"); + &log($fh,"

distprobe

"); + &log($fh,"
");
+    &log($fh,&encode_entities(&LONCAPA::distro(),'<>&"'));
+    &log($fh,"
"); -print $fh (< + &errout($fh); +} + +sub start_logging { + my $fh=IO::File->new(">$statusdir/newstatus.html"); + my %simplestatus=(); + my $now=time; + my $date=localtime($now); + + + &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. lonnet -
  10. Connections -
  11. Delayed Messages -
  12. Error Count +
  13. Configuration
    14. +
  14. Machine Information
    15. +
  15. Temporary Files
    16. +
  16. Session Tokens
    17. +
  17. WebDAV Session Tokens
    18. +
  18. httpd
    19. +
  19. lonsql
    20. +
  20. lond
    21. +
  21. lonc
    22. +
  22. lonnet
    23. +
  23. Connections
    24. +
  24. Delayed Messages
    25. +
  25. Error Count
-
- +
+

Configuration

PerlVars

- +
ENDHEADERS -foreach $varname (keys %perlvar) { - print $fh "\n"; -} -print $fh "
$varname$perlvar{$varname}

Hosts

"; -foreach $id (keys %hostname) { -print $fh - ""; -print $fh "\n"; -} -print $fh "
$id$hostdom{$id}$hostrole{$id}$hostname{$id}$hostip{$id}

Spare Hosts

    "; -foreach $id (keys %spareid) { - print $fh "
  1. $id\n"; + foreach my $varname (sort(keys(%perlvar))) { + &log($fh,"$varname". + &encode_entities($perlvar{$varname},'<>&"')."\n"); + } + &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".&Apache::lonnet::host_domain($id). + "".$role. + "".&Apache::lonnet::hostname($id)."

    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"); + } + return $fh; } -print $fh "
\n"; - -# --------------------------------------------------------------------- Machine - -print $fh '

Machine Information

'; -print $fh "

loadavg

"; - -open (LOADAVGH,"/proc/loadavg"); -$loadavg=; -close (LOADAVGH); - -print $fh "$loadavg"; - -@parts=split(/\s+/,$loadavg); -if ($parts[1]>4.0) { - $errors++; -} elsif ($parts[1]>2.0) { - $warnings++; -} elsif ($parts[1]>1.0) { - $notices++; -} - -print $fh "

df

"; -print $fh "
";
-
-open (DFH,"df|");
-while ($line=) { 
-   print $fh "$line"; 
-   @parts=split(/\s+/,$line);
-   $usage=$parts[4];
-   $usage=~s/\W//g;
-   if ($usage>90) { 
-      $warnings++; 
-   } elsif ($usage>80) {
-      $warnings++;
-   } elsif ($usage>60) {
-      $notices++;
-   }
-   if ($usage>95) { $warnings++; $warnings++ }
-}
-close (DFH);
-print $fh "
"; -&errout($fh); - # --------------------------------------------------------------- clean out tmp -print $fh '

Temporary Files

'; -$cleaned=0; -while ($fname=<$perlvar{'lonDaemons'}/tmp/*>) { - my ($dev,$ino,$mode,$nlink, - $uid,$gid,$rdev,$size, - $atime,$mtime,$ctime, - $blksize,$blocks)=stat($fname); - $now=time; - $since=$now-$mtime; - if ($since>$perlvar{'lonExpire'}) { - $cleaned++; - unlink("$fname"); - } - +sub clean_tmp { + my ($fh)=@_; + &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}):
'); + } + } + } } -print $fh "Cleaned up ".$cleaned." files."; -# ------------------------------------------------------------ clean out lonIDs -print $fh '

Session Tokens

'; -$cleaned=0; -$active=0; -while ($fname=<$perlvar{'lonIDsDir'}/*>) { - my ($dev,$ino,$mode,$nlink, - $uid,$gid,$rdev,$size, - $atime,$mtime,$ctime, - $blksize,$blocks)=stat($fname); - $now=time; - $since=$now-$mtime; - if ($since>$perlvar{'lonExpire'}) { - $cleaned++; - print $fh "Unlinking $fname
"; - unlink("$fname"); - } else { - $active++; - } - +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); } -print $fh "

Cleaned up ".$cleaned." stale session token(s)."; -print $fh "

$active open session(s)

"; - -# ----------------------------------------------------------------------- httpd -print $fh '

httpd

Access Log

';
+# ------------------------------------------------------------ clean out lonIDs
+sub clean_lonIDs {
+    my ($fh)=@_;
+    &log($fh,'
Session Tokens
');
+    my $cleaned=0;
+    my $active=0;
+    while (my $fname=<$perlvar{'lonIDsDir'}/*>) {
+	my ($dev,$ino,$mode,$nlink,
+	    $uid,$gid,$rdev,$size,
+	    $atime,$mtime,$ctime,
+	    $blksize,$blocks)=stat($fname);
+	my $now=time;
+	my $since=$now-$mtime;
+	if ($since>$perlvar{'lonExpire'}) {
+	    $cleaned++;
+	    &log($fh,"Unlinking $fname
");
+	    unlink("$fname");
+	} else {
+	    $active++;
+	}
+    }
+    &log($fh,"
Cleaned up ".$cleaned." stale session token(s).
");
+    &log($fh,"
$active open session(s)
");
+}
 
-open (DFH,"tail -n40 /etc/httpd/logs/access_log|");
-while ($line=) { print $fh "$line" };
-close (DFH);
+# ------------------------------------------------ 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)
");
+        }
+    }
+}
 
-print $fh "

Error Log

";
+# ----------------------------------------------------------- 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.
");
+}
 
-open (DFH,"tail -n50 /etc/httpd/logs/error_log|");
-while ($line=) { 
-   print $fh "$line";
-   if ($line=~/\[error\]/) { $notices++; } 
-};
-close (DFH);
-print $fh "
"; -&errout($fh); +# ----------------------------------------------------------------------- httpd +sub check_httpd_logs { + my ($fh)=@_; + if (open(PIPE,"./lchttpdlogs|")) { + while (my $line=) { + &log($fh,$line); + if ($line=~/\[error\]/) { $notices++; } + } + close(PIPE); + } + &errout($fh); +} -# ---------------------------------------------------------------------- lonsql -# -# Do not run for now -# -if ($perlvar{'lonRole'} eq "library") { +# ---------------------------------------------------------------------- lonnet - print $fh '

lonsql

Log

';
-    
-    if (-e "$perlvar{'lonDaemons'}/logs/lonsql.log"){
-	open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonsql.log|");
-	while ($line=) { 
-	    print $fh "$line";
-	    if ($line=~/INFO/) { $notices++; }
-	    if ($line=~/WARNING/) { $notices++; }
-	    if ($line=~/CRITICAL/) { $warnings++; }
-	};
+sub rotate_lonnet_logs {
+    my ($fh)=@_;
+    &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,&encode_entities($line,'<>&"'));
+	}
 	close (DFH);
     }
-    print $fh "
";
-    
-    my $lonsqlfile="$perlvar{'lonDaemons'}/logs/lonsql.pid";
+    &log($fh,"

Perm Log

");
     
-    if (-e $lonsqlfile) {
-	my $lfh=IO::File->new("$lonsqlfile");
-	my $lonsqlpid=<$lfh>;
-	chomp($lonsqlpid);
-	if (kill 0 => $lonsqlpid) {
-	    print $fh "
lonsql at pid $lonsqlpid responding
";
-	} else {
-	    $errors++; $errors++;
-	    print $fh "
lonsql at pid $lonsqlpid not responding
";
+    if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
+	open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
+	while (my $line=) { 
+	    &log($fh,&encode_entities($line,'<>&"'));
 	}
-    } else {
-	$errors++;
-	print $fh "
lonsql not running, trying to start
";
-	system(
- "$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors");
-	sleep 120 unless $qflag;
-	if (-e $lonsqlfile) {
-	    print $fh "Seems like it started ...
";
-	    my $lfh=IO::File->new("$lonsqlfile");
-	    my $lonsqlpid=<$lfh>;
-	    chomp($lonsqlpid);
-	    sleep 30 unless $qflag;
-	    if (kill 0 => $lonsqlpid) {
-		print $fh "
lonsql at pid $lonsqlpid responding
";
-	    } else {
-		$errors++; $errors++;
-		print $fh "
lonsql at pid $lonsqlpid not responding
";
-		print $fh "Give it one more try ...
";
-		system(
- "$perlvar{'lonDaemons'}/lonsql 2>>$perlvar{'lonDaemons'}/logs/lonsql_errors");
-		sleep 120 unless $qflag;
-	    }
-	} else {
-	    print $fh "Seems like that did not work!
";
-	    $errors++;
-	}
-	if (-e "$perlvar{'lonDaemons'}/logs/lonsql.log"){
-	    print $fh "
";
-	    open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonsql.log|");
-	    while ($line=) { 
-		print $fh "$line";
-		if ($line=~/WARNING/) { $notices++; }
-		if ($line=~/CRITICAL/) { $notices++; }
-	    };
-	    close (DFH);
-	    print $fh "
";
-	}
-    }
+	close (DFH);
+    } else { &log($fh,"No perm log\n") }
 
-    $fname="$perlvar{'lonDaemons'}/logs/lonsql.log";
-
-    my ($dev,$ino,$mode,$nlink,
-	$uid,$gid,$rdev,$size,
-	$atime,$mtime,$ctime,
-	$blksize,$blocks)=stat($fname);
+    my $fname="$perlvar{'lonDaemons'}/logs/lonnet.log";
+    &rotate_logfile($fname,$fh,'lonnet log');
 
-    if ($size>40000) {
-	print $fh "Rotating logs ...
";
-	rename("$fname.2","$fname.3");
-	rename("$fname.1","$fname.2");
-	rename("$fname","$fname.1");
+    &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)=@_; + &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=&Apache::lonnet::reply("ping",$tryserver); + if ($answer eq "$tryserver:$perlvar{'lonHostID'}") { + $result="ok"; + $good++; + } else { + $result=$answer; + $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); } -# ------------------------------------------------------------------------ lond -print $fh '

lond

Log

';
 
-if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){
-open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lond.log|");
-while ($line=) { 
-   print $fh "$line";
-   if ($line=~/INFO/) { $notices++; }
-   if ($line=~/WARNING/) { $notices++; }
-   if ($line=~/CRITICAL/) { $warnings++; }
-};
-close (DFH);
-}
-print $fh "
"; - -my $londfile="$perlvar{'lonDaemons'}/logs/lond.pid"; - -my $restartflag=1; -if (-e $londfile) { - my $lfh=IO::File->new("$londfile"); - my $londpid=<$lfh>; - chomp($londpid); - if (kill 0 => $londpid) { - print $fh "

lond at pid $londpid responding

"; - $restartflag=0; - } else { - $errors++; - print $fh "

lond at pid $londpid not responding

"; - # Intelligently handle this. - # Possibility #1: there is no process - # Solution: remove .pid file and restart - if (getpgrp($londpid)==-1) { - unlink($londfile); - $restartflag=1; - } - else { - # Possibility #2: there is a live process that is not responding - # for an unknown reason - # Solution: kill parent and children processes, remove .pid and restart - `killall -9 lond`; - unlink($londfile); - $restartflag=1; - } - print $fh - "

Deciding to clean up stale .pid file and restart lond

"; - } -} -if ($restartflag==1) { - $errors++; - print $fh "

lond not running, trying to start

"; - system( - "$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors"); - sleep 120 unless $qflag; - if (-e $londfile) { - print $fh "Seems like it started ...

"; - my $lfh=IO::File->new("$londfile"); - my $londpid=<$lfh>; - chomp($londpid); - sleep 30 unless $qflag; - if (kill 0 => $londpid) { - print $fh "

lond at pid $londpid responding

"; - } else { - $errors++; $errors++; - print $fh "

lond at pid $londpid not responding

"; - print $fh "Give it one more try ...

"; - system( - "$perlvar{'lonDaemons'}/lond 2>>$perlvar{'lonDaemons'}/logs/lond_errors"); - sleep 120 unless $qflag; - } - } else { - print $fh "Seems like that did not work!

"; - $errors++; - } - if (-e "$perlvar{'lonDaemons'}/logs/lond.log"){ - print $fh "

";
-    open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lond.log|");
-    while ($line=) { 
-      print $fh "$line";
-      if ($line=~/WARNING/) { $notices++; }
-      if ($line=~/CRITICAL/) { $notices++; }
-    };
-    close (DFH);
-    print $fh "
"; - } -} +# ------------------------------------------------------------ Delayed messages +sub check_delayed_msg { + my ($fh)=@_; + &log($fh,'

Delayed Messages

'); + print "Checking buffers.\n"; + + &log($fh,'

Scanning Permanent Log

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

"; - rename("$fname.2","$fname.3"); - rename("$fname.1","$fname.2"); - rename("$fname","$fname.1"); -} - -&errout($fh); -# ------------------------------------------------------------------------ lonc - -print $fh '

lonc

Log

';
-
-if (-e "$perlvar{'lonDaemons'}/logs/lonc.log"){
-open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonc.log|");
-while ($line=) { 
-   print $fh "$line";
-   if ($line=~/INFO/) { $notices++; }
-   if ($line=~/WARNING/) { $notices++; }
-   if ($line=~/CRITICAL/) { $warnings++; }
-};
-close (DFH);
-}
-print $fh "
"; - -my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; - -$restartflag=1; -if (-e $loncfile) { - my $lfh=IO::File->new("$loncfile"); - my $loncpid=<$lfh>; - chomp($loncpid); - if (kill 0 => $loncpid) { - print $fh "

lonc at pid $loncpid responding, sending USR1

"; - kill USR1 => $loncpid; - $restartflag=0; - } else { - $errors++; - print $fh "

lonc at pid $loncpid not responding

"; - # Intelligently handle this. - # Possibility #1: there is no process - # Solution: remove .pid file and restart - if (getpgrp($loncpid)==-1) { - unlink($loncfile); - $restartflag=1; - } - else { - # Possibility #2: there is a live process that is not responding - # for an unknown reason - # Solution: kill parent and children processes, remove .pid and restart - `killall -9 lonc`; - unlink($loncfile); - $restartflag=1; - } - print $fh - "

Deciding to clean up stale .pid file and restart lonc

"; - } -} -if ($restartflag==1) { - $errors++; - print $fh "

lonc not running, trying to start

"; - system( - "$perlvar{'lonDaemons'}/lonc 2>>$perlvar{'lonDaemons'}/logs/lonc_errors"); - sleep 120 unless $qflag; - if (-e $loncfile) { - print $fh "Seems like it started ...

"; - my $lfh=IO::File->new("$loncfile"); - my $loncpid=<$lfh>; - chomp($loncpid); - sleep 30 unless $qflag; - if (kill 0 => $loncpid) { - print $fh "

lonc at pid $loncpid responding

"; - } else { - $errors++; $errors++; - print $fh "

lonc at pid $loncpid not responding

"; - print $fh "Give it one more try ...

"; - system( - "$perlvar{'lonDaemons'}/lonc 2>>$perlvar{'lonDaemons'}/logs/lonc_errors"); - sleep 120 unless $qflag; - } - } else { - print $fh "Seems like that did not work!

"; - $errors++; - } - if (-e "$perlvar{'lonDaemons'}/logs/lonc.log") { - print $fh "

";
-    open (DFH,"tail -n100 $perlvar{'lonDaemons'}/logs/lonc.log|");
-    while ($line=) { 
-      print $fh "$line";
-      if ($line=~/WARNING/) { $notices++; }
-      if ($line=~/CRITICAL/) { $notices++; }
-    };
-    close (DFH);
-    print $fh "
"; - } -} + my %hostname = &Apache::lonnet::all_hostnames(); + my $numhosts = scalar(keys(%hostname)); -$fname="$perlvar{'lonDaemons'}/logs/lonc.log"; + my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log"); + while (my $line=<$dfh>) { + my ($time,$sdf,$dserv,$dcmd)=split(/:/,$line); + if ($numhosts) { + next unless ($hostname{$dserv}); + } + 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 ($dev,$ino,$mode,$nlink, - $uid,$gid,$rdev,$size, - $atime,$mtime,$ctime, - $blksize,$blocks)=stat($fname); + &log($fh,"

Total unsend messages: $unsend

\n"); + if ($unsend > 0) { + $warnings=$warnings+5*$unsend; + } -if ($size>40000) { - print $fh "Rotating logs ...

"; - rename("$fname.2","$fname.3"); - rename("$fname.1","$fname.2"); - rename("$fname","$fname.1"); + if ($unsend) { $simplestatus{'unsend'}=$unsend; } + &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=) {
+        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'.
"); + } + } } - -&errout($fh); -# ---------------------------------------------------------------------- lonnet - -print $fh '

lonnet

Temp Log

';
-if (-e "$perlvar{'lonDaemons'}/logs/lonnet.log"){
-open (DFH,"tail -n50 $perlvar{'lonDaemons'}/logs/lonnet.log|");
-while ($line=) { 
-    print $fh "$line";
-};
-close (DFH);
-}
-print $fh "

Perm Log

";
-
-if (-e "$perlvar{'lonDaemons'}/logs/lonnet.perm.log") {
-    open(DFH,"tail -n10 $perlvar{'lonDaemons'}/logs/lonnet.perm.log|");
-while ($line=) { 
-   print $fh "$line";
-};
-close (DFH);
-} else { print $fh "No perm log\n" }
-
-$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) {
-    print $fh "Rotating logs ...
";
-    rename("$fname.2","$fname.3");
-    rename("$fname.1","$fname.2");
-    rename("$fname","$fname.1");
+sub finish_logging {
+    my ($fh)=@_;
+    &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";
+    $fh->close();
+
+    if ($errors) { $simplestatus{'errors'}=$errors; }
+    if ($warnings) { $simplestatus{'warnings'}=$warnings; }
+    if ($notices) { $simplestatus{'notices'}=$notices; }
+    $simplestatus{'time'}=time;
 }
 
-print $fh "
"; -&errout($fh); -# ----------------------------------------------------------------- Connections +sub log_simplestatus { + rename("$statusdir/newstatus.html","$statusdir/index.html"); + + my $sfh=IO::File->new(">$statusdir/loncron_simple.txt"); + foreach (keys %simplestatus) { + print $sfh $_.'='.$simplestatus{$_}.'&'; + } + print $sfh "\n"; + $sfh->close(); +} -print $fh '

Connections

'; +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; +} -print $fh ""; -foreach $tryserver (keys %hostname) { +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; +} - $answer=reply("pong",$tryserver); - if ($answer eq "$tryserver:$perlvar{'lonHostID'}") { - $result="ok"; +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 { - $result=$answer; - $warnings++; - if ($answer eq 'con_lost') { $warnings++; } + print "File version retrieval and checksumming skipped - could not determine Linux distro.\n"; } - print $fh "\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); + } + } } -print $fh "
$tryserver$result
"; -&errout($fh); -# ------------------------------------------------------------ Delayed messages +sub write_connection_config { + my ($isprimary,$domconf,$url,%connectssl,%changes); + my $primaryLibServer = &Apache::lonnet::domain($perlvar{'lonDefDomain'},'primary'); + if ($primaryLibServer eq $perlvar{'lonHostID'}) { + $isprimary = 1; + } elsif ($primaryLibServer ne '') { + my $protocol = $Apache::lonnet::protocol{$primaryLibServer}; + my $hostname = &Apache::lonnet::hostname($primaryLibServer); + unless ($protocol eq 'https') { + $protocol = 'http'; + } + $url = $protocol.'://'.$hostname.'/cgi-bin/listdomconfig.pl'; + } + my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary, + $url); + if (ref($domconf) eq 'HASH') { + if (ref($domconf->{'ssl'}) eq 'HASH') { + foreach my $connect ('connto','connfrom') { + if (ref($domconf->{'ssl'}->{$connect}) eq 'HASH') { + my ($sslreq,$sslnoreq,$currsetting); + my %contypes; + foreach my $type ('dom','intdom','other') { + $connectssl{$connect.'_'.$type} = $domconf->{'ssl'}->{$connect}->{$type}; + } + } + } + } + if (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; +} -print $fh '

Delayed Messages

'; +sub get_domain_config { + my ($dom,$primlibserv,$isprimary,$url) = @_; + my %confhash; + 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 { + if (open(PIPE,"wget --no-check-certificate '$url?primary=$primlibserv&format=raw' |")) { + my $config = ''; + while () { + $config .= $_; + } + close(PIPE); + if ($config) { + my @pairs=split(/\&/,$config); + foreach my $item (@pairs) { + my ($key,$value)=split(/=/,$item,2); + my $what = &LONCAPA::unescape($key); + if ($value =~ s/^__FROZEN__//) { + $value = thaw(&LONCAPA::unescape($value)); + } else { + $value = &LONCAPA::unescape($value); + } + $confhash{$what}=$value; + } + } + } + } + return \%confhash; +} -print $fh '

Scanning Permanent Log

'; +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; +} -$unsend=0; -{ - my $dfh=IO::File->new("$perlvar{'lonDaemons'}/logs/lonnet.perm.log"); - while ($line=<$dfh>) { - ($time,$sdf,$dserv,$dcmd)=split(/:/,$line); - if ($sdf eq 'F') { - $local=localtime($time); - print "Failed: $time, $dserv, $dcmd
"; - $warnings++; - } - if ($sdf eq 'S') { $unsend--; } - if ($sdf eq 'D') { $unsend++; } - } -} -print $fh "Total unsend messages: $unsend

\n"; -$warnings=$warnings+5*$unsend; - -print $fh "

Outgoing Buffer

"; - -open (DFH,"ls -lF $perlvar{'lonSockDir'}/delayed|"); -while ($line=) { - print $fh "$line
"; -}; -close (DFH); - -# ------------------------------------------------------------------------- End -print $fh "\n"; -$totalcount=$notices+4*$warnings+100*$errors; -&errout($fh); -print $fh "

Total Error Count: $totalcount

"; -$now=time; -$date=localtime($now); -print $fh "
$date ($now)\n"; +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; } -rename ("$statusdir/newstatus.html","$statusdir/index.html"); - -if ($totalcount>200) { - $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; - $subj="LON: $perlvar{'lonHostID'} E:$errors W:$warnings N:$notices"; - system( - "metasend -b -t $emailto -s '$subj' -f $statusdir/index.html -m text/html"); +sub send_mail { + 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 $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"; + } } -1; +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'}) { + print("Unconfigured machine.\n"); + my $emailto=$perlvar{'lonSysEMail'}; + my $hostname=`/bin/hostname`; + chop $hostname; + $hostname=~s/[^\w\.]//g; # make sure is safe to pass through shell + my $subj="LON: Unconfigured machine $hostname"; + system("echo 'Unconfigured machine $hostname.' |\ + mailto $emailto -s '$subj' > /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"); + 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"); + exit 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); + } + } +# ---------------------------------------------------------------- Start report + $errors=0; + $warnings=0; + $notices=0; + + + 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) { + &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) { + &check_delayed_msg($fh); + &log_simplestatus(); + &write_loncaparevs(); + &write_serverhomeIDs(); + &write_checksums(); + 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); + if ($totalcount>200 && !$noemail) { &send_mail(); } + } +} +&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.