loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.4 and 1.10

version 1.4, 1999/11/04 20:53:04	version 1.10, 2000/02/08 17:39:23
Line 3	Line 3
# lond "LON Daemon" Server (port "LOND" 5663)	# lond "LON Daemon" Server (port "LOND" 5663)
# 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,	# 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,
# 7/8,7/9,7/10,7/12,7/17,7/19,9/21,	# 7/8,7/9,7/10,7/12,7/17,7/19,9/21,
# 10/7,10/8,10/9,10/11,10/13,10/15,11/4 Gerd Kortemeyer	# 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,
	# 12/7,12/15,01/06,01/11,01/12,01/14,2/8 Gerd Kortemeyer
# 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 27 open (CONFIG,"/etc/httpd/conf/access.con	Line 28 open (CONFIG,"/etc/httpd/conf/access.con
while ($configline=<CONFIG>) {	while ($configline=<CONFIG>) {
if ($configline =~ /PerlSetVar/) {	if ($configline =~ /PerlSetVar/) {
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);	my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
	chomp($varvalue);
$perlvar{$varname}=$varvalue;	$perlvar{$varname}=$varvalue;
}	}
}	}
Line 77 sub HUNTSMAN { # si	Line 79 sub HUNTSMAN { # si
kill 'INT' => keys %children;	kill 'INT' => keys %children;
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
unlink("$execdir/logs/lond.pid");	unlink("$execdir/logs/lond.pid");
&logthis("Shutting down");	&logthis("<font color=red>CRITICAL: Shutting down</font>");
exit; # clean up with dignity	exit; # clean up with dignity
}	}

Line 85 sub HUPSMAN { # sig	Line 87 sub HUPSMAN { # sig
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children	local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
kill 'INT' => keys %children;	kill 'INT' => keys %children;
close($server); # free up socket	close($server); # free up socket
&logthis("Restarting");	&logthis("<font color=red>CRITICAL: Restarting</font>");
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
exec("$execdir/lond"); # here we go again	exec("$execdir/lond"); # here we go again
}	}
Line 118 sub reconlonc {	Line 120 sub reconlonc {
&logthis("$peerfile still not there, give it another try");	&logthis("$peerfile still not there, give it another try");
sleep 5;	sleep 5;
if (-e "$peerfile") { return; }	if (-e "$peerfile") { return; }
&logthis("$peerfile still not there, giving up");	&logthis(
	"<font color=blue>WARNING: $peerfile still not there, giving up</font>");
} else {	} else {
&logthis("lonc at pid $loncpid not responding, giving up");	&logthis(
	"<font color=red>CRITICAL: "
	."lonc at pid $loncpid not responding, giving up</font>");
}	}
} else {	} else {
&logthis('lonc not running, giving up');	&logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');
}	}
}	}

Line 199 $execdir=$perlvar{'lonDaemons'};	Line 204 $execdir=$perlvar{'lonDaemons'};
open (PIDSAVE,">$execdir/logs/lond.pid");	open (PIDSAVE,">$execdir/logs/lond.pid");
print PIDSAVE "$$\n";	print PIDSAVE "$$\n";
close(PIDSAVE);	close(PIDSAVE);
&logthis("Starting");	&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");

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

Line 261 sub make_new_child {	Line 266 sub make_new_child {
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);
&logthis("Connect from $clientip ($hostid{$clientip})");	&logthis(
	"<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>");
my $clientok;	my $clientok;
if ($clientrec) {	if ($clientrec) {
my $remotereq=<$client>;	my $remotereq=<$client>;
Line 275 sub make_new_child {	Line 281 sub make_new_child {
$clientok=1;	$clientok=1;
print $client "ok\n";	print $client "ok\n";
} else {	} else {
&logthis("$clientip did not reply challenge");	&logthis(
	"<font color=blue>WARNING: $clientip did not reply challenge</font>");
}	}
} else {	} else {
&logthis("$clientip failed to initialize: >$remotereq<");	&logthis(
	"<font color=blue>WARNING: "
	."$clientip failed to initialize: >$remotereq< </font>");
}	}
} else {	} else {
&logthis("Unknown client $clientip");	&logthis(
	"<font color=blue>WARNING: Unknown client $clientip</font>");
}	}
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(
	"<font color=green>Established connection: $hostid{$clientip}</font>");
