Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.178.2.14 and 1.178.2.23

version 1.178.2.14, 2004/04/07 09:39:18	version 1.178.2.23, 2004/05/07 17:57:18
Line 242 sub TieUserHash {	Line 242 sub TieUserHash {
# make the history log entry:	# make the history log entry:


unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {	if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) {
	my $args = scalar @_;
	Debug(" Opening history: $namespace $args");
my $hfh = IO::File->new(">>$proname/$namespace.hist");	my $hfh = IO::File->new(">>$proname/$namespace.hist");
if($hfh) {	if($hfh) {
my $now = time;	my $now = time;
Line 788 sub ChangePasswordHandler {	Line 790 sub ChangePasswordHandler {
# npass - New password.	# npass - New password.

my ($udom,$uname,$upass,$npass)=split(/:/,$tail);	my ($udom,$uname,$upass,$npass)=split(/:/,$tail);
chomp($npass);
$upass=&unescape($upass);	$upass=&unescape($upass);
$npass=&unescape($npass);	$npass=&unescape($npass);
&Debug("Trying to change password for $uname");	&Debug("Trying to change password for $uname");
Line 796 sub ChangePasswordHandler {	Line 798 sub ChangePasswordHandler {
# First require that the user can be authenticated with their	# First require that the user can be authenticated with their
# old password:	# old password:

my $validated = ValidUser($udom, $uname, $upass);	my $validated = ValidateUser($udom, $uname, $upass);
if($validated) {	if($validated) {
my $realpasswd = GetAuthType($udom, $uname); # Defined since authd.	my $realpasswd = GetAuthType($udom, $uname); # Defined since authd.

Line 1028 sub UpdateResourceHandler {	Line 1030 sub UpdateResourceHandler {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my $fname=$tail;	my $fname= $tail; # This allows interactive testing


my $ownership=ishome($fname);	my $ownership=ishome($fname);
if ($ownership eq 'not_owner') {	if ($ownership eq 'not_owner') {
if (-e $fname) {	if (-e $fname) {
Line 1138 sub FetchUserFileHandler {	Line 1142 sub FetchUserFileHandler {
}	}
RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0);	RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0);
#	#
# Authenticate access to a user file. Question? The token for athentication	# Authenticate access to a user file.
# is allowed to be sent as cleartext is this really what we want? This token
# represents the user's session id. Once it is forged does this allow too much
# access??
#	#
# Parameters:	# Parameters:
# $cmd - The command that got us here.	# $cmd - The command that got us here.
Line 1191 sub UnsubscribeHandler {	Line 1192 sub UnsubscribeHandler {
my $client = shift;	my $client = shift;
my $userinput= "$cmd:$tail";	my $userinput= "$cmd:$tail";

my $fname = $tail;	my ($fname) = $tail;

	Debug("Unsubscribing $fname");
if (-e $fname) {	if (-e $fname) {
Reply($client, &unsub($client,$fname,$clientip), $userinput);	Debug("Exists");
	Reply($client, &unsub($fname,$clientip), $userinput);
} else {	} else {
Failure($client, "not_found\n", $userinput);	Failure($client, "not_found\n", $userinput);
}	}
return 1;	return 1;
}	}
RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0);	RegisterHandler("unsub", \&UnsubscribeHandler, 0, 1, 0);

# Subscribe to a resource	# Subscribe to a resource
#	#
Line 1413 sub RolesPutHandler {	Line 1417 sub RolesPutHandler {
my $client = shift;	my $client = shift;
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($exedom,$exeuser,$udom,$uname,$what) =split(/:/,$tail);	my ( $exedom, $exeuser, $udom, $uname, $what) = split(/:/,$tail);
&Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom.
"what = ".$what);
my $namespace='roles';	my $namespace='roles';
chomp($what);	chomp($what);
my $hashref = TieUserHash($udom, $uname, $namespace,	my $hashref = TieUserHash($udom, $uname, $namespace,
Line 1617 sub GetProfileEntryEncrypted {	Line 1621 sub GetProfileEntryEncrypted {

return 1;	return 1;
}	}
RegisterHandler("eget", \&GetProfileEncrypted, 0, 1, 0);	RegisterHandler("eget", \&GetProfileEntryEncrypted, 0, 1, 0);

#	#
# Deletes a key in a user profile database.	# Deletes a key in a user profile database.
Line 1848 sub DumpWithRegexp {	Line 1852 sub DumpWithRegexp {
}	}
RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0);	RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0);

# Store an aitem in any database but the roles database.	# Store a set of key=value pairs associated with a versioned name.
#	#
# Parameters:	# Parameters:
# $cmd - Request command keyword.	# $cmd - Request command keyword.
Line 1914 sub StoreHandler {	Line 1918 sub StoreHandler {
}	}
RegisterHandler("store", \&StoreHandler, 0, 1, 0);	RegisterHandler("store", \&StoreHandler, 0, 1, 0);
#	#
# Restore a prior version of a resource.	# Dump out all versions of a resource that has key=value pairs associated
	# with it for each version. These resources are built up via the store
	# command.
#	#
# Parameters:	# Parameters:
# $cmd - Command keyword.	# $cmd - Command keyword.
Line 1928 RegisterHandler("store", \&StoreHandler,	Line 1934 RegisterHandler("store", \&StoreHandler,
# 1 indicating the caller should not yet exit.	# 1 indicating the caller should not yet exit.
# Side-effects:	# Side-effects:
# Writes a reply to the client.	# Writes a reply to the client.
	# The reply is a string of the following shape:
	# version=current&version:keys=k1:k2...&1:k1=v1&1:k2=v2...
	# Where the 1 above represents version 1.
	# this continues for all pairs of keys in all versions.
	#
	#
	#
#	#
sub RestoreHandler {	sub RestoreHandler {
my $cmd = shift;	my $cmd = shift;
Line 2223 sub DumpCourseIdHandler {	Line 2236 sub DumpCourseIdHandler {
}	}
unless (defined($since)) { $since=0; }	unless (defined($since)) { $since=0; }
my $qresult='';	my $qresult='';
	logthis(" Looking for $description since $since");
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());	my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
if ($hashref) {	if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
my ($descr,$lasttime)=split(/\:/,$value);	my ($descr,$lasttime)=split(/\:/,$value);
	logthis("Got: key = $key descr = $descr time: $lasttime");
if ($lasttime<$since) {	if ($lasttime<$since) {
	logthis("Skipping .. too early");
next;	next;
}	}
if ($description eq '.') {	if ($description eq '.') {
	logthis("Adding wildcard match");
$qresult.=$key.'='.$descr.'&';	$qresult.=$key.'='.$descr.'&';
} else {	} else {
my $unescapeVal = &unescape($descr);	my $unescapeVal = &unescape($descr);
if (eval('$unescapeVal=~/$description/i')) {	logthis("Matching with $unescapeVal");
	if (eval('$unescapeVal=~/\Q$description\E/i')) {
	logthis("Adding on match");
$qresult.="$key=$descr&";	$qresult.="$key=$descr&";
}	}
}	}
Line 2419 sub TmpGetHandler {	Line 2437 sub TmpGetHandler {
my $client = shift;	my $client = shift;
my $userinput = "$cmd:$id";	my $userinput = "$cmd:$id";

chomp($id);
$id=~s/\W/\_/g;	$id=~s/\W/\_/g;
my $store;	my $store;
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
Line 2493 sub LsHandler {	Line 2511 sub LsHandler {

my $userinput = "$cmd:$ulsdir";	my $userinput = "$cmd:$ulsdir";

	chomp($ulsdir);

my $ulsout='';	my $ulsout='';
my $ulsfn;	my $ulsfn;
	logthis("ls for '$ulsdir'");
if (-e $ulsdir) {	if (-e $ulsdir) {
	logthis("ls - directory exists");
if(-d $ulsdir) {	if(-d $ulsdir) {
	logthis("ls $ulsdir is a file");
if (opendir(LSDIR,$ulsdir)) {	if (opendir(LSDIR,$ulsdir)) {
while ($ulsfn=readdir(LSDIR)) {	while ($ulsfn=readdir(LSDIR)) {
my @ulsstats=stat($ulsdir.'/'.$ulsfn);	my @ulsstats=stat($ulsdir.'/'.$ulsfn);
Line 2680 sub ProcessRequest {	Line 2703 sub ProcessRequest {
# Split off the request keyword from the rest of the stuff.	# Split off the request keyword from the rest of the stuff.

my ($command, $tail) = split(/:/, $userinput, 2);	my ($command, $tail) = split(/:/, $userinput, 2);
	chomp($command);
	chomp($tail);
	$tail =~ s/(\r)//; # This helps people debugging with e.g. telnet.

Debug("Command received: $command, encoded = $wasenc");	Debug("Command received: $command, encoded = $wasenc");

Line 2721 sub ProcessRequest {	Line 2747 sub ProcessRequest {
$KeepGoing = &$Handler($command, $tail, $client);	$KeepGoing = &$Handler($command, $tail, $client);
} else {	} else {
Debug("Refusing to dispatch because ok is false");	Debug("Refusing to dispatch because ok is false");
Failure($client, "refused", $userinput);	Failure($client, "refused\n", $userinput);
}	}


Line 3808 sub propath {	Line 3834 sub propath {

sub ishome {	sub ishome {
my $author=shift;	my $author=shift;
	Debug("ishome: $author");
$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;	$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;
	Debug(" after big regsub: $author");
my ($udom,$uname)=split(/\//,$author);	my ($udom,$uname)=split(/\//,$author);
	Debug(" domain: $udom user: $uname");
my $proname=propath($udom,$uname);	my $proname=propath($udom,$uname);
	Debug(" path = $proname");
if (-e $proname) {	if (-e $proname) {
return 'owner';	return 'owner';
} else {	} else {
Line 4036 sub ManagePermissions {	Line 4066 sub ManagePermissions {
my $authtype= shift;	my $authtype= shift;

# See if the request is of the form /$domain/_au	# See if the request is of the form /$domain/_au
&logthis("ruequest is $request");	&logthis("request is $request");
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...	if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...
my $execdir = $perlvar{'lonDaemons'};	my $execdir = $perlvar{'lonDaemons'};
my $userhome= "/home/$user" ;	my $userhome= "/home/$user" ;
Line 4276 sub addline {	Line 4306 sub addline {
my $expr='^'.$hostid.':'.$ip.':';	my $expr='^'.$hostid.':'.$ip.':';
$expr =~ s/\./\\\./g;	$expr =~ s/\./\\\./g;
my $sh;	my $sh;
	Debug("Looking for $expr");
if ($sh=IO::File->new("$fname.subscription")) {	if ($sh=IO::File->new("$fname.subscription")) {
while (my $subline=<$sh>) {	while (my $subline=<$sh>) {
if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;}	Debug("addline: line: $subline");
	if ($subline !~ /$expr/) {
	$contents.= $subline;
	} else {
	Debug("Found $subline");
	$found=1;
	}
}	}
$sh->close();	$sh->close();
}	}
$sh=IO::File->new(">$fname.subscription");	$sh=IO::File->new(">$fname.subscription");
if ($contents) { print $sh $contents; }	if ($contents) { print $sh $contents; }
if ($newline) { print $sh $newline; }	if ($newline) {
	Debug("Appending $newline");
	print $sh $newline;
	}
$sh->close();	$sh->close();
return $found;	return $found;
}	}
Line 4357 sub chatadd {	Line 4397 sub chatadd {
sub unsub {	sub unsub {
my ($fname,$clientip)=@_;	my ($fname,$clientip)=@_;
my $result;	my $result;
	my $unsubs = 0; # Number of successful unsubscribes:


	# An old way subscriptions were handled was to have a
	# subscription marker file:

	Debug("Attempting unlink of $fname.$clientname");
if (unlink("$fname.$clientname")) {	if (unlink("$fname.$clientname")) {
$result="ok\n";	$unsubs++; # Successful unsub via marker file.
} else {	}
$result="not_subscribed\n";
}	# The more modern way to do it is to have a subscription list
	# file:

if (-e "$fname.subscription") {	if (-e "$fname.subscription") {
my $found=&addline($fname,$clientname,$clientip,'');	my $found=&addline($fname,$clientname,$clientip,'');
if ($found) { $result="ok\n"; }	if ($found) {
	$unsubs++;
	}
	}

	# If either or both of these mechanisms succeeded in unsubscribing a
	# resource we can return ok:

	if($unsubs) {
	$result = "ok\n";
} else {	} else {
if ($result != "ok\n") { $result="not_subscribed\n"; }	$result = "not_subscribed\n";
}	}

return $result;	return $result;
}	}

Line 4419 sub thisversion {	Line 4478 sub thisversion {

sub subscribe {	sub subscribe {
my ($userinput,$clientip)=@_;	my ($userinput,$clientip)=@_;
	chomp($userinput);
my $result;	my $result;
my ($cmd,$fname)=split(/:/,$userinput);	my ($cmd,$fname)=split(/:/,$userinput);
my $ownership=&ishome($fname);	my $ownership=&ishome($fname);
	Debug("subscribe: Owner = $ownership file: '$fname'");
if ($ownership eq 'owner') {	if ($ownership eq 'owner') {
# explitly asking for the current version?	# explitly asking for the current version?
unless (-e $fname) {	unless (-e $fname) {
	Debug("subscribe - does not exist");
my $currentversion=&currentversion($fname);	my $currentversion=&currentversion($fname);
if (&thisversion($fname)==$currentversion) {	if (&thisversion($fname)==$currentversion) {
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {	if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {
Line 4440 sub subscribe {	Line 4502 sub subscribe {
}	}
}	}
if (-e $fname) {	if (-e $fname) {
	Debug("subscribe - exists");
if (-d $fname) {	if (-d $fname) {
$result="directory\n";	$result="directory\n";
} else {	} else {
Line 4494 sub make_passwd_file {	Line 4557 sub make_passwd_file {
#	#
my $uid = getpwnam($uname);	my $uid = getpwnam($uname);
if((defined $uid) && ($uid == 0)) {	if((defined $uid) && ($uid == 0)) {
	&logthis(">>>Attempted add of privileged account blocked<<<");
return "no_priv_account_error\n";	return "no_priv_account_error\n";
}	}

Line 4509 sub make_passwd_file {	Line 4573 sub make_passwd_file {

my $useraddok = $?;	my $useraddok = $?;
if($useraddok > 0) {	if($useraddok > 0) {
&logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok));	my $lcstring = lcuseraddstrerror($useraddok);
	&logthis("Failed lcuseradd: $lcstring");
	return "error: lcuseradd failed: $lcstring\n";
}	}
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
print $pf "unix:\n";	print $pf "unix:\n";
Line 4527 sub make_passwd_file {	Line 4593 sub make_passwd_file {

sub sethost {	sub sethost {
my ($remotereq) = @_;	my ($remotereq) = @_;
	Debug("sethost got $remotereq");
my (undef,$hostid)=split(/:/,$remotereq);	my (undef,$hostid)=split(/:/,$remotereq);
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }	if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
	Debug("sethost attempting to set host $hostid");
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {	if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
$currenthostid=$hostid;	$currenthostid=$hostid;
$currentdomainid=$hostdom{$hostid};	$currentdomainid=$hostdom{$hostid};

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.178.2.14
changed lines
	Added in v.1.178.2.23