version 1.39, 2002/04/10 04:35:31
|
version 1.47, 2003/02/24 19:56:30
|
Line 37
|
Line 37
|
# 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19, |
# 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19, |
# 10/8,10/9,10/15,11/18,12/22, |
# 10/8,10/9,10/15,11/18,12/22, |
# 2/8,7/25 Gerd Kortemeyer |
# 2/8,7/25 Gerd Kortemeyer |
# 12/05 Scott Harrison |
|
# 12/05 Gerd Kortemeyer |
# 12/05 Gerd Kortemeyer |
# YEAR=2001 |
# YEAR=2001 |
# 01/10/01 Scott Harrison |
|
# 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer |
# 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer |
# 12/20 Scott Harrison |
|
# YEAR=2002 |
# YEAR=2002 |
# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer |
# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer |
# 3/07/02 Ron Fox |
# 3/07/02 Ron Fox |
# based on nonforker from Perl Cookbook |
# based on nonforker from Perl Cookbook |
# - server who multiplexes without forking |
# - server who multiplexes without forking |
|
|
|
use lib '/home/httpd/lib/perl/'; |
|
use LONCAPA::Configuration; |
|
|
use POSIX; |
use POSIX; |
use IO::Socket; |
use IO::Socket; |
use IO::Select; |
use IO::Select; |
Line 71 $DEBUG = 0; # Set to 1 for annoyingly
|
Line 71 $DEBUG = 0; # Set to 1 for annoyingly
|
$SIG{QUIT}=\&catchexception; |
$SIG{QUIT}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
$SIG{__DIE__}=\&catchexception; |
|
|
# ------------------------------------ Read httpd access.conf and get variables |
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf |
&status("Read access.conf"); |
&status("Read loncapa.conf and loncapa_apache.conf"); |
open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; |
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); |
|
my %perlvar=%{$perlvarref}; |
while ($configline=<CONFIG>) { |
undef $perlvarref; |
if ($configline =~ /PerlSetVar/) { |
|
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); |
|
chomp($varvalue); |
|
$perlvar{$varname}=$varvalue; |
|
} |
|
} |
|
close(CONFIG); |
|
|
|
# ----------------------------- Make sure this process is running from user=www |
# ----------------------------- Make sure this process is running from user=www |
&status("Check user ID"); |
&status("Check user ID"); |
Line 262 unlink($port);
|
Line 255 unlink($port);
|
@allbuffered=grep /\.$conserver$/, readdir DIRHANDLE; |
@allbuffered=grep /\.$conserver$/, readdir DIRHANDLE; |
closedir(DIRHANDLE); |
closedir(DIRHANDLE); |
my $dfname; |
my $dfname; |
foreach (@allbuffered) { |
foreach (sort @allbuffered) { |
&status("Sending delayed: $_"); |
&status("Sending delayed: $_"); |
$dfname="$path/$_"; |
$dfname="$path/$_"; |
if($DEBUG) { &logthis('Sending '.$dfname); } |
if($DEBUG) { &logthis('Sending '.$dfname); } |
Line 332 tie %ready, 'Tie::RefHash';
|
Line 325 tie %ready, 'Tie::RefHash';
|
|
|
# Main loop: check reads/accepts, check writes, check ready to process |
# Main loop: check reads/accepts, check writes, check ready to process |
|
|
status("Main loop"); |
status("Main loop $conserver"); |
while (1) { |
while (1) { |
my $client; |
my $client; |
my $rv; |
my $rv; |
Line 372 while (1) {
|
Line 365 while (1) {
|
} |
} |
$servers{$client->fileno} = $client; |
$servers{$client->fileno} = $client; |
nonblock($client); |
nonblock($client); |
|
$client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of |
|
# connection liveness. |
} |
} |
HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready); |
HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready); |
HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer, |
HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer, |
Line 707 sub openremote {
|
Line 702 sub openremote {
|
|
|
my $conserver=shift; |
my $conserver=shift; |
|
|
&status("Opening TCP"); |
&status("Opening TCP $conserver"); |
my $st=120+int(rand(240)); # Sleep before opening: |
my $st=120+int(rand(240)); # Sleep before opening: |
|
|
unless ( |
unless ( |
Line 747 if ($answer ne 'ok') {
|
Line 742 if ($answer ne 'ok') {
|
} |
} |
|
|
sleep 5; |
sleep 5; |
&status("Ponging"); |
&status("Ponging $conserver"); |
print $remotesock "pong\n"; |
print $remotesock "pong\n"; |
$answer=<$remotesock>; |
$answer=<$remotesock>; |
chomp($answer); |
chomp($answer); |
Line 980 sub londtransaction {
|
Line 975 sub londtransaction {
|
alarm(0); |
alarm(0); |
}; |
}; |
} else { |
} else { |
if($DEBUG) { |
&logthis("lonc - suiciding on send Timeout"); |
&logthis("Timeout on send in londtransaction"); |
die("lonc - suiciding on send Timeout"); |
} |
|
} |
} |
if( ($@ =~ /timeout/) && ($DEBUG)) { |
if ($@ =~ /timeout/) { |
&logthis("Timeout on receive in londtransaction"); |
&logthis("lonc - suiciding on send Timeout"); |
|
die("lonc - suiciding on send Timeout"); |
} |
} |
# |
# |
# Restore the initial sigmask set. |
# Restore the initial sigmask set. |
Line 1040 sub status {
|
Line 1035 sub status {
|
my $now=time; |
my $now=time; |
my $local=localtime($now); |
my $local=localtime($now); |
$status=$local.': '.$what; |
$status=$local.': '.$what; |
|
$0='lonc: '.$what.' '.$local; |
} |
} |
|
|
|
|