# ------------------------------------------------------------ Process requests	# ------------------------------------------------------------ Process requests
while (my $userinput=<$client>) {	while (my $userinput=<$client>) {
chomp($userinput);	chomp($userinput);
Line 494 sub make_new_child {	Line 506 sub make_new_child {
}	}
# ------------------------------------------------------------------------- put	# ------------------------------------------------------------------------- put
} elsif ($userinput =~ /^put/) {	} elsif ($userinput =~ /^put/) {
my ($cmd,$udom,$uname,$namespace,$what)	my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);	=split(/:/,$userinput);
$namespace=~s/\W//g;	$namespace=~s/\//\_/g;
	$namespace=~s/\W//g;
	if ($namespace ne 'roles') {
chomp($what);	chomp($what);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $now=time;	my $now=time;
Line 520 sub make_new_child {	Line 534 sub make_new_child {
} else {	} else {
print $client "error:$!\n";	print $client "error:$!\n";
}	}
	} else {
	print $client "refused\n";
	}
	# -------------------------------------------------------------------- rolesput
	} elsif ($userinput =~ /^rolesput/) {
	if ($wasenc==1) {
	my ($cmd,$exedom,$exeuser,$udom,$uname,$what)
	=split(/:/,$userinput);
	my $namespace='roles';
	chomp($what);
	my $proname=propath($udom,$uname);
	my $now=time;
	{
	my $hfh;
	if (
	$hfh=IO::File->new(">>$proname/$namespace.hist")
	) {
	print $hfh "P:$now:$exedom:$exeuser:$what\n";
	}
	}
	my @pairs=split(/\&/,$what);
	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
	foreach $pair (@pairs) {
	($key,$value)=split(/=/,$pair);
	$hash{$key}=$value;
	}
	if (untie(%hash)) {
	print $client "ok\n";
	} else {
	print $client "error:$!\n";
	}
	} else {
	print $client "error:$!\n";
	}
	} else {
	print $client "refused\n";
	}
# ------------------------------------------------------------------------- get	# ------------------------------------------------------------------------- get
} elsif ($userinput =~ /^get/) {	} elsif ($userinput =~ /^get/) {
my ($cmd,$udom,$uname,$namespace,$what)	my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);	=split(/:/,$userinput);
	$namespace=~s/\//\_/g;
