loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.493 and 1.508

version 1.493, 2012/04/26 20:00:57	version 1.508, 2014/04/16 14:39:59
Line 130 my @passwderrors = ("ok",	Line 130 my @passwderrors = ("ok",
"pwchange_failure - lcpasswd Error filename is invalid");	"pwchange_failure - lcpasswd Error filename is invalid");


# The array below are lcuseradd error strings.:

my $lastadderror = 13;
my @adderrors = ("ok",
"User ID mismatch, lcuseradd must run as user www",
"lcuseradd Incorrect number of command line parameters must be 3",
"lcuseradd Incorrect number of stdinput lines, must be 3",
"lcuseradd Too many other simultaneous pwd changes in progress",
"lcuseradd User does not exist",
"lcuseradd Unable to make www member of users's group",
"lcuseradd Unable to su to root",
"lcuseradd Unable to set password",
"lcuseradd Username has invalid characters",
"lcuseradd Password has an invalid character",
"lcuseradd User already exists",
"lcuseradd Could not add user.",
"lcuseradd Password mismatch");


# This array are the errors from lcinstallfile:	# This array are the errors from lcinstallfile:

my @installerrors = ("ok",	my @installerrors = ("ok",
"Initial user id of client not that of www",	"Initial user id of client not that of www",
"Usage error, not enough command line arguments",	"Usage error, not enough command line arguments",
"Source file name does not exist",	"Source filename does not exist",
"Destination file name does not exist",	"Destination filename does not exist",
"Some file operation failed",	"Some file operation failed",
"Invalid table filename."	"Invalid table filename."
);	);
Line 1704 sub read_lonnet_global {	Line 1685 sub read_lonnet_global {
sub server_devalidatecache_handler {	sub server_devalidatecache_handler {
my ($cmd,$tail,$client) = @_;	my ($cmd,$tail,$client) = @_;
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";
my ($name,$id) = map { &unescape($_); } split(/:/,$tail);	my $items = &unescape($tail);
&Apache::lonnet::devalidate_cache_new($name,$id);	my @cached = split(/\&/,$items);
	foreach my $key (@cached) {
	if ($key =~ /:/) {
	my ($name,$id) = map { &unescape($_); } split(/:/,$key);
	&Apache::lonnet::devalidate_cache_new($name,$id);
	}
	}
my $result = 'ok';	my $result = 'ok';
&Reply($client,\$result,$userinput);	&Reply($client,\$result,$userinput);
return 1;	return 1;
Line 2131 sub change_authentication_handler {	Line 2118 sub change_authentication_handler {
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!!
# If just changing the unix passwd. need to arrange to run	# If just changing the unix passwd. need to arrange to run
# passwd since otherwise make_passwd_file will run	# passwd since otherwise make_passwd_file will fail as
# lcuseradd which fails if an account already exists	# creation of unix authenticated users is no longer supported
# (to prevent an unscrupulous LONCAPA admin from stealing	# except from the command line, when running make_domain_coordinator.pl
# an existing account by overwriting it as a LonCAPA account).

if(($oldauth =~/^unix/) && ($umode eq "unix")) {	if(($oldauth =~/^unix/) && ($umode eq "unix")) {
my $result = &change_unix_password($uname, $npass);	my $result = &change_unix_password($uname, $npass);
Line 2152 sub change_authentication_handler {	Line 2138 sub change_authentication_handler {
# re-run manage_permissions for that role in order to be able	# re-run manage_permissions for that role in order to be able
# to take ownership of the construction space back to www:www	# to take ownership of the construction space back to www:www
#	#


if( (($oldauth =~ /^unix/) && ($umode eq "internal")) \|\|
(($oldauth =~ /^internal/) && ($umode eq "unix")) ) {
if(&is_author($udom, $uname)) {
&Debug(" Need to manage author permissions...");
&manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
}
}
&Reply($client, \$result, $userinput);	&Reply($client, \$result, $userinput);
}	}

Line 2370 sub fetch_user_file_handler {	Line 2349 sub fetch_user_file_handler {
unlink($transname);	unlink($transname);
&Failure($client, "failed\n", $userinput);	&Failure($client, "failed\n", $userinput);
} else {	} else {
	if ($fname =~ /^default.+\.(page\|sequence)$/) {
	my ($major,$minor) = split(/\./,$clientversion);
	if (($major < 2) \|\| ($major == 2 && $minor < 11)) {
	my $now = time;
	&Apache::lonnet::do_cache_new('crschange',$udom.'_'.$uname,$now,600);
	my $key = &escape('internal.contentchange');
	my $what = "$key=$now";
	my $hashref = &tie_user_hash($udom,$uname,'environment',
	&GDBM_WRCREAT(),"P",$what);
	if ($hashref) {
	$hashref->{$key}=$now;
	if (!&untie_user_hash($hashref)) {
	&logthis("error: ".($!+0)." untie (GDBM) failed ".
	"when updating internal.contentchange");
	}
	}
	}
	}
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
}	}
}	}
Line 3176 sub get_profile_keys {	Line 3173 sub get_profile_keys {
sub dump_profile_database {	sub dump_profile_database {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;

	my $res = LONCAPA::Lond::dump_profile_database($tail);

	if ($res =~ /^error:/) {
	Failure($client, \$res, "$cmd:$tail");
	} else {
	Reply($client, \$res, "$cmd:$tail");
	}

	return 1;

	#TODO remove
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($udom,$uname,$namespace) = split(/:/,$tail);	my ($udom,$uname,$namespace) = split(/:/,$tail);
Line 3254 sub dump_profile_database {	Line 3262 sub dump_profile_database {
sub dump_with_regexp {	sub dump_with_regexp {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;

my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientname, $clientversion);	my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientversion);

if ($res =~ /^error:/) {	if ($res =~ /^error:/) {
Failure($client, \$res, "$cmd:$tail");	Failure($client, \$res, "$cmd:$tail");
Line 3829 sub put_course_id_hash_handler {	Line 3837 sub put_course_id_hash_handler {
# creationcontext - include courses created in specified context	# creationcontext - include courses created in specified context
#	#
# domcloner - flag to indicate if user can create CCs in course's domain.	# domcloner - flag to indicate if user can create CCs in course's domain.
# If so, ability to clone course is automatic.	# If so, ability to clone course is automatic.
	# hasuniquecode - filter by courses for which a six character unique code has
	# been set.
#	#
# $client - The socket open on the client.	# $client - The socket open on the client.
# Returns:	# Returns:
Line 3838 sub put_course_id_hash_handler {	Line 3848 sub put_course_id_hash_handler {
# a reply is written to $client.	# a reply is written to $client.
sub dump_course_id_handler {	sub dump_course_id_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;

	my $res = LONCAPA::Lond::dump_course_id_handler($tail);
	if ($res =~ /^error:/) {
	Failure($client, \$res, "$cmd:$tail");
	} else {
	Reply($client, \$res, "$cmd:$tail");
	}

	return 1;

	#TODO remove
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,	my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,	$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
$caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,	$caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
$creationcontext,$domcloner) =split(/:/,$tail);	$creationcontext,$domcloner,$hasuniquecode) =split(/:/,$tail);
my $now = time;	my $now = time;
my ($cloneruname,$clonerudom,%cc_clone);	my ($cloneruname,$clonerudom,%cc_clone);
if (defined($description)) {	if (defined($description)) {
Line 3916 sub dump_course_id_handler {	Line 3937 sub dump_course_id_handler {
} else {	} else {
$creationcontext = '.';	$creationcontext = '.';
}	}
	unless ($hasuniquecode) {
	$hasuniquecode = '.';
	}
my $unpack = 1;	my $unpack = 1;
if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' &&	if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' &&
$typefilter eq '.') {	$typefilter eq '.') {
Line 4004 sub dump_course_id_handler {	Line 4028 sub dump_course_id_handler {
$selfenroll_end = $items->{'selfenroll_end_date'};	$selfenroll_end = $items->{'selfenroll_end_date'};
$created = $items->{'created'};	$created = $items->{'created'};
$context = $items->{'context'};	$context = $items->{'context'};
	if ($hasuniquecode ne '.') {
	next unless ($items->{'uniquecode'});
	}
if ($selfenrollonly) {	if ($selfenrollonly) {
next if (!$selfenroll_types);	next if (!$selfenroll_types);
if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {	if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
Line 4426 sub get_id_handler {	Line 4453 sub get_id_handler {
}	}
&register_handler("idget", \&get_id_handler, 0, 1, 0);	&register_handler("idget", \&get_id_handler, 0, 1, 0);

	# Deletes one or more ids in a domain's id database.
	#
	# Parameters:
	# $cmd - Command keyword (iddel).
	# $tail - Command tail. In this case a colon
	# separated list containing:
	# The domain for which we are deleting the id(s).
	# &-separated list of id(s) to delete.
	# $client - File open on client socket.
	# Returns:
	# 1 - Continue processing
	# 0 - Exit server.
	#
	#

	sub del_id_handler {
	my ($cmd,$tail,$client) = @_;

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

	my ($udom,$what)=split(/:/,$tail);
	chomp($what);
	my $hashref = &tie_domain_hash($udom, "ids", &GDBM_WRCREAT(),
	"D", $what);
	if ($hashref) {
	my @keys=split(/\&/,$what);
	foreach my $key (@keys) {
	delete($hashref->{$key});
	}
	if (&untie_user_hash($hashref)) {
	&Reply($client, "ok\n", $userinput);
	} else {
	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
	"while attempting iddel\n", $userinput);
	}
	} else {
	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
	"while attempting iddel\n", $userinput);
	}
	return 1;
	}
	&register_handler("iddel", \&del_id_handler, 0, 1, 0);

#	#
# Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database	# Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database
#	#
Line 4974 sub validate_instcode_handler {	Line 5044 sub validate_instcode_handler {
my ($dom,$instcode,$owner) = split(/:/, $tail);	my ($dom,$instcode,$owner) = split(/:/, $tail);
$instcode = &unescape($instcode);	$instcode = &unescape($instcode);
$owner = &unescape($owner);	$owner = &unescape($owner);
my ($outcome,$description) =	my ($outcome,$description,$credits) =
&localenroll::validate_instcode($dom,$instcode,$owner);	&localenroll::validate_instcode($dom,$instcode,$owner);
my $result = &escape($outcome).'&'.&escape($description);	my $result = &escape($outcome).'&'.&escape($description).'&'.
	&escape($credits);
&Reply($client, \$result, $userinput);	&Reply($client, \$result, $userinput);

return 1;	return 1;
Line 5192 sub crsreq_checks_handler {	Line 5263 sub crsreq_checks_handler {
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";
my $dom = $tail;	my $dom = $tail;
my $result;	my $result;
my @reqtypes = ('official','unofficial','community');	my @reqtypes = ('official','unofficial','community','textbook');
eval {	eval {
local($SIG{__DIE__})='DEFAULT';	local($SIG{__DIE__})='DEFAULT';
my %validations;	my %validations;
Line 5219 sub crsreq_checks_handler {	Line 5290 sub crsreq_checks_handler {
sub validate_crsreq_handler {	sub validate_crsreq_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";
my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail);	my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$customdata) = split(/:/, $tail);
$instcode = &unescape($instcode);	$instcode = &unescape($instcode);
$owner = &unescape($owner);	$owner = &unescape($owner);
$crstype = &unescape($crstype);	$crstype = &unescape($crstype);
$inststatuslist = &unescape($inststatuslist);	$inststatuslist = &unescape($inststatuslist);
$instcode = &unescape($instcode);	$instcode = &unescape($instcode);
$instseclist = &unescape($instseclist);	$instseclist = &unescape($instseclist);
	my $custominfo = &Apache::lonnet::thaw_unescape($customdata);
my $outcome;	my $outcome;
eval {	eval {
local($SIG{__DIE__})='DEFAULT';	local($SIG{__DIE__})='DEFAULT';
$outcome = &localenroll::validate_crsreq($dom,$owner,$crstype,	$outcome = &localenroll::validate_crsreq($dom,$owner,$crstype,
$inststatuslist,$instcode,	$inststatuslist,$instcode,
$instseclist);	$instseclist,$custominfo);
};	};
if (!$@) {	if (!$@) {
&Reply($client, \$outcome, $userinput);	&Reply($client, \$outcome, $userinput);
Line 5242 sub validate_crsreq_handler {	Line 5314 sub validate_crsreq_handler {
}	}
&register_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0);	&register_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0);

	sub crsreq_update_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,$code,$infohashref) =
	split(/:/, $tail);
	$crstype = &unescape($crstype);
	$action = &unescape($action);
	$ownername = &unescape($ownername);
	$ownerdomain = &unescape($ownerdomain);
	$fullname = &unescape($fullname);
	$title = &unescape($title);
	$code = &unescape($code);
	my $incoming = &Apache::lonnet::thaw_unescape($infohashref);
	my ($result,$outcome);
	eval {
	local($SIG{__DIE__})='DEFAULT';
	my %rtnhash;
	$outcome = &localenroll::crsreq_updates($cdom,$cnum,$crstype,$action,
	$ownername,$ownerdomain,$fullname,
	$title,$code,$incoming,\%rtnhash);
	if ($outcome eq 'ok') {
	my @posskeys = qw(createdweb createdmsg queuedweb queuedmsg formitems reviewweb);
	foreach my $key (keys(%rtnhash)) {
	if (grep(/^\Q$key\E/,@posskeys)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&';
	}
	}
	$result =~ s/\&$//;
	}
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	&Reply($client, \$result, $userinput);
	} else {
	&Reply($client, "format_error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	return 1;
	}
	&register_handler("autocrsrequpdate", \&crsreq_update_handler, 0, 1, 0);

#	#
# Read and retrieve institutional code format (for support form).	# Read and retrieve institutional code format (for support form).
# Formal Parameters:	# Formal Parameters:
Line 5949 sub lcpasswdstrerror {	Line 6064 sub lcpasswdstrerror {
}	}
}	}

#
# Convert an error return code from lcuseradd to a string value:
#
sub lcuseraddstrerror {
my $ErrorCode = shift;
if(($ErrorCode < 0) \|\| ($ErrorCode > $lastadderror)) {
return "lcuseradd - Unrecognized error code: ".$ErrorCode;
} else {
return $adderrors[$ErrorCode];
}
}

# grabs exception and records it to log before exiting	# grabs exception and records it to log before exiting
sub catchexception {	sub catchexception {
my ($error)=@_;	my ($error)=@_;
Line 6450 sub make_new_child {	Line 6553 sub make_new_child {
#---------------------------------------------------- kerberos 5 initialization	#---------------------------------------------------- kerberos 5 initialization
&Authen::Krb5::init_context();	&Authen::Krb5::init_context();
unless (($dist eq 'fedora5') \|\| ($dist eq 'fedora4') \|\|	unless (($dist eq 'fedora5') \|\| ($dist eq 'fedora4') \|\|
($dist eq 'fedora6') \|\| ($dist eq 'suse9.3')) {	($dist eq 'fedora6') \|\| ($dist eq 'suse9.3') \|\|
	($dist eq 'suse12.2') \|\| ($dist eq 'suse12.3') \|\|
	($dist eq 'suse13.1')) {
&Authen::Krb5::init_ets();	&Authen::Krb5::init_ets();
}	}

Line 6495 sub make_new_child {	Line 6600 sub make_new_child {
#	#
# If the remote is attempting a local init... give that a try:	# If the remote is attempting a local init... give that a try:
#	#
	logthis("remotereq: $remotereq");
(my $i, my $inittype, $clientversion) = split(/:/, $remotereq);	(my $i, my $inittype, $clientversion) = split(/:/, $remotereq);
# For LON-CAPA 2.9, the client session will have sent its LON-CAPA	# For LON-CAPA 2.9, the client session will have sent its LON-CAPA
# version when initiating the connection. For LON-CAPA 2.8 and older,	# version when initiating the connection. For LON-CAPA 2.8 and older,
# the version is retrieved from the global %loncaparevs in lonnet.pm.	# the version is retrieved from the global %loncaparevs in lonnet.pm.
	# $clientversion contains path to keyfile if $inittype eq 'local'
	# it's overridden below in this case
$clientversion \|\|= $Apache::lonnet::loncaparevs{$clientname};	$clientversion \|\|= $Apache::lonnet::loncaparevs{$clientname};

# If the connection type is ssl, but I didn't get my	# If the connection type is ssl, but I didn't get my
Line 7250 sub make_passwd_file {	Line 7358 sub make_passwd_file {
}	}
}	}
} elsif ($umode eq 'unix') {	} elsif ($umode eq 'unix') {
{	&logthis(">>>Attempt to create unix account blocked -- unix auth not available for new users.");
#	$result="no_new_unix_accounts";
# Don't allow the creation of privileged accounts!!! that would
# be real bad!!!
#
my $uid = getpwnam($uname);
if((defined $uid) && ($uid == 0)) {
&logthis(">>>Attempt to create privileged account blocked");
return "no_priv_account_error\n";
}

my $execpath ="$perlvar{'lonDaemons'}/"."lcuseradd";

my $lc_error_file = $execdir."/tmp/lcuseradd".$$.".status";
{
&Debug("Executing external: ".$execpath);
&Debug("user = ".$uname.", Password =". $npass);
my $se = IO::File->new("\|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
print $se "$uname\n";
print $se "$udom\n";
print $se "$npass\n";
print $se "$npass\n";
print $se "$lc_error_file\n"; # Status -> unique file.
}
if (-r $lc_error_file) {
&Debug("Opening error file: $lc_error_file");
my $error = IO::File->new("< $lc_error_file");
my $useraddok = <$error>;
$error->close;
unlink($lc_error_file);

chomp $useraddok;

if($useraddok > 0) {
my $error_text = &lcuseraddstrerror($useraddok);
&logthis("Failed lcuseradd: $error_text");
$result = "lcuseradd_failed:$error_text";
} else {
my $pf = IO::File->new(">$passfilename");
if($pf) {
print $pf "unix:\n";
} else {
$result = "pass_file_failed_error";
}
}
} else {
&Debug("Could not locate lcuseradd error: $lc_error_file");
$result="bug_lcuseradd_no_output_file";
}
}
} elsif ($umode eq 'none') {	} elsif ($umode eq 'none') {
{	{
my $pf = IO::File->new("> $passfilename");	my $pf = IO::File->new("> $passfilename");
Line 7577 Place in B<logs/lond.log>	Line 7637 Place in B<logs/lond.log>

stores hash in namespace	stores hash in namespace

=item rolesputy	=item rolesput

put a role into a user's environment	put a role into a user's environment

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

Removed from v.1.493
changed lines
	Added in v.1.508