--- loncom/lond 2000/07/17 21:36:33 1.17 +++ loncom/lond 2000/12/06 18:05:51 1.29 @@ -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,07/15,07/17 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 @@ -511,12 +541,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= @@ -553,14 +584,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"; } @@ -659,7 +697,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]}&"; } @@ -682,7 +720,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]}&"; } @@ -744,7 +782,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&"; } @@ -765,7 +803,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}&"; } @@ -829,7 +867,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; @@ -839,7 +877,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)) { @@ -904,7 +942,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]}&"; }