Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.47 and 1.57

version 1.47, 2001/05/11 19:31:25	version 1.57, 2001/11/26 20:31:01
Line 15	Line 15
# 03/15 Scott Harrison	# 03/15 Scott Harrison
# 03/24 Gerd Kortemeyer	# 03/24 Gerd Kortemeyer
# 04/02 Scott Harrison	# 04/02 Scott Harrison
# 05/11 Gerd Kortemeyer	# 05/11,05/28,08/30 Gerd Kortemeyer
	# 9/30,10/22,11/13,11/15,11/16 Scott Harrison
	# 11/26 Gerd Kortemeyer
#	#
	# $Id$
	###

# based on "Perl Cookbook" ISBN 1-56592-243-3	# based on "Perl Cookbook" ISBN 1-56592-243-3
# preforker - server who forks first	# preforker - server who forks first
# runs as a daemon	# runs as a daemon
Line 32 use Crypt::IDEA;	Line 37 use Crypt::IDEA;
use LWP::UserAgent();	use LWP::UserAgent();
use GDBM_File;	use GDBM_File;
use Authen::Krb4;	use Authen::Krb4;
	use lib '/home/httpd/lib/perl/';
	use localauth;

	my $status='';
	my $lastlog='';

# grabs exception and records it to log before exiting	# grabs exception and records it to log before exiting
sub catchexception {	sub catchexception {
Line 41 sub catchexception {	Line 51 sub catchexception {
&logthis("<font color=red>CRITICAL: "	&logthis("<font color=red>CRITICAL: "
."ABNORMAL EXIT. Child $$ for server $wasserver died through "	."ABNORMAL EXIT. Child $$ for server $wasserver died through "
."a crash with this error msg->[$error]</font>");	."a crash with this error msg->[$error]</font>");
	&logthis('Famous last words: '.$status.' - '.$lastlog);
if ($client) { print $client "error: $error\n"; }	if ($client) { print $client "error: $error\n"; }
die($error);	die($error);
}	}
Line 143 sub HUPSMAN { # sig	Line 154 sub HUPSMAN { # sig
exec("$execdir/lond"); # here we go again	exec("$execdir/lond"); # here we go again
}	}

	sub checkchildren {
	&initnewstatus();
	&logstatus();
	&logthis('Going to check on the children');
	map {
	sleep 1;
	unless (kill 'USR1' => $_) {
	&logthis ('Child '.$_.' is dead');
	&logstatus($$.' is dead');
	}
	} sort keys %children;
	}

# --------------------------------------------------------------------- Logging	# --------------------------------------------------------------------- Logging

sub logthis {	sub logthis {
Line 154 sub logthis {	Line 178 sub logthis {
print $fh "$local ($$): $message\n";	print $fh "$local ($$): $message\n";
}	}

	# ------------------------------------------------------------------ Log status

	sub logstatus {
	my $docdir=$perlvar{'lonDocRoot'};
	my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
	print $fh $$."\t".$status."\t".$lastlog."\n";
	}

	sub initnewstatus {
	my $docdir=$perlvar{'lonDocRoot'};
	my $fh=IO::File->new(">$docdir/lon-status/londstatus.txt");
	my $now=time;
	my $local=localtime($now);
	print $fh "LOND status $local - parent $$\n\n";
	}

	# -------------------------------------------------------------- Status setting

	sub status {
	my $what=shift;
	my $now=time;
	my $local=localtime($now);
	$status=$local.': '.$what;
	}

# -------------------------------------------------------- Escape Special Chars	# -------------------------------------------------------- Escape Special Chars

Line 300 open (PIDSAVE,">$execdir/logs/lond.pid")	Line 348 open (PIDSAVE,">$execdir/logs/lond.pid")
print PIDSAVE "$$\n";	print PIDSAVE "$$\n";
close(PIDSAVE);	close(PIDSAVE);
&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");	&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
	&status('Starting');

# ------------------------------------------------------- Now we are on our own	# ------------------------------------------------------- Now we are on our own

Line 310 for (1 .. $PREFORK) {	Line 359 for (1 .. $PREFORK) {

# ----------------------------------------------------- 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;

# And maintain the population.	# And maintain the population.
while (1) {	while (1) {
	&status('Sleeping');
sleep; # wait for a signal (i.e., child's death)	sleep; # wait for a signal (i.e., child's death)
	&logthis('Woke up');
	&status('Woke up');
for ($i = $children; $i < $PREFORK; $i++) {	for ($i = $children; $i < $PREFORK; $i++) {
make_new_child(); # top up the child pool	make_new_child(); # top up the child pool
}	}
Line 340 sub make_new_child {	Line 395 sub make_new_child {
or die "Can't unblock SIGINT for fork: $!\n";	or die "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = 1;	$children{$pid} = 1;
$children++;	$children++;
	&status('Started child '.$pid);
return;	return;
} else {	} else {
# Child can not return from this subroutine.	# Child can not return from this subroutine.
$SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before	$SIG{INT} = 'DEFAULT'; # make SIGINT kill us as it did before
	$SIG{USR1}= \&logstatus;
	$lastlog='Forked ';
	$status='Forked';

# unblock signals	# unblock signals
sigprocmask(SIG_UNBLOCK, $sigset)	sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";	or die "Can't unblock SIGINT for fork: $!\n";
Line 353 sub make_new_child {	Line 412 sub make_new_child {

# handle connections until we've reached $MAX_CLIENTS_PER_CHILD	# handle connections until we've reached $MAX_CLIENTS_PER_CHILD
for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {	for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
	&status('Idle, waiting for connection');
$client = $server->accept() or last;	$client = $server->accept() or last;
	&status('Accepted connection');
# =============================================================================	# =============================================================================
# do something with the connection	# do something with the connection
# -----------------------------------------------------------------------------	# -----------------------------------------------------------------------------
Line 364 sub make_new_child {	Line 424 sub make_new_child {
my $clientip=inet_ntoa($iaddr);	my $clientip=inet_ntoa($iaddr);
my $clientrec=($hostid{$clientip} ne undef);	my $clientrec=($hostid{$clientip} ne undef);
&logthis(	&logthis(
"<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>");	"<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"
	);
	&status("Connecting $clientip ($hostid{$clientip})");
my $clientok;	my $clientok;
if ($clientrec) {	if ($clientrec) {
	&status("Waiting for init from $clientip ($hostid{$clientip})");
my $remotereq=<$client>;	my $remotereq=<$client>;
$remotereq=~s/\W//g;	$remotereq=~s/\W//g;
if ($remotereq eq 'init') {	if ($remotereq eq 'init') {
my $challenge="$$".time;	my $challenge="$$".time;
print $client "$challenge\n";	print $client "$challenge\n";
	&status(
	"Waiting for challenge reply from $clientip ($hostid{$clientip})");
$remotereq=<$client>;	$remotereq=<$client>;
$remotereq=~s/\W//g;	$remotereq=~s/\W//g;
if ($challenge eq $remotereq) {	if ($challenge eq $remotereq) {
Line 381 sub make_new_child {	Line 446 sub make_new_child {
&logthis(	&logthis(
"<font color=blue>WARNING: $clientip did not reply challenge</font>");	"<font color=blue>WARNING: $clientip did not reply challenge</font>");
print $client "bye\n";	print $client "bye\n";
	&status('No challenge reply '.$clientip);
}	}
} else {	} else {
&logthis(	&logthis(
"<font color=blue>WARNING: "	"<font color=blue>WARNING: "
."$clientip failed to initialize: >$remotereq< </font>");	."$clientip failed to initialize: >$remotereq< </font>");
print $client "bye\n";	print $client "bye\n";
	&status('No init '.$clientip);
}	}
} else {	} else {
&logthis(	&logthis(
"<font color=blue>WARNING: Unknown client $clientip</font>");	"<font color=blue>WARNING: Unknown client $clientip</font>");
print $client "bye\n";	print $client "bye\n";
	&status('Hung up on '.$clientip);
}	}
if ($clientok) {	if ($clientok) {
# ---------------- New known client connecting, could mean machine online again	# ---------------- New known client connecting, could mean machine online again
&reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");	&reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
&logthis(	&logthis(
"<font color=green>Established connection: $hostid{$clientip}</font>");	"<font color=green>Established connection: $hostid{$clientip}</font>");
	&status('Listening to '.$hostid{$clientip});
# ------------------------------------------------------------ Process requests	# ------------------------------------------------------------ Process requests
while (my $userinput=<$client>) {	while (my $userinput=<$client>) {
chomp($userinput);	chomp($userinput);
	&status('Processing '.$hostid{$clientip}.': '.$userinput);
my $wasenc=0;	my $wasenc=0;
# ------------------------------------------------------------ See if encrypted	# ------------------------------------------------------------ See if encrypted
if ($userinput =~ /^enc/) {	if ($userinput =~ /^enc/) {
Line 449 sub make_new_child {	Line 519 sub make_new_child {
$loadavg =~ s/\s.*//g;	$loadavg =~ s/\s.*//g;
my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};	my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
print $client "$loadpercent\n";	print $client "$loadpercent\n";
	# ----------------------------------------------------------------- currentauth
	} elsif ($userinput =~ /^currentauth/) {
	if ($wasenc==1) {
	my ($cmd,$udom,$uname)=split(/:/,$userinput);
	my $proname=propath($udom,$uname);
	my $passfilename="$proname/passwd";
	if (-e $passfilename) {
	my $pf = IO::File->new($passfilename);
	my $realpasswd=<$pf>;
	chomp($realpasswd);
	my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
	my $availablecontent='';
	if ($howpwd eq 'krb4') {
	$availablecontent=$contentpwd;
	}
	print $client "$howpwd:$availablecontent\n";
	} else {
	print $client "unknown_user\n";
	}
	} else {
	print $client "refused\n";
	}
# ------------------------------------------------------------------------ auth	# ------------------------------------------------------------------------ auth
} elsif ($userinput =~ /^auth/) {	} elsif ($userinput =~ /^auth/) {
if ($wasenc==1) {	if ($wasenc==1) {
Line 468 sub make_new_child {	Line 560 sub make_new_child {
(crypt($upass,$contentpwd) eq $contentpwd);	(crypt($upass,$contentpwd) eq $contentpwd);
} elsif ($howpwd eq 'unix') {	} elsif ($howpwd eq 'unix') {
$contentpwd=(getpwnam($uname))[1];	$contentpwd=(getpwnam($uname))[1];
$pwdcorrect=	my $pwauth_path="/usr/local/sbin/pwauth";
(crypt($upass,$contentpwd) eq $contentpwd);	unless ($contentpwd eq 'x') {
	$pwdcorrect=
	(crypt($upass,$contentpwd) eq $contentpwd);
	}
	elsif (-e $pwauth_path) {
	open PWAUTH, "\|$pwauth_path" or
	die "Cannot invoke authentication";
	print PWAUTH "$uname\n$upass\n";
	close PWAUTH;
	$pwdcorrect=!$?;
	}
} elsif ($howpwd eq 'krb4') {	} elsif ($howpwd eq 'krb4') {
$pwdcorrect=(	$pwdcorrect=(
Authen::Krb4::get_pw_in_tkt($uname,"",	Authen::Krb4::get_pw_in_tkt($uname,"",
$contentpwd,'krbtgt',$contentpwd,1,	$contentpwd,'krbtgt',$contentpwd,1,
$upass) == 0);	$upass) == 0);
}	} elsif ($howpwd eq 'localauth') {
	$pwdcorrect=&localauth::localauth($uname,$upass,
	$contentpwd);
	}
if ($pwdcorrect) {	if ($pwdcorrect) {
print $client "authorized\n";	print $client "authorized\n";
} else {	} else {
Line 525 sub make_new_child {	Line 630 sub make_new_child {
}	}
# -------------------------------------------------------------------- makeuser	# -------------------------------------------------------------------- makeuser
} elsif ($userinput =~ /^makeuser/) {	} elsif ($userinput =~ /^makeuser/) {
	my $oldumask=umask(0077);
if ($wasenc==1) {	if ($wasenc==1) {
my	my
($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);	($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
Line 562 sub make_new_child {	Line 668 sub make_new_child {
{	{
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
print $pf "internal:$ncpass\n";	print $pf "internal:$ncpass\n";
}	}
print $client "ok\n";	print $client "ok\n";
} elsif ($umode eq 'none') {	} elsif ($umode eq 'localauth') {
	{
	my $pf = IO::File->new(">$passfilename");
	print $pf "localauth:$npass\n";
	}
	print $client "ok\n";
	} elsif ($umode eq 'unix') {
	{
	my $execpath="$perlvar{'lonDaemons'}/".
	"lcuseradd";
	{
	my $se = IO::File->new("\|$execpath");
	print $se "$uname\n";
	print $se "$npass\n";
	print $se "$npass\n";
	}
	my $pf = IO::File->new(">$passfilename");
	print $pf "unix:\n";
	}
	print $client "ok\n";
	} elsif ($umode eq 'none') {
{	{
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
print $pf "none:\n";	print $pf "none:\n";
Line 580 sub make_new_child {	Line 706 sub make_new_child {
} else {	} else {
print $client "refused\n";	print $client "refused\n";
}	}
	umask($oldumask);
	# -------------------------------------------------------------- changeuserauth
	} elsif ($userinput =~ /^changeuserauth/) {
	if ($wasenc==1) {
	my
	($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);
	chomp($npass);
	$npass=&unescape($npass);
	my $proname=propath($udom,$uname);
	my $passfilename="$proname/passwd";
	if ($udom ne $perlvar{'lonDefDomain'}) {
	print $client "not_right_domain\n";
	} else {
	if ($umode eq 'krb4') {
	{
	my $pf = IO::File->new(">$passfilename");
	print $pf "krb4:$npass\n";
	}
	print $client "ok\n";
	} elsif ($umode eq 'internal') {
	my $salt=time;
	$salt=substr($salt,6,2);
	my $ncpass=crypt($npass,$salt);
	{
	my $pf = IO::File->new(">$passfilename");
	print $pf "internal:$ncpass\n";
	}
	print $client "ok\n";
	} elsif ($umode eq 'localauth') {
	{
	my $pf = IO::File->new(">$passfilename");
	print $pf "localauth:$npass\n";
	}
	print $client "ok\n";
	} elsif ($umode eq 'unix') {
	{
	my $execpath="$perlvar{'lonDaemons'}/".
	"lcuseradd";
	{
	my $se = IO::File->new("\|$execpath");
	print $se "$uname\n";
	print $se "$npass\n";
	print $se "$npass\n";
	}
	my $pf = IO::File->new(">$passfilename");
	print $pf "unix:\n";
	}
	print $client "ok\n";
	} elsif ($umode eq 'none') {
	{
	my $pf = IO::File->new(">$passfilename");
	print $pf "none:\n";
	}
	print $client "ok\n";
	} else {
	print $client "auth_mode_error\n";
	}
	}
	} else {
	print $client "refused\n";
	}
# ------------------------------------------------------------------------ home	# ------------------------------------------------------------------------ home
} elsif ($userinput =~ /^home/) {	} elsif ($userinput =~ /^home/) {
my ($cmd,$udom,$uname)=split(/:/,$userinput);	my ($cmd,$udom,$uname)=split(/:/,$userinput);
Line 709 sub make_new_child {	Line 896 sub make_new_child {
chomp($what);	chomp($what);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $now=time;	my $now=time;
{	unless ($namespace=~/^nohist\_/) {
my $hfh;	my $hfh;
if (	if (
$hfh=IO::File->new(">>$proname/$namespace.hist")	$hfh=IO::File->new(">>$proname/$namespace.hist")
Line 834 sub make_new_child {	Line 1021 sub make_new_child {
chomp($what);	chomp($what);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $now=time;	my $now=time;
{	unless ($namespace=~/^nohist\_/) {
my $hfh;	my $hfh;
if (	if (
$hfh=IO::File->new(">>$proname/$namespace.hist")	$hfh=IO::File->new(">>$proname/$namespace.hist")
Line 905 sub make_new_child {	Line 1092 sub make_new_child {
chomp($what);	chomp($what);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $now=time;	my $now=time;
{	unless ($namespace=~/^nohist\_/) {
my $hfh;	my $hfh;
if (	if (
$hfh=IO::File->new(">>$proname/$namespace.hist")	$hfh=IO::File->new(">>$proname/$namespace.hist")
Line 1100 sub make_new_child {	Line 1287 sub make_new_child {
}	}
if ($ulsout eq '') { $ulsout='empty'; }	if ($ulsout eq '') { $ulsout='empty'; }
print $client "$ulsout\n";	print $client "$ulsout\n";
	# ------------------------------------------------------------------ Hanging up
	} elsif (($userinput =~ /^exit/) \|\|
	($userinput =~ /^init/)) {
	&logthis(
	"Client $clientip ($hostid{$clientip}) hanging up: $userinput");
	print $client "bye\n";
	last;
# ------------------------------------------------------------- unknown command	# ------------------------------------------------------------- unknown command
} else {	} else {
# unknown command	# unknown command

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

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.

Removed from v.1.47
changed lines
	Added in v.1.57