--- loncom/lond 2000/07/14 07:43:15 1.15
+++ loncom/lond 2000/12/06 20:38:21 1.30
@@ -7,7 +7,9 @@
# 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
# 03/07,05/31 Gerd Kortemeyer
# 06/26 Scott Harrison
-# 06/29,06/30,07/14 Gerd Kortemeyer
+# 06/29,06/30,07/14,07/15,07/17,07/20,07/25,09/18 Gerd Kortemeyer
+# 12/05 Scott Harrison
+# 12/05 Gerd Kortemeyer
#
# based on "Perl Cookbook" ISBN 1-56592-243-3
# preforker - server who forks first
@@ -25,6 +27,23 @@ use LWP::UserAgent();
use GDBM_File;
use Authen::Krb4;
+# grabs exception and records it to log before exiting
+sub catchexception {
+ my ($error)=@_;
+ $SIG{'QUIT'}='DEFAULT';
+ $SIG{__DIE__}='DEFAULT';
+ &logthis("CRITICAL: "
+ ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+ ."a crash with this error msg->[$error]");
+ if ($client) { print $client "error: $error\n"; }
+ die($error);
+}
+
+# -------------------------------- Set signal handlers to record abnormal exits
+
+$SIG{'QUIT'}=\&catchexception;
+$SIG{__DIE__}=\&catchexception;
+
# ------------------------------------ Read httpd access.conf and get variables
open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf";
@@ -38,6 +57,17 @@ while ($configline=) {
}
close(CONFIG);
+# --------------------------------------------- Check if other instance running
+
+my $pidfile="$perlvar{'lonDaemons'}/logs/lond.pid";
+
+if (-e $pidfile) {
+ my $lfh=IO::File->new("$pidfile");
+ my $pide=<$lfh>;
+ chomp($pide);
+ if (kill 0 => $pide) { die "already running"; }
+}
+
$PREFORK=4; # number of children to maintain, at least four spare
# ------------------------------------------------------------- Read hosts file
@@ -92,6 +122,7 @@ sub HUPSMAN { # sig
kill 'INT' => keys %children;
close($server); # free up socket
&logthis("CRITICAL: Restarting");
+ unlink("$execdir/logs/lond.pid");
my $execdir=$perlvar{'lonDaemons'};
exec("$execdir/lond"); # here we go again
}
@@ -217,7 +248,7 @@ sub propath {
my ($udom,$uname)=@_;
$udom=~s/\W//g;
$uname=~s/\W//g;
- my $subdir=$uname.'___';
+ my $subdir=$uname.'__';
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
return $proname;
@@ -333,15 +364,18 @@ sub make_new_child {
} else {
&logthis(
"WARNING: $clientip did not reply challenge");
+ print $client "bye\n";
}
} else {
&logthis(
"WARNING: "
."$clientip failed to initialize: >$remotereq< ");
+ print $client "bye\n";
}
} else {
&logthis(
"WARNING: Unknown client $clientip");
+ print $client "bye\n";
}
if ($clientok) {
# ---------------- New known client connecting, could mean machine online again
@@ -508,12 +542,13 @@ sub make_new_child {
$response=$ua->request($request,$transname);
}
if ($response->is_error()) {
- unline($transname);
+ unlink($transname);
my $message=$response->status_line;
&logthis(
"LWP GET: $message for $fname ($remoteurl)");
} else {
if ($remoteurl!~/\.meta$/) {
+ my $ua=new LWP::UserAgent;
my $mrequest=
new HTTP::Request('GET',$remoteurl.'.meta');
my $mresponse=
@@ -550,14 +585,21 @@ sub make_new_child {
my $ownership=ishome($fname);
if ($ownership eq 'owner') {
if (-e $fname) {
+ if (-d $fname) {
+ print $client "directory\n";
+ } else {
$now=time;
{
- my $sh=IO::File->new(">$fname.$hostid{$clientip}");
- print $sh "$clientip:$now\n";
+ my $sh;
+ if ($sh=
+ IO::File->new(">$fname.$hostid{$clientip}")) {
+ print $sh "$clientip:$now\n";
+ }
}
$fname=~s/\/home\/httpd\/html\/res/raw/;
$fname="http://$thisserver/".$fname;
print $client "$fname\n";
+ }
} else {
print $client "not_found\n";
}
@@ -656,7 +698,7 @@ sub make_new_child {
my @queries=split(/\&/,$what);
my $proname=propath($udom,$uname);
my $qresult='';
- if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
+ if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
for ($i=0;$i<=$#queries;$i++) {
$qresult.="$hash{$queries[$i]}&";
}
@@ -679,7 +721,7 @@ sub make_new_child {
my @queries=split(/\&/,$what);
my $proname=propath($udom,$uname);
my $qresult='';
- if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
+ if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
for ($i=0;$i<=$#queries;$i++) {
$qresult.="$hash{$queries[$i]}&";
}
@@ -741,7 +783,7 @@ sub make_new_child {
$namespace=~s/\W//g;
my $proname=propath($udom,$uname);
my $qresult='';
- if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
+ if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
foreach $key (keys %hash) {
$qresult.="$key&";
}
@@ -762,7 +804,7 @@ sub make_new_child {
$namespace=~s/\W//g;
my $proname=propath($udom,$uname);
my $qresult='';
- if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
+ if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
foreach $key (keys %hash) {
$qresult.="$key=$hash{$key}&";
}
@@ -826,7 +868,7 @@ sub make_new_child {
chomp($rid);
my $proname=propath($udom,$uname);
my $qresult='';
- if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
+ if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) {
my $version=$hash{"version:$rid"};
$qresult.="version=$version&";
my $scope;
@@ -836,7 +878,7 @@ sub make_new_child {
my $key;
$qresult.="$scope:keys=$vkeys&";
foreach $key (@keys) {
- $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&";
+ $qresult.="$scope:$key=".$hash{"$scope:$rid:$key"}."&";
}
}
if (untie(%hash)) {
@@ -901,7 +943,7 @@ sub make_new_child {
my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
my @queries=split(/\&/,$what);
my $qresult='';
- if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
+ if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER,0640)) {
for ($i=0;$i<=$#queries;$i++) {
$qresult.="$hash{$queries[$i]}&";
}
@@ -961,6 +1003,7 @@ sub make_new_child {
} else {
$ulsout='no_such_dir';
}
+ if ($ulsout eq '') { $ulsout='empty'; }
print $client "$ulsout\n";
# ------------------------------------------------------------- unknown command
} else {