loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.2 and 1.7

version 1.2, 1999/10/26 20:24:47	version 1.7, 2000/01/12 19:30:43
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 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 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 17 use Symbol;	Line 18 use Symbol;
use POSIX;	use POSIX;
use Crypt::IDEA;	use Crypt::IDEA;
use LWP::UserAgent();	use LWP::UserAgent();
	use GDBM_File;
	use Authen::Krb4;

# ------------------------------------ Read httpd access.conf and get variables	# ------------------------------------ Read httpd access.conf and get variables

Line 25 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 355 sub make_new_child {	Line 359 sub make_new_child {
$contentpwd=(getpwnam($uname))[1];	$contentpwd=(getpwnam($uname))[1];
$pwdcorrect=	$pwdcorrect=
(crypt($upass,$contentpwd) eq $contentpwd);	(crypt($upass,$contentpwd) eq $contentpwd);
	} elsif ($howpwd eq 'krb4') {
	$pwdcorrect=(
	Authen::Krb4::get_pw_in_tkt($uname,"",
	$contentpwd,'krbtgt',$contentpwd,1,
	$upass) == 0);
}	}
if ($pwdcorrect) {	if ($pwdcorrect) {
print $client "authorized\n";	print $client "authorized\n";
Line 487 sub make_new_child {	Line 496 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/\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 500 sub make_new_child {	Line 510 sub make_new_child {
) { print $hfh "P:$now:$what\n"; }	) { print $hfh "P:$now:$what\n"; }
}	}
my @pairs=split(/\&/,$what);	my @pairs=split(/\&/,$what);
if (dbmopen(%hash,"$proname/$namespace.db",0644)) {	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";
	}
	# -------------------------------------------------------------------- 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) {	foreach $pair (@pairs) {
($key,$value)=split(/=/,$pair);	($key,$value)=split(/=/,$pair);
$hash{$key}=$value;	$hash{$key}=$value;
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
print $client "ok\n";	print $client "ok\n";
} else {	} else {
print $client "error:$!\n";	print $client "error:$!\n";
Line 513 sub make_new_child {	Line 557 sub make_new_child {
} else {	} else {
print $client "error:$!\n";	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)
Line 522 sub make_new_child {	Line 569 sub make_new_child {
my @queries=split(/\&/,$what);	my @queries=split(/\&/,$what);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $qresult='';	my $qresult='';
if (dbmopen(%hash,"$proname/$namespace.db",0644)) {	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
for ($i=0;$i<=$#queries;$i++) {	for ($i=0;$i<=$#queries;$i++) {
$qresult.="$hash{$queries[$i]}&";	$qresult.="$hash{$queries[$i]}&";
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
print $client "$qresult\n";	print $client "$qresult\n";
} else {	} else {
Line 544 sub make_new_child {	Line 591 sub make_new_child {
my @queries=split(/\&/,$what);	my @queries=split(/\&/,$what);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $qresult='';	my $qresult='';
if (dbmopen(%hash,"$proname/$namespace.db",0644)) {	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
for ($i=0;$i<=$#queries;$i++) {	for ($i=0;$i<=$#queries;$i++) {
$qresult.="$hash{$queries[$i]}&";	$qresult.="$hash{$queries[$i]}&";
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
if ($cipher) {	if ($cipher) {
my $cmdlength=length($qresult);	my $cmdlength=length($qresult);
Line 585 sub make_new_child {	Line 632 sub make_new_child {
) { print $hfh "D:$now:$what\n"; }	) { print $hfh "D:$now:$what\n"; }
}	}
my @keys=split(/\&/,$what);	my @keys=split(/\&/,$what);
if (dbmopen(%hash,"$proname/$namespace.db",0644)) {	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
foreach $key (@keys) {	foreach $key (@keys) {
delete($hash{$key});	delete($hash{$key});
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
print $client "ok\n";	print $client "ok\n";
} else {	} else {
print $client "error:$!\n";	print $client "error:$!\n";
Line 605 sub make_new_child {	Line 652 sub make_new_child {
chomp($namespace);	chomp($namespace);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $qresult='';	my $qresult='';
if (dbmopen(%hash,"$proname/$namespace.db",0644)) {	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
foreach $key (keys %hash) {	foreach $key (keys %hash) {
$qresult.="$key&";	$qresult.="$key&";
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
print $client "$qresult\n";	print $client "$qresult\n";
} else {	} else {
Line 626 sub make_new_child {	Line 673 sub make_new_child {
chomp($namespace);	chomp($namespace);
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
my $qresult='';	my $qresult='';
if (dbmopen(%hash,"$proname/$namespace.db",0644)) {	if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
foreach $key (keys %hash) {	foreach $key (keys %hash) {
$qresult.="$key=$hash{$key}&";	$qresult.="$key=$hash{$key}&";
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
	$qresult=~s/\&$//;
	print $client "$qresult\n";
	} else {
	print $client "error:$!\n";
	}
	} else {
	print $client "error:$!\n";
	}
	# ----------------------------------------------------------------------- store
	} elsif ($userinput =~ /^store/) {
	my ($cmd,$udom,$uname,$namespace,$rid,$what)
	=split(/:/,$userinput);
	$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/\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/\&$//;	$qresult=~s/\&$//;
print $client "$qresult\n";	print $client "$qresult\n";
} else {	} else {
Line 653 sub make_new_child {	Line 771 sub make_new_child {
) { print $hfh "P:$now:$what\n"; }	) { print $hfh "P:$now:$what\n"; }
}	}
my @pairs=split(/\&/,$what);	my @pairs=split(/\&/,$what);
if (dbmopen(%hash,"$proname.db",0644)) {	if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
foreach $pair (@pairs) {	foreach $pair (@pairs) {
($key,$value)=split(/=/,$pair);	($key,$value)=split(/=/,$pair);
$hash{$key}=$value;	$hash{$key}=$value;
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
print $client "ok\n";	print $client "ok\n";
} else {	} else {
print $client "error:$!\n";	print $client "error:$!\n";
Line 674 sub make_new_child {	Line 792 sub make_new_child {
my $proname="$perlvar{'lonUsersDir'}/$udom/ids";	my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
my @queries=split(/\&/,$what);	my @queries=split(/\&/,$what);
my $qresult='';	my $qresult='';
if (dbmopen(%hash,"$proname.db",0644)) {	if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) {
for ($i=0;$i<=$#queries;$i++) {	for ($i=0;$i<=$#queries;$i++) {
$qresult.="$hash{$queries[$i]}&";	$qresult.="$hash{$queries[$i]}&";
}	}
if (dbmclose(%hash)) {	if (untie(%hash)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
print $client "$qresult\n";	print $client "$qresult\n";
} else {	} else {
Line 687 sub make_new_child {	Line 805 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

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

Removed from v.1.2
changed lines
	Added in v.1.7