loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.249 and 1.261

version 1.249, 2004/09/07 10:05:23	version 1.261, 2004/10/18 10:13:46
Line 331 sub InsecureConnection {	Line 331 sub InsecureConnection {


}	}

#	#
	# Safely execute a command (as long as it's not a shel command and doesn
	# not require/rely on shell escapes. The function operates by doing a
	# a pipe based fork and capturing stdout and stderr from the pipe.
	#
	# Formal Parameters:
	# $line - A line of text to be executed as a command.
	# Returns:
	# The output from that command. If the output is multiline the caller
	# must know how to split up the output.
	#
	#
	sub execute_command {
	my ($line) = @_;
	my @words = split(/\s/, $line); # Bust the command up into words.
	my $output = "";

	my $pid = open(CHILD, "-\|");

	if($pid) { # Parent process
	Debug("In parent process for execute_command");
	my @data = <CHILD>; # Read the child's outupt...
	close CHILD;
	foreach my $output_line (@data) {
	Debug("Adding $output_line");
	$output .= $output_line; # Presumably has a \n on it.
	}

	} else { # Child process
	close (STDERR);
	open (STDERR, ">&STDOUT");# Combine stderr, and stdout...
	exec(@words); # won't return.
	}
	return $output;
	}


# GetCertificate: Given a transaction that requires a certificate,	# GetCertificate: Given a transaction that requires a certificate,
# this function will extract the certificate from the transaction	# this function will extract the certificate from the transaction
# request. Note that at this point, the only concept of a certificate	# request. Note that at this point, the only concept of a certificate
Line 1013 sub tie_user_hash {	Line 1048 sub tie_user_hash {
$how, 0640)) {	$how, 0640)) {
# If this is a namespace for which a history is kept,	# If this is a namespace for which a history is kept,
# make the history log entry:	# make the history log entry:
if (($namespace =~/^nohist\_/) && (defined($loghead))) {	if (($namespace !~/^nohist\_/) && (defined($loghead))) {
my $args = scalar @_;	my $args = scalar @_;
Debug(" Opening history: $namespace $args");	Debug(" Opening history: $namespace $args");
my $hfh = IO::File->new(">>$proname/$namespace.hist");	my $hfh = IO::File->new(">>$proname/$namespace.hist");
Line 1030 sub tie_user_hash {	Line 1065 sub tie_user_hash {

}	}

	# read_profile
	#
	# Returns a set of specific entries from a user's profile file.
	# this is a utility function that is used by both get_profile_entry and
	# get_profile_entry_encrypted.
	#
	# Parameters:
	# udom - Domain in which the user exists.
	# uname - User's account name (loncapa account)
	# namespace - The profile namespace to open.
	# what - A set of & separated queries.
	# Returns:
	# If all ok: - The string that needs to be shipped back to the user.
	# If failure - A string that starts with error: followed by the failure
	# reason.. note that this probabyl gets shipped back to the
	# user as well.
	#
	sub read_profile {
	my ($udom, $uname, $namespace, $what) = @_;

	my $hashref = &tie_user_hash($udom, $uname, $namespace,
	&GDBM_READER());
	if ($hashref) {
	my @queries=split(/\&/,$what);
	my $qresult='';

	for (my $i=0;$i<=$#queries;$i++) {
	$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string.
	}
	$qresult=~s/\&$//; # Remove trailing & from last lookup.
	if (untie %$hashref) {
	return $qresult;
	} else {
	return "error: ".($!+0)." untie (GDBM) Failed";
	}
	} else {
	if ($!+0 == 2) {
	return "error:No such file or GDBM reported bad block error";
	} else {
	return "error: ".($!+0)." tie (GDBM) Failed";
	}
	}

	}
#--------------------- Request Handlers --------------------------------------------	#--------------------- Request Handlers --------------------------------------------
#	#
# By convention each request handler registers itself prior to the sub	# By convention each request handler registers itself prior to the sub
Line 1302 sub push_file_handler {	Line 1381 sub push_file_handler {

sub du_handler {	sub du_handler {
my ($cmd, $ududir, $client) = @_;	my ($cmd, $ududir, $client) = @_;
	my ($ududir) = split(/:/,$ududir); # Make 'telnet' testing easier.
	my $userinput = "$cmd:$ududir";

if ($ududir=~/\.\./ \|\| $ududir!~m\|^/home/httpd/\|) {	if ($ududir=~/\.\./ \|\| $ududir!~m\|^/home/httpd/\|) {
&Failure($client,"refused\n","$cmd:$ududir");	&Failure($client,"refused\n","$cmd:$ududir");
return 1;	return 1;
Line 1314 sub du_handler {	Line 1396 sub du_handler {
#	#
if (-d $ududir) {	if (-d $ududir) {
# And as Shakespeare would say to make	# And as Shakespeare would say to make
# assurance double sure, quote the $ududir	# assurance double sure,
# This is in case someone manages to first	# use execute_command to ensure that the command is not executed in
# e.g. fabricate a valid directory with a ';'	# a shell that can screw us up.
# in it. Quoting the dir will help
# keep $ududir completely interpreted as a	my $duout = execute_command("du -ks $ududir");
# directory.
#
my $duout = `du -ks "$ududir" 2>/dev/null`;
$duout=~s/[^\d]//g; #preserve only the numbers	$duout=~s/[^\d]//g; #preserve only the numbers
&Reply($client,"$duout\n","$cmd:$ududir");	&Reply($client,"$duout\n","$cmd:$ududir");
} else {	} else {
&Failure($client, "bad_directory:$ududir", $userinput);
	&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir");

}	}
return 1;	return 1;
}	}
Line 1725 sub change_authentication_handler {	Line 1806 sub change_authentication_handler {
chomp($npass);	chomp($npass);

$npass=&unescape($npass);	$npass=&unescape($npass);
	my $oldauth = &get_auth_type($udom, $uname); # Get old auth info.
my $passfilename = &password_path($udom, $uname);	my $passfilename = &password_path($udom, $uname);
if ($passfilename) { # Not allowed to create a new user!!	if ($passfilename) { # Not allowed to create a new user!!
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);	my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
	#
	# If the current auth mode is internal, and the old auth mode was
	# unix, or krb*, and the user is an author for this domain,
	# re-run manage_permissions for that role in order to be able
	# to take ownership of the construction space back to www:www
	#

	if( ($oldauth =~ /^unix/) && ($umode eq "internal")) { # unix -> internal
	if(&is_author($udom, $uname)) {
	&Debug(" Need to manage author permissions...");
	&manage_permissions("/$udom/_au", $udom, $uname, "internal:");
	}
	}


&Reply($client, $result, $userinput);	&Reply($client, $result, $userinput);
} else {	} else {
&Failure($client, "non_authorized", $userinput); # Fail the user now.	&Failure($client, "non_authorized\n", $userinput); # Fail the user now.
}	}
}	}
return 1;	return 1;
Line 1957 sub remove_user_file_handler {	Line 2054 sub remove_user_file_handler {
if (-e $udir) {	if (-e $udir) {
my $file=$udir.'/userfiles/'.$ufile;	my $file=$udir.'/userfiles/'.$ufile;
if (-e $file) {	if (-e $file) {
	#
	# If the file is a regular file unlink is fine...
	# However it's possible the client wants a dir.
	# removed, in which case rmdir is more approprate:
	#
if (-f $file){	if (-f $file){
unlink($file);	unlink($file);
} elsif(-d $file) {	} elsif(-d $file) {
rmdir($file);	rmdir($file);
}	}
if (-e $file) {	if (-e $file) {
	# File is still there after we deleted it ?!?

&Failure($client, "failed\n", "$cmd:$tail");	&Failure($client, "failed\n", "$cmd:$tail");
} else {	} else {
&Reply($client, "ok\n", "$cmd:$tail");	&Reply($client, "ok\n", "$cmd:$tail");
Line 2003 sub mkdir_user_file_handler {	Line 2107 sub mkdir_user_file_handler {
if (-e $udir) {	if (-e $udir) {
my $newdir=$udir.'/userfiles/'.$ufile;	my $newdir=$udir.'/userfiles/'.$ufile;
if (!-e $newdir) {	if (!-e $newdir) {
mkdir($newdir);	my @parts=split('/',$newdir);
	my $path;
	foreach my $part (@parts) {
	$path .= '/'.$part;
	if (!-e $path) {
	mkdir($path,0770);
	}
	}
if (!-e $newdir) {	if (!-e $newdir) {
&Failure($client, "failed\n", "$cmd:$tail");	&Failure($client, "failed\n", "$cmd:$tail");
} else {	} else {
Line 2081 sub token_auth_user_file_handler {	Line 2192 sub token_auth_user_file_handler {
my ($fname, $session) = split(/:/, $tail);	my ($fname, $session) = split(/:/, $tail);

chomp($session);	chomp($session);
my $reply='non_auth';	my $reply="non_auth\n";
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.	if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
$session.'.id')) {	$session.'.id')) {
while (my $line=<ENVIN>) {	while (my $line=<ENVIN>) {
if ($line=~ m\|userfile\.\Q$fname\E\=\|) { $reply='ok'; }	if ($line=~ m\|userfile\.\Q$fname\E\=\|) { $reply="ok\n"; }
}	}
close(ENVIN);	close(ENVIN);
&Reply($client, $reply);	&Reply($client, $reply, "$cmd:$tail");
} else {	} else {
&Failure($client, "invalid_token\n", "$cmd:$tail");	&Failure($client, "invalid_token\n", "$cmd:$tail");
}	}
Line 2350 sub roles_put_handler {	Line 2461 sub roles_put_handler {
# is done on close this improves the chances the log will be an un-	# is done on close this improves the chances the log will be an un-
# corrupted ordered thing.	# corrupted ordered thing.
if ($hashref) {	if ($hashref) {
	my $pass_entry = &get_auth_type($udom, $uname);
	my ($auth_type,$pwd) = split(/:/, $pass_entry);
	$auth_type = $auth_type.":";
my @pairs=split(/\&/,$what);	my @pairs=split(/\&/,$what);
foreach my $pair (@pairs) {	foreach my $pair (@pairs) {
my ($key,$value)=split(/=/,$pair);	my ($key,$value)=split(/=/,$pair);
&manage_permissions($key, $udom, $uname,	&manage_permissions($key, $udom, $uname,
&get_auth_type( $udom, $uname));	$auth_type);
$hashref->{$key}=$value;	$hashref->{$key}=$value;
}	}
if (untie($hashref)) {	if (untie($hashref)) {
Line 2449 sub get_profile_entry {	Line 2563 sub get_profile_entry {

my ($udom,$uname,$namespace,$what) = split(/:/,$tail);	my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
chomp($what);	chomp($what);
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());	my $replystring = read_profile($udom, $uname, $namespace, $what);
if ($hashref) {	my ($first) = split(/:/,$replystring);
my @queries=split(/\&/,$what);	if($first ne "error") {
my $qresult='';	&Reply($client, "$replystring\n", $userinput);

for (my $i=0;$i<=$#queries;$i++) {
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string.
}
$qresult=~s/\&$//; # Remove trailing & from last lookup.
if (untie(%$hashref)) {
&Reply($client, "$qresult\n", $userinput);
} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting get\n", $userinput);
}
} else {	} else {
if ($!+0 == 2) { # +0 coerces errno -> number 2 is ENOENT	&Failure($client, $replystring." while attempting get\n", $userinput);
&Failure($client, "error:No such file or ".
"GDBM reported bad block error\n", $userinput);
} else { # Some other undifferentiated err.
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
"while attempting get\n", $userinput);
}
}	}
return 1;	return 1;


}	}
&register_handler("get", \&get_profile_entry, 0,1,0);	&register_handler("get", \&get_profile_entry, 0,1,0);

Line 2504 sub get_profile_entry_encrypted {	Line 2603 sub get_profile_entry_encrypted {

my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);	my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
chomp($what);	chomp($what);
my $hashref = &tie_user_hash($udom, $uname, $namespace,	my $qresult = read_profile($udom, $uname, $namespace, $what);
&GDBM_READER());	my ($first) = split(/:/, $qresult);
if ($hashref) {	if($first ne "error") {
my @queries=split(/\&/,$what);
my $qresult='';	if ($cipher) {
for (my $i=0;$i<=$#queries;$i++) {	my $cmdlength=length($qresult);
$qresult.="$hashref->{$queries[$i]}&";	$qresult.=" ";
}	my $encqresult='';
if (untie(%$hashref)) {	for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
$qresult=~s/\&$//;	$encqresult.= unpack("H16",
if ($cipher) {	$cipher->encrypt(substr($qresult,
my $cmdlength=length($qresult);	$encidx,
$qresult.=" ";	8)));
my $encqresult='';
for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
$encqresult.= unpack("H16",
$cipher->encrypt(substr($qresult,
$encidx,
8)));
}
&Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
} else {
&Failure( $client, "error:no_key\n", $userinput);
}	}
	&Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure( $client, "error:no_key\n", $userinput);
"while attempting eget\n", $userinput);	}
}
} else {	} else {
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".	&Failure($client, "$qresult while attempting eget\n", $userinput);
"while attempting eget\n", $userinput);
}	}

return 1;	return 1;
}	}
&register_handler("eget", \&GetProfileEntryEncrypted, 0, 1, 0);	&register_handler("eget", \&get_profile_entry_encrypted, 0, 1, 0);
#	#
# Deletes a key in a user profile database.	# Deletes a key in a user profile database.
#	#
Line 3087 sub put_course_id_handler {	Line 3176 sub put_course_id_handler {
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());	my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
if ($hashref) {	if ($hashref) {
foreach my $pair (@pairs) {	foreach my $pair (@pairs) {
my ($key,$value)=split(/=/,$pair);	my ($key,$descr,$inst_code)=split(/=/,$pair);
$hashref->{$key}=$value.':'.$now;	$hashref->{$key}=$descr.':'.$inst_code.':'.$now;
}	}
if (untie(%$hashref)) {	if (untie(%$hashref)) {
&Reply($client, "ok\n", $userinput);	&Reply( $client, "ok\n", $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)	&Failure($client, "error: ".($!+0)
." untie(GDBM) Failed ".	." untie(GDBM) Failed ".
"while attempting courseidput\n", $userinput);	"while attempting courseidput\n", $userinput);
}	}
} else {	} else {
&Failure( $client, "error: ".($!+0)	&Failure($client, "error: ".($!+0)
." tie(GDBM) Failed ".	." tie(GDBM) Failed ".
"while attempting courseidput\n", $userinput);	"while attempting courseidput\n", $userinput);
}	}


return 1;	return 1;
}	}
Line 3799 sub process_request {	Line 3889 sub process_request {
$userinput = decipher($userinput);	$userinput = decipher($userinput);
$wasenc=1;	$wasenc=1;
if(!$userinput) { # Cipher not defined.	if(!$userinput) { # Cipher not defined.
&Failure($client, "error: Encrypted data without negotated key");	&Failure($client, "error: Encrypted data without negotated key\n");
return 0;	return 0;
}	}
}	}
Line 4851 sub make_new_child {	Line 4941 sub make_new_child {
exit;	exit;

}	}
	#
	# Determine if a user is an author for the indicated domain.
	#
	# Parameters:
	# domain - domain to check in .
	# user - Name of user to check.
	#
	# Return:
	# 1 - User is an author for domain.
	# 0 - User is not an author for domain.
	sub is_author {
	my ($domain, $user) = @_;

	&Debug("is_author: $user @ $domain");

	my $hashref = &tie_user_hash($domain, $user, "roles",
	&GDBM_READER());

	# Author role should show up as a key /domain/_au

	my $key = "/$domain/_au";
	my $value = $hashref->{$key};

	if(defined($value)) {
	&Debug("$user @ $domain is an author");
	}

	return defined($value);
	}
#	#
# Checks to see if the input roleput request was to set	# Checks to see if the input roleput request was to set
# an author role. If so, invokes the lchtmldir script to set	# an author role. If so, invokes the lchtmldir script to set
Line 4867 sub make_new_child {	Line 4984 sub make_new_child {
sub manage_permissions	sub manage_permissions
{	{


my ($request, $domain, $user, $authtype) = @_;	my ($request, $domain, $user, $authtype) = @_;

	&Debug("manage_permissions: $request $domain $user $authtype");

# See if the request is of the form /$domain/_au	# See if the request is of the form /$domain/_au
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" ;
&logthis("system $execdir/lchtmldir $userhome $user $authtype");	&logthis("system $execdir/lchtmldir $userhome $user $authtype");
	&Debug("Setting homedir permissions for $userhome");
system("$execdir/lchtmldir $userhome $user $authtype");	system("$execdir/lchtmldir $userhome $user $authtype");
}	}
}	}
Line 4969 sub get_auth_type	Line 5090 sub get_auth_type
Debug("Password info = $realpassword\n");	Debug("Password info = $realpassword\n");
my ($authtype, $contentpwd) = split(/:/, $realpassword);	my ($authtype, $contentpwd) = split(/:/, $realpassword);
Debug("Authtype = $authtype, content = $contentpwd\n");	Debug("Authtype = $authtype, content = $contentpwd\n");
my $availinfo = '';	return "$authtype:$contentpwd";
if($authtype eq 'krb4' or $authtype eq 'krb5') {
$availinfo = $contentpwd;
}

return "$authtype:$availinfo";
} else {	} else {
Debug("Returning nouser");	Debug("Returning nouser");
return "nouser";	return "nouser";
Line 5323 sub make_passwd_file {	Line 5439 sub make_passwd_file {
if ($umode eq 'krb4' or $umode eq 'krb5') {	if ($umode eq 'krb4' or $umode eq 'krb5') {
{	{
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
print $pf "$umode:$npass\n";	if ($pf) {
	print $pf "$umode:$npass\n";
	} else {
	$result = "pass_file_failed_error";
	}
}	}
} elsif ($umode eq 'internal') {	} elsif ($umode eq 'internal') {
my $salt=time;	my $salt=time;
Line 5332 sub make_passwd_file {	Line 5452 sub make_passwd_file {
{	{
&Debug("Creating internal auth");	&Debug("Creating internal auth");
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
print $pf "internal:$ncpass\n";	if($pf) {
	print $pf "internal:$ncpass\n";
	} else {
	$result = "pass_file_failed_error";
	}
}	}
} elsif ($umode eq 'localauth') {	} elsif ($umode eq 'localauth') {
{	{
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
print $pf "localauth:$npass\n";	if($pf) {
	print $pf "localauth:$npass\n";
	} else {
	$result = "pass_file_failed_error";
	}
}	}
} elsif ($umode eq 'unix') {	} elsif ($umode eq 'unix') {
{	{
Line 5376 sub make_passwd_file {	Line 5504 sub make_passwd_file {
$result = "lcuseradd_failed:$error_text\n";	$result = "lcuseradd_failed:$error_text\n";
} else {	} else {
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
print $pf "unix:\n";	if($pf) {
	print $pf "unix:\n";
	} else {
	$result = "pass_file_failed_error";
	}
}	}
}	}
} elsif ($umode eq 'none') {	} elsif ($umode eq 'none') {
{	{
my $pf = IO::File->new("> $passfilename");	my $pf = IO::File->new("> $passfilename");
print $pf "none:\n";	if($pf) {
	print $pf "none:\n";
	} else {
	$result = "pass_file_failed_error";
	}
}	}
} else {	} else {
$result="auth_mode_error\n";	$result="auth_mode_error\n";

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

Removed from v.1.249
changed lines
	Added in v.1.261