version 1.103.2.1, 2003/03/14 21:25:44
|
version 1.106, 2003/01/15 04:43:14
|
Line 54
|
Line 54
|
# 02/19 Matthew Hall |
# 02/19 Matthew Hall |
# 02/25 Gerd Kortemeyer |
# 02/25 Gerd Kortemeyer |
# 05/11 Scott Harrison |
# 05/11 Scott Harrison |
|
# 01/xx/2003 Ron Fox.. Remove preforking. This makes the general daemon |
|
# logic simpler (and there were problems maintaining the preforked |
|
# population). Since the time averaged connection rate is close to zero |
|
# because lonc's purpose is to maintain near continuous connnections, |
|
# preforking is not really needed. |
### |
### |
|
|
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
|
# preforker - server who forks first |
|
# runs as a daemon |
|
# HUPs |
|
# uses IDEA encryption |
|
|
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
Line 272 sub checkchildren {
|
Line 272 sub checkchildren {
|
} |
} |
} |
} |
sleep 5; |
sleep 5; |
$SIG{ALRM} = sub { die "timeout" }; |
|
$SIG{__DIE__} = 'DEFAULT'; |
|
foreach (sort keys %children) { |
foreach (sort keys %children) { |
unless (-e "$docdir/lon-status/londchld/$_.txt") { |
unless (-e "$docdir/lon-status/londchld/$_.txt") { |
eval { |
|
alarm(300); |
|
&logthis('Child '.$_.' did not respond'); |
&logthis('Child '.$_.' did not respond'); |
kill 9 => $_; |
kill 9 => $_; |
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; |
$subj="LON: $perlvar{'lonHostID'} killed lond process $_"; |
$subj="LON: $perlvar{'lonHostID'} killed lond process $_"; |
my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`; |
my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`; |
$execdir=$perlvar{'lonDaemons'}; |
$execdir=$perlvar{'lonDaemons'}; |
$result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`; |
$result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_` |
alarm(0); |
|
} |
|
} |
} |
} |
} |
$SIG{ALRM} = 'DEFAULT'; |
|
$SIG{__DIE__} = \&cathcexception; |
|
} |
} |
|
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
Line 499 close(PIDSAVE);
|
Line 491 close(PIDSAVE);
|
&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>"); |
&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>"); |
&status('Starting'); |
&status('Starting'); |
|
|
# ------------------------------------------------------- Now we are on our own |
|
|
|
# Fork off our children. |
|
for (1 .. $PREFORK) { |
|
make_new_child(); |
|
} |
|
|
|
# ----------------------------------------------------- Install signal handlers |
# ----------------------------------------------------- Install signal handlers |
|
|
&status('Forked children'); |
|
|
|
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
$SIG{HUP} = \&HUPSMAN; |
$SIG{HUP} = \&HUPSMAN; |
$SIG{USR1} = \&checkchildren; |
$SIG{USR1} = \&checkchildren; |
|
|
# And maintain the population. |
|
|
|
|
# -------------------------------------------------------------- |
|
# Accept connections. When a connection comes in, it is validated |
|
# and if good, a child process is created to process transactions |
|
# along the connection. |
|
|
while (1) { |
while (1) { |
&status('Sleeping'); |
$client = $server->accept() or next; |
sleep; # wait for a signal (i.e., child's death) |
make_new_child($client); |
&logthis('Woke up'); |
|
&status('Woke up'); |
|
for ($i = $children; $i < $PREFORK; $i++) { |
|
make_new_child(); # top up the child pool |
|
} |
|
} |
} |
|
|
sub make_new_child { |
sub make_new_child { |
|
my $client; |
my $pid; |
my $pid; |
my $cipher; |
my $cipher; |
my $sigset; |
my $sigset; |
|
|
|
$client = shift; |
&logthis("Attempting to start child"); |
&logthis("Attempting to start child"); |
# block signal for fork |
# block signal for fork |
$sigset = POSIX::SigSet->new(SIGINT); |
$sigset = POSIX::SigSet->new(SIGINT); |
Line 563 sub make_new_child {
|
Line 553 sub make_new_child {
|
&Authen::Krb5::init_context(); |
&Authen::Krb5::init_context(); |
&Authen::Krb5::init_ets(); |
&Authen::Krb5::init_ets(); |
|
|
# handle connections until we've reached $MAX_CLIENTS_PER_CHILD |
|
for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { |
|
&status('Idle, waiting for connection'); |
|
$client = $server->accept() or last; |
|
&status('Accepted connection'); |
&status('Accepted connection'); |
# ============================================================================= |
# ============================================================================= |
# do something with the connection |
# do something with the connection |
Line 574 sub make_new_child {
|
Line 560 sub make_new_child {
|
$client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of |
$client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of |
# connection liveness. |
# connection liveness. |
# see if we know client and check for spoof IP by challenge |
# see if we know client and check for spoof IP by challenge |
my $caller=getpeername($client); |
my $caller = getpeername($client); |
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
my $clientip=inet_ntoa($iaddr); |
my $clientip=inet_ntoa($iaddr); |
my $clientrec=($hostid{$clientip} ne undef); |
my $clientrec=($hostid{$clientip} ne undef); |
Line 729 sub make_new_child {
|
Line 715 sub make_new_child {
|
} |
} |
} |
} |
} elsif ($howpwd eq 'krb4') { |
} elsif ($howpwd eq 'krb4') { |
$null=pack("C",0); |
$null=pack("C",0); |
unless ($upass=~/$null/) { |
unless ($upass=~/$null/) { |
$pwdcorrect=( |
my $krb4_error = &Authen::Krb4::get_pw_in_tkt |
Authen::Krb4::get_pw_in_tkt($uname,"", |
($uname,"",$contentpwd,'krbtgt', |
$contentpwd,'krbtgt',$contentpwd,1, |
$contentpwd,1,$upass); |
$upass) == 0); |
if (!$krb4_error) { |
} else { $pwdcorrect=0; } |
$pwdcorrect = 1; |
|
} else { |
|
$pwdcorrect=0; |
|
# log error if it is not a bad password |
|
if ($krb4_error != 62) { |
|
&logthis('krb4:'.$uname.','.$contentpwd.','. |
|
&Authen::Krb4::get_err_txt($Authen::Krb4::error)); |
|
} |
|
} |
|
} |
} elsif ($howpwd eq 'krb5') { |
} elsif ($howpwd eq 'krb5') { |
$null=pack("C",0); |
$null=pack("C",0); |
unless ($upass=~/$null/) { |
unless ($upass=~/$null/) { |
Line 1226 sub make_new_child {
|
Line 1221 sub make_new_child {
|
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
} |
} |
|
# ----------------------------------------------------------------- dumpcurrent |
|
} elsif ($userinput =~ /^dumpcurrent/) { |
|
my ($cmd,$udom,$uname,$namespace) |
|
=split(/:/,$userinput); |
|
$namespace=~s/\//\_/g; |
|
$namespace=~s/\W//g; |
|
my $qresult=''; |
|
my $proname=propath($udom,$uname); |
|
if (tie(%hash,'GDBM_File', |
|
"$proname/$namespace.db", |
|
&GDBM_READER(),0640)) { |
|
# Structure of %data: |
|
# $data{$symb}->{$parameter}=$value; |
|
# $data{$symb}->{'v.'.$parameter}=$version; |
|
# since $parameter will be unescaped, we do not |
|
# have to worry about silly parameter names... |
|
my %data = (); |
|
while (my ($key,$value) = each(%hash)) { |
|
my ($v,$symb,$param) = split(/:/,$key); |
|
next if ($v eq 'version' || $symb eq 'keys'); |
|
next if (exists($data{$symb}) && |
|
exists($data{$symb}->{$param}) && |
|
$data{$symb}->{'v.'.$param} > $v); |
|
#&logthis("v = ".$v." p = ".$param." s = ".$symb); |
|
$data{$symb}->{$param}=$value; |
|
$data{$symb}->{'v.'.$param}=$value; |
|
} |
|
if (untie(%hash)) { |
|
while (my ($symb,$param_hash) = each(%data)) { |
|
while(my ($param,$value) = each (%$param_hash)){ |
|
next if ($param =~ /^v\./); |
|
$qresult.=$symb.':'.$param.'='.$value.'&'; |
|
} |
|
} |
|
chop($qresult); |
|
print $client "$qresult\n"; |
|
} else { |
|
print $client "error:$!\n"; |
|
} |
|
} else { |
|
print $client "error:$!\n"; |
|
} |
# ------------------------------------------------------------------------ dump |
# ------------------------------------------------------------------------ dump |
} elsif ($userinput =~ /^dump/) { |
} elsif ($userinput =~ /^dump/) { |
my ($cmd,$udom,$uname,$namespace,$regexp) |
my ($cmd,$udom,$uname,$namespace,$regexp) |
Line 1503 sub make_new_child {
|
Line 1540 sub make_new_child {
|
&logthis("<font color=blue>WARNING: " |
&logthis("<font color=blue>WARNING: " |
."Rejected client $clientip, closing connection</font>"); |
."Rejected client $clientip, closing connection</font>"); |
} |
} |
} |
} |
|
|
# ============================================================================= |
# ============================================================================= |
|
|
&logthis("<font color=red>CRITICAL: " |
&logthis("<font color=red>CRITICAL: " |
."Disconnect from $clientip ($hostid{$clientip})</font>"); |
."Disconnect from $clientip ($hostid{$clientip})</font>"); |
# tidy up gracefully and finish |
|
|
|
$server->close(); |
|
|
|
# this exit is VERY important, otherwise the child will become |
# this exit is VERY important, otherwise the child will become |
# a producer of more and more children, forking yourself into |
# a producer of more and more children, forking yourself into |
# process death. |
# process death. |
exit; |
exit; |
} |
|
} |
} |
|
|
|
|