$namespace=~s/\W//g;	$namespace=~s/\W//g;
chomp($what);	chomp($what);
my @queries=split(/\&/,$what);	my @queries=split(/\&/,$what);
Line 546 sub make_new_child {	Line 598 sub make_new_child {
} elsif ($userinput =~ /^eget/) {	} elsif ($userinput =~ /^eget/) {
my ($cmd,$udom,$uname,$namespace,$what)	my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);	=split(/:/,$userinput);
	$namespace=~s/\//\_/g;
$namespace=~s/\W//g;	$namespace=~s/\W//g;
chomp($what);	chomp($what);
my @queries=split(/\&/,$what);	my @queries=split(/\&/,$what);
Line 581 sub make_new_child {	Line 634 sub make_new_child {
} elsif ($userinput =~ /^del/) {	} elsif ($userinput =~ /^del/) {
my ($cmd,$udom,$uname,$namespace,$what)	my ($cmd,$udom,$uname,$namespace,$what)
=split(/:/,$userinput);	=split(/:/,$userinput);
	$namespace=~s/\//\_/g;
$namespace=~s/\W//g;	$namespace=~s/\W//g;
chomp($what);	chomp($what);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
Line 608 sub make_new_child {	Line 662 sub make_new_child {
} elsif ($userinput =~ /^keys/) {	} elsif ($userinput =~ /^keys/) {
my ($cmd,$udom,$uname,$namespace)	my ($cmd,$udom,$uname,$namespace)
=split(/:/,$userinput);	=split(/:/,$userinput);
	$namespace=~s/\//\_/g;
$namespace=~s/\W//g;	$namespace=~s/\W//g;
chomp($namespace);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $qresult='';	my $qresult='';
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
Line 629 sub make_new_child {	Line 683 sub make_new_child {
} elsif ($userinput =~ /^dump/) {	} elsif ($userinput =~ /^dump/) {
my ($cmd,$udom,$uname,$namespace)	my ($cmd,$udom,$uname,$namespace)
=split(/:/,$userinput);	=split(/:/,$userinput);
	$namespace=~s/\//\_/g;
$namespace=~s/\W//g;	$namespace=~s/\W//g;
chomp($namespace);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $qresult='';	my $qresult='';
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
Line 646 sub make_new_child {	Line 700 sub make_new_child {
} else {	} else {
print $client "error:$!\n";	print $client "error:$!\n";
}	}
	# ----------------------------------------------------------------------- store
	} elsif ($userinput =~ /^store/) {
	my ($cmd,$udom,$uname,$namespace,$rid,$what)
	=split(/:/,$userinput);
	$namespace=~s/\//\_/g;
	$namespace=~s/\W//g;
	if ($namespace ne 'roles') {
	chomp($what);
	my $proname=propath($udom,$uname);
	my $now=time;
	{
	my $hfh;
	if (
	$hfh=IO::File->new(">>$proname/$namespace.hist")
	) { print $hfh "P:$now:$rid:$what\n"; }
	}
	my @pairs=split(/\&/,$what);

	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
	my @previouskeys=split(/&/,$hash{"keys:$rid"});
	my $key;
	$hash{"version:$rid"}++;
	my $version=$hash{"version:$rid"};
	my $allkeys='';
	foreach $pair (@pairs) {
	($key,$value)=split(/=/,$pair);
	$allkeys.=$key.':';
	$hash{"$version:$rid:$key"}=$value;
	}
	$allkeys=~s/:$//;
	$hash{"$version:keys:$rid"}=$allkeys;
	if (untie(%hash)) {
	print $client "ok\n";
	} else {
	print $client "error:$!\n";
	}
	} else {
	print $client "error:$!\n";
	}
	} else {
	print $client "refused\n";
	}
	# --------------------------------------------------------------------- restore
	} elsif ($userinput =~ /^restore/) {
	my ($cmd,$udom,$uname,$namespace,$rid)
	=split(/:/,$userinput);
	$namespace=~s/\//\_/g;
	$namespace=~s/\W//g;
	chomp($rid);
	my $proname=propath($udom,$uname);
	my $qresult='';
	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
	my $version=$hash{"version:$rid"};
	$qresult.="version=$version&";
	my $scope;
	for ($scope=1;$scope<=$version;$scope++) {
	my $vkeys=$hash{"$scope:keys:$rid"};
	my @keys=split(/:/,$vkeys);
	my $key;
	$qresult.="$scope:keys=$vkeys&";
	foreach $key (@keys) {
	$qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&";
	}
	}
	if (untie(%hash)) {
	$qresult=~s/\&$//;
	print $client "$qresult\n";
	} else {
	print $client "error:$!\n";
	}
	} else {
	print $client "error:$!\n";
	}
# ----------------------------------------------------------------------- idput	# ----------------------------------------------------------------------- idput
} elsif ($userinput =~ /^idput/) {	} elsif ($userinput =~ /^idput/) {
my ($cmd,$udom,$what)=split(/:/,$userinput);	my ($cmd,$udom,$what)=split(/:/,$userinput);
Line 694 sub make_new_child {	Line 821 sub make_new_child {
} else {	} else {
print $client "error:$!\n";	print $client "error:$!\n";
}	}
	# -------------------------------------------------------------------------- ls
	} elsif ($userinput =~ /^ls/) {
	my ($cmd,$ulsdir)=split(/:/,$userinput);
	my $ulsout='';
	my $ulsfn;
	if (-e $ulsdir) {
	while ($ulsfn=<$ulsdir/*>) {
	my @ulsstats=stat($ulsfn);
	$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
	}
	} else {
	$ulsout='no_such_dir';
	}
	print $client "$ulsout\n";
# ------------------------------------------------------------- unknown command	# ------------------------------------------------------------- unknown command
} else {	} else {
# unknown command	# unknown command
Line 703 sub make_new_child {	Line 844 sub make_new_child {
}	}
} else {	} else {
print $client "refused\n";	print $client "refused\n";
&logthis("Rejected client $clientip, closing connection");	&logthis("<font color=blue>WARNING: "
	."Rejected client $clientip, closing connection</font>");
}	}
&logthis("Disconnect from $clientip ($hostid{$clientip})");	&logthis("<font color=red>CRITICAL: "
	."Disconnect from $clientip ($hostid{$clientip})</font>");
# =============================================================================	# =============================================================================
}	}

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

Removed from v.1.4
changed lines
	Added in v.1.10