loncom/interface/loncreateuser.pm - diff

Return to loncreateuser.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncreateuser.pm between versions 1.39.6.1 and 1.77

version 1.39.6.1, 2002/09/05 16:44:22	version 1.77, 2004/01/17 18:12:05
Line 25	Line 25
#	#
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
# (Create a course
# (My Desk
#
# (Internal Server Error Handler
#
# (Login Screen
# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
#
# YEAR=2001
# 3/1/1 Gerd Kortemeyer)
#
# 3/1 Gerd Kortemeyer)
#
# 2/14 Gerd Kortemeyer)
#
# 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer
# April Guy Albertelli
# 05/10,10/16 Gerd Kortemeyer
# 11/12,11/13,11/15 Scott Harrison
# 02/11/02 Matthew Hall
#
# $Id$
###	###

package Apache::loncreateuser;	package Apache::loncreateuser;

	=pod

	=head1 NAME

	Apache::loncreateuser - handler to create users and custom roles

	=head1 SYNOPSIS

	Apache::loncreateuser provides an Apache handler for creating users,
	editing their login parameters, roles, and removing roles, and
	also creating and assigning custom roles.

	=head1 OVERVIEW

	=head2 Custom Roles

	In LON-CAPA, roles are actually collections of privileges. "Teaching
	Assistant", "Course Coordinator", and other such roles are really just
	collection of privileges that are useful in many circumstances.

	Creating custom roles can be done by the Domain Coordinator through
	the Create User functionality. That screen will show all privileges
	that can be assigned to users. For a complete list of privileges,
	please see C</home/httpd/lonTabs/rolesplain.tab>.

	Custom role definitions are stored in the C<roles.db> file of the role
	author.

	=cut

use strict;	use strict;
use Apache::Constants qw(:common :http);	use Apache::Constants qw(:common :http);
use Apache::lonnet;	use Apache::lonnet;
	use Apache::loncommon;
	use Apache::lonlocal;

my $loginscript; # piece of javascript used in two separate instances	my $loginscript; # piece of javascript used in two separate instances
my $generalrule;	my $generalrule;
Line 71 BEGIN {	Line 80 BEGIN {
my %param = ( formname => 'document.cu',	my %param = ( formname => 'document.cu',
kerb_def_dom => $krbdefdom	kerb_def_dom => $krbdefdom
);	);
$loginscript = &Apache::loncommon::authform_header(%param);	# no longer static due to configurable kerberos defaults
	# $loginscript = &Apache::loncommon::authform_header(%param);
$generalrule = &Apache::loncommon::authform_authorwarning(%param);	$generalrule = &Apache::loncommon::authform_authorwarning(%param);
$authformnop = &Apache::loncommon::authform_nochange(%param);	$authformnop = &Apache::loncommon::authform_nochange(%param);
$authformkrb = &Apache::loncommon::authform_kerberos(%param);	# no longer static due to configurable kerberos defaults
	# $authformkrb = &Apache::loncommon::authform_kerberos(%param);
$authformint = &Apache::loncommon::authform_internal(%param);	$authformint = &Apache::loncommon::authform_internal(%param);
$authformfsys = &Apache::loncommon::authform_filesystem(%param);	$authformfsys = &Apache::loncommon::authform_filesystem(%param);
$authformloc = &Apache::loncommon::authform_local(%param);	$authformloc = &Apache::loncommon::authform_local(%param);
}	}


	# ======================================================= Existing Custom Roles

	sub my_custom_roles {
	my %returnhash=();
	my %rolehash=&Apache::lonnet::dump('roles');
	foreach (keys %rolehash) {
	if ($_=~/^rolesdef\_(\w+)$/) {
	$returnhash{$1}=$1;
	}
	}
	return %returnhash;
	}

	# ==================================================== Figure out author access

	sub authorpriv {
	my ($auname,$audom)=@_;
	if (($auname ne $ENV{'user.name'}) \|\|
	(($audom ne $ENV{'user.domain'}) &&
	($audom ne $ENV{'request.role.domain'}))) { return ''; }
	unless (&Apache::lonnet::allowed('cca',$audom)) { return ''; }
	return 1;
	}

# =================================================================== Phase one	# =================================================================== Phase one

sub print_username_entry_form {	sub print_username_entry_form {
Line 87 sub print_username_entry_form {	Line 123 sub print_username_entry_form {
my $defdom=$ENV{'request.role.domain'};	my $defdom=$ENV{'request.role.domain'};
my @domains = &Apache::loncommon::get_domains();	my @domains = &Apache::loncommon::get_domains();
my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');	my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
	my $bodytag =&Apache::loncommon::bodytag(
	'Create Users, Change User Privileges').
	&Apache::loncommon::help_open_faq(282).
	&Apache::loncommon::help_open_bug('Instructor Interface');
	my $selscript=&Apache::loncommon::studentbrowser_javascript();
	my $sellink=&Apache::loncommon::selectstudent_link
	('crtuser','ccuname','ccdomain');
	my %existingroles=&my_custom_roles();
	my $choice=&Apache::loncommon::select_form('make new role','rolename',
	('make new role' => 'Generate new role ...',%existingroles));
	my %lt=&Apache::lonlocal::texthash(
	'siur' => "Set Individual User Roles",
	'usr' => "Username",
	'dom' => "Domain",
	'usrr' => "User Roles",
	'ecrp' => "Edit Custom Role Privileges",
	'nr' => "Name of Role",
	'cre' => "Custom Role Editor"
	);
	my $helpsiur=&Apache::loncommon::help_open_topic('Course_Change_Privileges');
	my $helpecpr=&Apache::loncommon::help_open_topic('Course_Editing_Custom_Roles');
$r->print(<<"ENDDOCUMENT");	$r->print(<<"ENDDOCUMENT");
<html>	<html>
<head>	<head>
<title>The LearningOnline Network with CAPA</title>	<title>The LearningOnline Network with CAPA</title>
	$selscript
</head>	</head>
<body bgcolor="#FFFFFF">	$bodytag
<h1>Create User, Change User Privileges</h1>	<form action="/adm/createuser" method="post" name="crtuser">
<form action="/adm/createuser" method="post">
<input type="hidden" name="phase" value="get_user_info">	<input type="hidden" name="phase" value="get_user_info">
<p>	<h2>$lt{siur}$helpsiur</h2>
Username: <input type="text" size="15" name="ccuname"><br>	<table>
Domain: $domform	<tr><td>$lt{usr}:</td><td><input type="text" size="15" name="ccuname">
</p>	</td><td rowspan="2">$sellink</td></tr><tr><td>
<input type="submit" value="Continue">	$lt{'dom'}:</td><td>$domform</td></tr>
	</table>
	<input name="userrole" type="submit" value="$lt{usrr}" />
</form>	</form>
	<form action="/adm/createuser" method="post" name="docustom">
	<input type="hidden" name="phase" value="selected_custom_edit">
	<h2>$lt{'ecrp'}$helpecpr</h2>
	$lt{'nr'}: $choice <input type="text" size="15" name="newrolename" /><br />
	<input name="customeditor" type="submit" value="$lt{'cre'}" />
</body>	</body>
</html>	</html>
ENDDOCUMENT	ENDDOCUMENT
Line 113 sub print_user_modification_page {	Line 177 sub print_user_modification_page {
my $ccuname=$ENV{'form.ccuname'};	my $ccuname=$ENV{'form.ccuname'};
my $ccdomain=$ENV{'form.ccdomain'};	my $ccdomain=$ENV{'form.ccdomain'};

$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;	$ccuname=~s/\W//gs;
my $krbdefdom=$1;	$ccdomain=~s/\W//gs;
$krbdefdom=~tr/a-z/A-Z/;
	unless (($ccuname) && ($ccdomain)) {
	&print_username_entry_form($r);
	return;
	}

	my $defdom=$ENV{'request.role.domain'};

	my ($krbdef,$krbdefdom) =
	&Apache::loncommon::get_kerberos_defaults($defdom);

my %param = ( formname => 'document.cu',	my %param = ( formname => 'document.cu',
kerb_def_dom => $krbdefdom	kerb_def_dom => $krbdefdom,
	kerb_def_auth => $krbdef
);	);
$loginscript = &Apache::loncommon::authform_header(%param);	$loginscript = &Apache::loncommon::authform_header(%param);
	$authformkrb = &Apache::loncommon::authform_kerberos(%param);
my $defdom=$ENV{'request.role.domain'};

$ccuname=~s/\W//g;	$ccuname=~s/\W//g;
$ccdomain=~s/\W//g;	$ccdomain=~s/\W//g;
	my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
my $dochead =<<"ENDDOCHEAD";	my $dochead =<<"ENDDOCHEAD";
<html>	<html>
<head>	<head>
Line 137 sub print_user_modification_page {	Line 212 sub print_user_modification_page {
parmwin.close();	parmwin.close();
}	}

function pjump(type,dis,value,marker,ret,call) {	$pjump_def
parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
+"&value="+escape(value)+"&marker="+escape(marker)
+"&return="+escape(ret)
+"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
"height=350,width=350,scrollbars=no,menubar=no");

}

function dateset() {	function dateset() {
eval("document.cu."+document.cu.pres_marker.value+	eval("document.cu."+document.cu.pres_marker.value+
Line 154 sub print_user_modification_page {	Line 222 sub print_user_modification_page {

</script>	</script>
</head>	</head>
<body bgcolor="#FFFFFF">
<img align="right" src="/adm/lonIcons/lonlogos.gif">
ENDDOCHEAD	ENDDOCHEAD
	$r->print(&Apache::loncommon::bodytag(
	'Create Users, Change User Privileges'));
my $forminfo =<<"ENDFORMINFO";	my $forminfo =<<"ENDFORMINFO";
<form action="/adm/createuser" method="post" name="cu">	<form action="/adm/createuser" method="post" name="cu">
<input type="hidden" name="phase" value="update_user_data">	<input type="hidden" name="phase" value="update_user_data">
Line 169 ENDFORMINFO	Line 237 ENDFORMINFO
my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);	my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
my %incdomains;	my %incdomains;
my %inccourses;	my %inccourses;
foreach (%Apache::lonnet::hostdom) {	foreach (values(%Apache::lonnet::hostdom)) {
$incdomains{$_}=1;	$incdomains{$_}=1;
}	}
foreach (keys(%ENV)) {	foreach (keys(%ENV)) {
Line 182 ENDFORMINFO	Line 250 ENDFORMINFO
'<option value="default" selected>default</option>'."\n".	'<option value="default" selected>default</option>'."\n".
&Apache::loncommon::home_server_option_list($ccdomain);	&Apache::loncommon::home_server_option_list($ccdomain);

	my %lt=&Apache::lonlocal::texthash(
	'cnu' => "Create New User",
	'nu' => "New User",
	'id' => "in domain",
	'pd' => "Personal Data",
	'fn' => "First Name",
	'mn' => "Middle Name",
	'ln' => "Last Name",
	'gen' => "Generation",
	'idsn' => "ID/Student Number",
	'hs' => "Home Server",
	'lg' => "Login Data"
	);
$r->print(<<ENDNEWUSER);	$r->print(<<ENDNEWUSER);
$dochead	$dochead
<h1>Create New User</h1>	<h1>$lt{'cnu'}</h1>
$forminfo	$forminfo
<h2>New user "$ccuname" in domain $ccdomain</h2>	<h2>$lt{'nu'} "$ccuname" $lt{'id'} $ccdomain</h2>
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
</script>	</script>
<input type='hidden' name='makeuser' value='1' />	<input type='hidden' name='makeuser' value='1' />
<h3>Personal Data</h3>	<h3>$lt{'pd'}</h3>
<p>	<p>
<table>	<table>
<tr><td>First Name </td>	<tr><td>$lt{'fn'} </td>
<td><input type='text' name='cfirst' size='15' /></td></tr>	<td><input type='text' name='cfirst' size='15' /></td></tr>
<tr><td>Middle Name </td>	<tr><td>$lt{'mn'} </td>
<td><input type='text' name='cmiddle' size='15' /></td></tr>	<td><input type='text' name='cmiddle' size='15' /></td></tr>
<tr><td>Last Name </td>	<tr><td>$lt{'ln'} </td>
<td><input type='text' name='clast' size='15' /></td></tr>	<td><input type='text' name='clast' size='15' /></td></tr>
<tr><td>Generation </td>	<tr><td>$lt{'gen'} </td>
<td><input type='text' name='cgen' size='5' /></td></tr>	<td><input type='text' name='cgen' size='5' /></td></tr>
</table>	</table>
ID/Student Number <input type='text' name='cstid' size='15' /></p>	$lt{'idsn'} <input type='text' name='cstid' size='15' /></p>
Home Server: <select name="hserver" size="1"> $home_server_list </select>	$lt{'hs'}: <select name="hserver" size="1"> $home_server_list </select>
<hr />	<hr />
<h3>Login Data</h3>	<h3>$lt{'lg'}</h3>
<p>$generalrule </p>	<p>$generalrule </p>
<p>$authformkrb </p>	<p>$authformkrb </p>
<p>$authformint </p>	<p>$authformint </p>
Line 214 Home Server: <select name="hserver" size	Line 295 Home Server: <select name="hserver" size
<p>$authformloc </p>	<p>$authformloc </p>
ENDNEWUSER	ENDNEWUSER
} else { # user already exists	} else { # user already exists
	my %lt=&Apache::lonlocal::texthash(
	'cup' => "Change User Privileges",
	'usr' => "User",
	'id' => "in domain",
	'fn' => "first name",
	'mn' => "middle name",
	'ln' => "last name",
	'gen' => "generation"
	);
$r->print(<<ENDCHANGEUSER);	$r->print(<<ENDCHANGEUSER);
$dochead	$dochead
<h1>Change User Privileges</h1>	<h1>$lt{'cup'}</h1>
$forminfo	$forminfo
<h2>User "$ccuname" in domain $ccdomain </h2>	<h2>$lt{'usr'} "$ccuname" $lt{'id'} "$ccdomain"</h2>
ENDCHANGEUSER	ENDCHANGEUSER
# Get the users information	# Get the users information
my %userenv = &Apache::lonnet::get('environment',	my %userenv = &Apache::lonnet::get('environment',
Line 229 ENDCHANGEUSER	Line 319 ENDCHANGEUSER
<hr />	<hr />
<table border="2">	<table border="2">
<tr>	<tr>
<th>first name</th><th>middle name</th><th>last name</th><th>generation</th>	<th>$lt{'fn'}</th><th>$lt{'mn'}</th><th>$lt{'ln'}</th><th>$lt{'gen'}</th>
</tr>	</tr>
<tr>	<tr>
END	END
foreach ('firstname','middlename','lastname','generation') {	foreach ('firstname','middlename','lastname','generation') {
if (&Apache::lonnet::allowed('mau',$ccdomain)) {	if (&Apache::lonnet::allowed('mau',$ccdomain)) {
$r->print(<<"END");	$r->print(<<"END");
<td><input type="text" name="c$_" value="$userenv{$_}" size="15"/></td>	<td><input type="text" name="c$_" value="$userenv{$_}" size="15" /></td>
END	END
} else {	} else {
$r->print('<td>'.$userenv{$_}.'</td>');	$r->print('<td>'.$userenv{$_}.'</td>');
}	}
}	}
$r->print(<<END);	$r->print(<<END);
</tr>	</tr>
</table>	</table>
END	END
Line 250 END	Line 340 END
my ($tmp) = keys(%rolesdump);	my ($tmp) = keys(%rolesdump);
unless ($tmp =~ /^(con_lost\|error)/i) {	unless ($tmp =~ /^(con_lost\|error)/i) {
my $now=time;	my $now=time;
	my %lt=&Apache::lonlocal::texthash(
	'rer' => "Revoke Existing Roles",
	'rev' => "Revoke",
	'del' => "Delete",
	'rol' => "Role",
	'ext' => "Extent",
	'sta' => "Start",
	'end' => "End"
	);
$r->print(<<END);	$r->print(<<END);
<hr />	<hr />
<h3>Revoke Existing Roles</h3>	<h3>$lt{'rer'}</h3>
<table border=2>	<table border=2>
<tr><th>Revoke</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>	<tr><th>$lt{'rev'}</th><th>$lt{'del'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th>
END	END
foreach my $area (keys(%rolesdump)) {	foreach my $area (sort { my $a1=join('_',(split('_',$a))[1,0]);
	my $b1=join('_',(split('_',$b))[1,0]);
	return $a1 cmp $b1;
	} keys(%rolesdump)) {
next if ($area =~ /^rolesdef/);	next if ($area =~ /^rolesdef/);
my $role = $rolesdump{$area};	my $role = $rolesdump{$area};
my $thisrole=$area;	my $thisrole=$area;
$area =~ s/\_\w\w$//;	$area =~ s/\_\w\w$//;
my ($role_code,$role_end_time,$role_start_time) =	my ($role_code,$role_end_time,$role_start_time) =
split(/_/,$role);	split(/_/,$role);
	# Is this a custom role? Get role owner and title.
	my ($croleudom,$croleuname,$croletitle)=
	($role_code=~/^cr\/(\w+)\/(\w+)\/(\w+)$/);
my $bgcol='ffffff';	my $bgcol='ffffff';
my $allowed=0;	my $allowed=0;
	my $delallowed=0;
if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {	if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
	my ($coursedom,$coursedir) = ($1,$2);
	# $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
my %coursedata=	my %coursedata=
&Apache::lonnet::coursedescription($1.'_'.$2);	&Apache::lonnet::coursedescription($1.'_'.$2);
my $carea='Course: '.$coursedata{'description'};	my $carea;
	if (defined($coursedata{'description'})) {
	$carea=&mt('Course').': '.$coursedata{'description'}.
	'<br />'.&mt('Domain').': '.$coursedom.(' 'x8).
	&Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
	} else {
	$carea=&mt('Unavailable course').': '.$area;
	}
$inccourses{$1.'_'.$2}=1;	$inccourses{$1.'_'.$2}=1;
if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {	if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) \|\|
	(&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
$allowed=1;	$allowed=1;
}	}
	if ((&Apache::lonnet::allowed('dro',$1)) \|\|
	(&Apache::lonnet::allowed('dro',$ccdomain))) {
	$delallowed=1;
	}
	# - custom role. Needs more info, too
	if ($croletitle) {
	if (&Apache::lonnet::allowed('ccr',$1.'/'.$2)) {
	$allowed=1;
	$thisrole.='.'.$role_code;
	}
	}
# Compute the background color based on $area	# Compute the background color based on $area
$bgcol=$1.'_'.$2;	$bgcol=$1.'_'.$2;
$bgcol=~s/[^8-9b-e]//g;	$bgcol=~s/[^7-9a-e]//g;
$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {	if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
$carea.='<br>Section/Group: '.$3;	$carea.='<br>Section/Group: '.$3;
}	}
Line 284 END	Line 411 END
} else {	} else {
# Determine if current user is able to revoke privileges	# Determine if current user is able to revoke privileges
if ($area=~ /^\/(\w+)\//) {	if ($area=~ /^\/(\w+)\//) {
if (&Apache::lonnet::allowed('c'.$role_code,$1)) {	if ((&Apache::lonnet::allowed('c'.$role_code,$1)) \|\|
	(&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
$allowed=1;	$allowed=1;
}	}
	if (((&Apache::lonnet::allowed('dro',$1)) \|\|
	(&Apache::lonnet::allowed('dro',$ccdomain))) &&
	($role_code ne 'dc')) {
	$delallowed=1;
	}
} else {	} else {
if (&Apache::lonnet::allowed('c'.$role_code,'/')) {	if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
$allowed=1;	$allowed=1;
}	}
}	}
}	}
# I have no idea what the hell the above code does	if ($role_code eq 'ca') {
# So the following is a check:	$area=~/\/(\w+)\/(\w+)/;
if ($allowed) {	if (&authorpriv($2,$1)) {
# If we are looking at a co-author role, make sure it is	$allowed=1;
# for the current users construction space before we let	} else {
# them revoke it.	$allowed=0;
if (($role_code eq 'ca') &&
($ENV{'request.role'} !~ /^dc/)) {
if ($area !~
/^\/$ENV{'request.role.domain'}\/$ENV{'user.name'}/) {
$allowed = 0;
}
}	}
}	}
my $row = '';	my $row = '';
$row.='<tr bgcolor=#"'.$bgcol.'"><td>';	$row.='<tr bgcolor="#'.$bgcol.'"><td>';
my $active=1;	my $active=1;
$active=0 if (($role_end_time) && ($now>$role_end_time));	$active=0 if (($role_end_time) && ($now>$role_end_time));
if (($active) && ($allowed)) {	if (($active) && ($allowed)) {
$row.= '<input type="checkbox" name="rev:'.$thisrole.'">';	$row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
} else {	} else {
	if ($active) {
	$row.=' ';
	} else {
	$row.=&mt('expired or revoked');
	}
	}
	$row.='</td><td>';
	if ($delallowed) {
	$row.= '<input type="checkbox" name="del:'.$thisrole.'">';
	} else {
$row.=' ';	$row.=' ';
}	}
$row.= '</td><td>'.&Apache::lonnet::plaintext($role_code).	my $plaintext='';
	unless ($croletitle) {
	$plaintext=&Apache::lonnet::plaintext($role_code);
	} else {
	$plaintext=
	"Customrole '$croletitle' defined by $croleuname\@$croleudom";
	}
	$row.= '</td><td>'.$plaintext.
'</td><td>'.$area.	'</td><td>'.$area.
'</td><td>'.($role_start_time?localtime($role_start_time)	'</td><td>'.($role_start_time?localtime($role_start_time)
: ' ' ).	: ' ' ).
Line 330 END	Line 474 END
my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
if ($currentauth=~/^krb(4\|5):/) {	if ($currentauth=~/^krb(4\|5):/) {
$currentauth=~/^krb(4\|5):(.*)/;	$currentauth=~/^krb(4\|5):(.*)/;
my $krbdefdom2=$1;	my $krbdefdom=$1;
my %param = ( formname => 'document.cu',	my %param = ( formname => 'document.cu',
kerb_def_dom => $krbdefdom	kerb_def_dom => $krbdefdom
);	);
Line 343 END	Line 487 END
$currentauth=~/^localauth:/	$currentauth=~/^localauth:/
) { # bad authentication scheme	) { # bad authentication scheme
if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {	if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
	my %lt=&Apache::lonlocal::texthash(
	'err' => "ERROR",
	'uuas' => "This user has an unrecognized authentication scheme",
	'sldb' => "Please specify login data below",
	'ld' => "Login Data"
	);
$r->print(<<ENDBADAUTH);	$r->print(<<ENDBADAUTH);
<hr />	<hr />
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
</script>	</script>
<font color='#ff0000'>ERROR:</font>	<font color='#ff0000'>$lt{'err'}:</font>
This user has an unrecognized authentication scheme ($currentauth).	$lt{'uuas'} ($currentauth). $lt{'sldb'}.
Please specify login data below.	<h3>$lt{'ld'}</h3>
<h3>Login Data</h3>
<p>$generalrule</p>	<p>$generalrule</p>
<p>$authformkrb</p>	<p>$authformkrb</p>
<p>$authformint</p>	<p>$authformint</p>
Line 361 ENDBADAUTH	Line 510 ENDBADAUTH
} else {	} else {
# This user is not allowed to modify the users	# This user is not allowed to modify the users
# authentication scheme, so just notify them of the problem	# authentication scheme, so just notify them of the problem
	my %lt=&Apache::lonlocal::texthash(
	'err' => "ERROR",
	'uuas' => "This user has an unrecognized authentication scheme",
	'adcs' => "Please alert a domain coordinator of this situation"
	);
$r->print(<<ENDBADAUTH);	$r->print(<<ENDBADAUTH);
<hr />	<hr />
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
</script>	</script>
<font color="#ff0000"> ERROR: </font>	<font color="#ff0000"> $lt{'err'}: </font>
This user has an unrecognized authentication scheme ($currentauth).	$lt{'uuas'} ($currentauth). $lt{'adcs'}.
Please alert a domain coordinator of this situation.
<hr />	<hr />
ENDBADAUTH	ENDBADAUTH
}	}
Line 395 ENDBADAUTH	Line 548 ENDBADAUTH
$authform_other="<p>$authformkrb</p>".	$authform_other="<p>$authformkrb</p>".
"<p>$authformint</p><p>$authformfsys</p>";	"<p>$authformint</p><p>$authformfsys</p>";
}	}
$authformcurrent=<<ENDCURRENTAUTH;	$authformcurrent.=' <i>(will override current values)</i><br />';
<table border='1'>
<tr>
<td><font color='#ff0000'>* * * WARNING * * *</font></td>
<td><font color='#ff0000'>* * * WARNING * * *</font></td>
</tr>
<tr><td bgcolor='#cbbcbb'>$authformcurrent</td>
<td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
</table>
ENDCURRENTAUTH
if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {	if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
# Current user has login modification privileges	# Current user has login modification privileges
	my %lt=&Apache::lonlocal::texthash(
	'ccld' => "Change Current Login Data",
	'enld' => "Enter New Login Data"
	);
$r->print(<<ENDOTHERAUTHS);	$r->print(<<ENDOTHERAUTHS);
<hr />	<hr />
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
</script>	</script>
<h3>Change Current Login Data</h3>	<h3>$lt{'ccld'}</h3>
<p>$generalrule</p>	<p>$generalrule</p>
<p>$authformnop</p>	<p>$authformnop</p>
<p>$authformcurrent</p>	<p>$authformcurrent</p>
<h3>Enter New Login Data</h3>	<h3>$lt{'enld'}</h3>
$authform_other	$authform_other
ENDOTHERAUTHS	ENDOTHERAUTHS
}	}
} ## End of "check for bad authentication type" logic	} ## End of "check for bad authentication type" logic
} ## End of new user/old user logic	} ## End of new user/old user logic
$r->print('<hr /><h3>Add Roles</h3>');	$r->print('<hr /><h3>'.&mt('Add Roles').'</h3>');
#	#
# Co-Author	# Co-Author
#	#
if (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) {	if (&authorpriv($ENV{'user.name'},$ENV{'request.role.domain'}) &&
	($ENV{'user.name'} ne $ccuname \|\| $ENV{'user.domain'} ne $ccdomain)) {
	# No sense in assigning co-author role to yourself
my $cuname=$ENV{'user.name'};	my $cuname=$ENV{'user.name'};
my $cudom=$ENV{'request.role.domain'};	my $cudom=$ENV{'request.role.domain'};
	my %lt=&Apache::lonlocal::texthash(
	'cs' => "Construction Space",
	'act' => "Activate",
	'rol' => "Role",
	'ext' => "Extent",
	'sta' => "Start",
	'end' => "End".
	'cau' => "Co-Author",
	'ssd' => "Set Start Date",
	'sed' => "Set End Date"
	);
$r->print(<<ENDCOAUTH);	$r->print(<<ENDCOAUTH);
<h4>Construction Space</h4>	<h4>$lt{'cs'}</h4>
<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>	<table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
<th>Start</th><th>End</th></tr>	<th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
<tr>	<tr>
<td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>	<td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
<td>Co-Author</td>	<td>$lt{'cau'}</td>
<td>$cudom\_$cuname</td>	<td>$cudom\_$cuname</td>
<td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>	<td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
<a href=	<a href=
"javascript:pjump('date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset')">Set Start Date</a></td>	"javascript:pjump('date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset')">$lt{'ssd'}</a></td>
<td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>	<td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
<a href=	<a href=
"javascript:pjump('date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset')">Set End Date</a></td>	"javascript:pjump('date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset')">$lt{'sed'}</a></td>
</tr>	</tr>
</table>	</table>
ENDCOAUTH	ENDCOAUTH
Line 450 ENDCOAUTH	Line 611 ENDCOAUTH
#	#
# Domain level	# Domain level
#	#
$r->print('<h4>Domain Level</h4>'.	$r->print('<h4>'.&mt('Domain Level').'</h4>'.
'<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.	'<table border=2><tr><th>'.&mt('Activate').'</th><th>'.&mt('Role').'</th><th>'.&mt('Extent').'</th>'.
'<th>Start</th><th>End</th></tr>');	'<th>'.&mt('Start').'</th><th>'.&mt('End').'</th></tr>');
foreach ( sort( keys(%incdomains))) {	foreach ( sort( keys(%incdomains))) {
my $thisdomain=$_;	my $thisdomain=$_;
foreach ('dc','li','dg','au') {	foreach ('dc','li','dg','au','sc') {
if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {	if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
my $plrole=&Apache::lonnet::plaintext($_);	my $plrole=&Apache::lonnet::plaintext($_);
	my %lt=&Apache::lonlocal::texthash(
	'ssd' => "Set Start Date",
	'sed' => "Set End Date"
	);
$r->print(<<ENDDROW);	$r->print(<<ENDDROW);
<tr>	<tr>
<td><input type=checkbox name="act_$thisdomain\_$_"></td>	<td><input type=checkbox name="act_$thisdomain\_$_"></td>
Line 465 ENDCOAUTH	Line 630 ENDCOAUTH
<td>$thisdomain</td>	<td>$thisdomain</td>
<td><input type=hidden name="start_$thisdomain\_$_" value=''>	<td><input type=hidden name="start_$thisdomain\_$_" value=''>
<a href=	<a href=
"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>	"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
<td><input type=hidden name="end_$thisdomain\_$_" value=''>	<td><input type=hidden name="end_$thisdomain\_$_" value=''>
<a href=	<a href=
"javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>	"javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
</tr>	</tr>
ENDDROW	ENDDROW
}	}
Line 479 ENDDROW	Line 644 ENDDROW
# Course level	# Course level
#	#
$r->print(&course_level_table(%inccourses));	$r->print(&course_level_table(%inccourses));
$r->print("<hr /><input type=submit value=\"Modify User\">\n");	$r->print("<hr /><input type=submit value=\"".&mt('Modify User')."\">\n");
$r->print("</form></body></html>");	$r->print("</form></body></html>");
}	}

Line 489 sub update_user_data {	Line 654 sub update_user_data {
my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},	my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
$ENV{'form.ccdomain'});	$ENV{'form.ccdomain'});
# Error messages	# Error messages
my $error = '<font color="#ff0000">Error:</font>';	my $error = '<font color="#ff0000">'.&mt('Error').':</font>';
my $end = '</body></html>';	my $end = '</body></html>';
# Print header	# Print header
$r->print(<<ENDTHREEHEAD);	$r->print(<<ENDTHREEHEAD);
Line 497 sub update_user_data {	Line 662 sub update_user_data {
<head>	<head>
<title>The LearningOnline Network with CAPA</title>	<title>The LearningOnline Network with CAPA</title>
</head>	</head>
<body bgcolor="#FFFFFF">
<img align="right" src="/adm/lonIcons/lonlogos.gif">
ENDTHREEHEAD	ENDTHREEHEAD
	my $title;
	if (exists($ENV{'form.makeuser'})) {
	$title='Set Privileges for New User';
	} else {
	$title='Modify User Privileges';
	}
	$r->print(&Apache::loncommon::bodytag($title));
# Check Inputs	# Check Inputs
if (! $ENV{'form.ccuname'} ) {	if (! $ENV{'form.ccuname'} ) {
$r->print($error.'No login name specified.'.$end);	$r->print($error.&mt('No login name specified').'.'.$end);
return;	return;
}	}
if ( $ENV{'form.ccuname'} =~/\W/) {	if ( $ENV{'form.ccuname'} =~/\W/) {
$r->print($error.'Invalid login name. '.	$r->print($error.&mt('Invalid login name').'. '.
'Only letters, numbers, and underscores are valid.'.	&mt('Only letters, numbers, and underscores are valid').'.'.
$end);	$end);
return;	return;
}	}
if (! $ENV{'form.ccdomain'} ) {	if (! $ENV{'form.ccdomain'} ) {
$r->print($error.'No domain specified.'.$end);	$r->print($error.&mt('No domain specified').'.'.$end);
return;	return;
}	}
if ( $ENV{'form.ccdomain'} =~/\W/) {	if ( $ENV{'form.ccdomain'} =~/\W/) {
$r->print($error.'Invalid domain name. '.	$r->print($error.&mt ('Invalid domain name').'. '.
'Only letters, numbers, and underscores are valid.'.	&mt('Only letters, numbers, and underscores are valid').'.'.
$end);	$end);
return;	return;
}	}
if (! exists($ENV{'form.makeuser'})) {	if (! exists($ENV{'form.makeuser'})) {
# Modifying an existing user, so check the validity of the name	# Modifying an existing user, so check the validity of the name
if ($uhome eq 'no_host') {	if ($uhome eq 'no_host') {
$r->print($error.'Unable to determine home server for '.	$r->print($error.&mt('Unable to determine home server for ').
$ENV{'form.ccuname'}.' in domain '.	$ENV{'form.ccuname'}.&mt(' in domain ').
$ENV{'form.ccdomain'}.'.');	$ENV{'form.ccdomain'}.'.');
return;	return;
}	}
Line 554 ENDTHREEHEAD	Line 724 ENDTHREEHEAD
# If they are creating a new user but have not specified login	# If they are creating a new user but have not specified login
# information this will be caught below.	# information this will be caught below.
} else {	} else {
$r->print($error.'Invalid login mode or password'.$end);	$r->print($error.&mt('Invalid login mode or password').$end);
return;	return;
}	}
if ($ENV{'form.makeuser'}) {	if ($ENV{'form.makeuser'}) {
# Create a new user	# Create a new user
	my %lt=&Apache::lonlocal::texthash(
	'cru' => "Creating user",
	'id' => "in domain"
	);
$r->print(<<ENDNEWUSERHEAD);	$r->print(<<ENDNEWUSERHEAD);
<h1>Create User</h1>	<h3>$lt{'cru'} "$ENV{'form.ccuname'}" $lt{'id'} "$ENV{'form.ccdomain'}"</h3>
<h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
ENDNEWUSERHEAD	ENDNEWUSERHEAD
# Check for the authentication mode and password	# Check for the authentication mode and password
if (! $amode \|\| ! $genpwd) {	if (! $amode \|\| ! $genpwd) {
$r->print($error.'Invalid login mode or password'.$end);	$r->print($error.&mt('Invalid login mode or password').$end);
return;	return;
}	}
# Determine desired host	# Determine desired host
Line 576 ENDNEWUSERHEAD	Line 749 ENDNEWUSERHEAD
my %home_servers = &Apache::loncommon::get_library_servers	my %home_servers = &Apache::loncommon::get_library_servers
($ENV{'form.ccdomain'});	($ENV{'form.ccdomain'});
if (! exists($home_servers{$desiredhost})) {	if (! exists($home_servers{$desiredhost})) {
$r->print($error.'Invalid home server specified');	$r->print($error.&mt('Invalid home server specified'));
return;	return;
}	}
}	}
Line 587 ENDNEWUSERHEAD	Line 760 ENDNEWUSERHEAD
$ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},	$ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},
undef,$desiredhost	undef,$desiredhost
);	);
$r->print('Generating user: '.$result);	$r->print(&mt('Generating user').': '.$result);
my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},	my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
$ENV{'form.ccdomain'});	$ENV{'form.ccdomain'});
$r->print('<br>Home server: '.$home.' '.	$r->print('<br />'.&mt('Home server').': '.$home.' '.
$Apache::lonnet::libserv{$home});	$Apache::lonnet::libserv{$home});
} elsif (($ENV{'form.login'} ne 'nochange') &&	} elsif (($ENV{'form.login'} ne 'nochange') &&
($ENV{'form.login'} ne '' )) {	($ENV{'form.login'} ne '' )) {
# Modify user privileges	# Modify user privileges
	my %lt=&Apache::lonlocal::texthash(
	'usr' => "User",
	'id' => "in domain"
	);
$r->print(<<ENDMODIFYUSERHEAD);	$r->print(<<ENDMODIFYUSERHEAD);
<h1>Change User Privileges</h1>	<h2>$lt{'usr'} "$ENV{'form.ccuname'}" $lt{'id'} "$ENV{'form.ccdomain'}"</h2>
<h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
ENDMODIFYUSERHEAD	ENDMODIFYUSERHEAD
if (! $amode \|\| ! $genpwd) {	if (! $amode \|\| ! $genpwd) {
$r->print($error.'Invalid login mode or password'.$end);	$r->print($error.'Invalid login mode or password'.$end);
Line 609 ENDMODIFYUSERHEAD	Line 785 ENDMODIFYUSERHEAD
&Apache::lonnet::modifyuserauth(	&Apache::lonnet::modifyuserauth(
$ENV{'form.ccdomain'},$ENV{'form.ccuname'},	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},
$amode,$genpwd));	$amode,$genpwd));
$r->print('<br>Home server: '.&Apache::lonnet::homeserver	$r->print('<br>'.&mt('Home server').': '.&Apache::lonnet::homeserver
($ENV{'form.ccuname'},$ENV{'form.ccdomain'}));	($ENV{'form.ccuname'},$ENV{'form.ccdomain'}));
} else {	} else {
# Okay, this is a non-fatal error.	# Okay, this is a non-fatal error.
$r->print($error.'You do not have the authority to modify '.	$r->print($error.&mt('You do not have the authority to modify this users authentification information').'.');
'this users authentification information.');
}	}
}	}
##	##
Line 648 ENDMODIFYUSERHEAD	Line 823 ENDMODIFYUSERHEAD
$ENV{'form.ccdomain'},$ENV{'form.ccuname'});	$ENV{'form.ccdomain'},$ENV{'form.ccuname'});
if ($putresult eq 'ok') {	if ($putresult eq 'ok') {
# Tell the user we changed the name	# Tell the user we changed the name
	my %lt=&Apache::lonlocal::texthash(
	'uic' => "User Information Changed",
	'frst' => "first",
	'mddl' => "middle",
	'lst' => "last",
	'gen' => "generation",
	'prvs' => "Previous",
	'chto' => "Changed To"
	);
$r->print(<<"END");	$r->print(<<"END");
<table border="2">	<table border="2">
<caption>User Information Changed</caption>	<caption>$lt{'uic'}</caption>
<tr><th> </th>	<tr><th> </th>
<th>first</th>	<th>$lt{'frst'}</th>
<th>middle</th>	<th>$lt{'mddl'}</th>
<th>last</th>	<th>$lt{'lst'}</th>
<th>generation</th></tr>	<th>$lt{'gen'}</th></tr>
<tr><td>Previous</td>	<tr><td>$lt{'prvs'}</td>
<td>$userenv{'firstname'} </td>	<td>$userenv{'firstname'} </td>
<td>$userenv{'middlename'} </td>	<td>$userenv{'middlename'} </td>
<td>$userenv{'lastname'} </td>	<td>$userenv{'lastname'} </td>
<td>$userenv{'generation'} </td></tr>	<td>$userenv{'generation'} </td></tr>
<tr><td>Changed To</td>	<tr><td>$lt{'chto'}</td>
<td>$ENV{'form.cfirstname'} </td>	<td>$ENV{'form.cfirstname'} </td>
<td>$ENV{'form.cmiddlename'} </td>	<td>$ENV{'form.cmiddlename'} </td>
<td>$ENV{'form.clastname'} </td>	<td>$ENV{'form.clastname'} </td>
Line 669 ENDMODIFYUSERHEAD	Line 853 ENDMODIFYUSERHEAD
</table>	</table>
END	END
} else { # error occurred	} else { # error occurred
$r->print("<h2>Unable to successfully change environment for ".	$r->print("<h2>".&mt('Unable to successfully change environment for')." ".
$ENV{'form.ccuname'}." in domain ".	$ENV{'form.ccuname'}." ".&mt('in domain')." ".
$ENV{'form.ccdomain'}."</h2>");	$ENV{'form.ccdomain'}."</h2>");
}	}
} else { # End of if ($ENV ... ) logic	} else { # End of if ($ENV ... ) logic
# They did not want to change the users name but we can	# They did not want to change the users name but we can
# still tell them what the name is	# still tell them what the name is
	my %lt=&Apache::lonlocal::texthash(
	'usr' => "User",
	'id' => "in domain",
	'gen' => "Generation"
	);
$r->print(<<"END");	$r->print(<<"END");
<h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>	<h2>$lt{'usr'} "$ENV{'form.ccuname'}" $lt{'id'} "$ENV{'form.ccdomain'}"</h2>
<h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>	<h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
<h4>Generation: $userenv{'generation'}</h4>	<h4>$lt{'gen'}: $userenv{'generation'}</h4>
END	END
}	}
}	}
##	##
my $now=time;	my $now=time;
$r->print('<h3>Modifying Roles</h3>');	$r->print('<h3>'.&mt('Modifying Roles').'</h3>');
foreach (keys (%ENV)) {	foreach (keys (%ENV)) {
next if (! $ENV{$_});	next if (! $ENV{$_});
# Revoke roles	# Revoke roles
if ($_=~/^form\.rev/) {	if ($_=~/^form\.rev/) {
if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {	if ($_=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
$r->print('Revoking '.$2.' in '.$1.': '.	# Revoke standard role
	$r->print(&mt('Revoking').' '.$2.' in '.$1.': <b>'.
	&Apache::lonnet::revokerole($ENV{'form.ccdomain'},
	$ENV{'form.ccuname'},$1,$2).'</b><br>');
	if ($2 eq 'st') {
	$1=~/^\/(\w+)\/(\w+)/;
	my $cid=$1.'_'.$2;
	$r->print(&mt('Drop from classlist').': <b>'.
	&Apache::lonnet::critical('put:'.
	$ENV{'course.'.$cid.'.domain'}.':'.
	$ENV{'course.'.$cid.'.num'}.':classlist:'.
	&Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
	$ENV{'form.ccdomain'}).'='.
	&Apache::lonnet::escape($now.':'),
	$ENV{'course.'.$cid.'.home'}).'</b><br>');
	}
	}
	if ($_=~/^form\.rev\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {
	# Revoke custom role
	$r->print(&mt('Revoking custom role').
	' '.$4.' by '.$3.'@'.$2.' in '.$1.': <b>'.
	&Apache::lonnet::revokecustomrole($ENV{'form.ccdomain'},
	$ENV{'form.ccuname'},$1,$2,$3,$4).
	'</b><br>');
	}
	} elsif ($_=~/^form\.del/) {
	if ($_=~/^form\.del\:([^\_]+)\_([^\_]+)$/) {
	$r->print(&mt('Deleting').' '.$2.' in '.$1.': '.
&Apache::lonnet::assignrole($ENV{'form.ccdomain'},	&Apache::lonnet::assignrole($ENV{'form.ccdomain'},
$ENV{'form.ccuname'},$1,$2,$now).'<br>');	$ENV{'form.ccuname'},$1,$2,$now,0,1).'<br>');
if ($2 eq 'st') {	if ($2 eq 'st') {
$1=~/^\/(\w+)\/(\w+)/;	$1=~/^\/(\w+)\/(\w+)/;
my $cid=$1.'_'.$2;	my $cid=$1.'_'.$2;
$r->print('Drop from classlist: '.	$r->print(&mt('Drop from classlist').': <b>'.
&Apache::lonnet::critical('put:'.	&Apache::lonnet::critical('put:'.
$ENV{'course.'.$cid.'.domain'}.':'.	$ENV{'course.'.$cid.'.domain'}.':'.
$ENV{'course.'.$cid.'.num'}.':classlist:'.	$ENV{'course.'.$cid.'.num'}.':classlist:'.
&Apache::lonnet::escape($ENV{'form.ccuname'}.':'.	&Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
$ENV{'form.ccdomain'}).'='.	$ENV{'form.ccdomain'}).'='.
&Apache::lonnet::escape($now.':'),	&Apache::lonnet::escape($now.':'),
$ENV{'course.'.$cid.'.home'}).'<br>');	$ENV{'course.'.$cid.'.home'}).'</b><br>');
}	}
}	}
} elsif ($_=~/^form\.act/) {	} elsif ($_=~/^form\.act/) {
if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {	if
	($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) {
	# Activate a custom role
	my $url='/'.$1.'/'.$2;
	my $full=$1.'_'.$2.'_cr_cr_'.$3.'_'.$4.'_'.$5;
	if ($ENV{'form.sec_'.$full}) {
	$url.='/'.$ENV{'form.sec_'.$full};
	}

	my $start = ( $ENV{'form.start_'.$full} ?
	$ENV{'form.start_'.$full} :
	$now );
	my $end = ( $ENV{'form.end_'.$full} ?
	$ENV{'form.end_'.$full} :
	0 );

	$r->print(&mt('Assigning custom role').' "'.$5.'" by '.$4.'@'.$3.' in '.$url.
	($start?', '.&mt('starting').' '.localtime($start):'').
	($end?', ending '.localtime($end):'').': <b>'.
	&Apache::lonnet::assigncustomrole(
	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},$url,$3,$4,$5,$end,$start).
	'</b><br>');
	} elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {
# Activate roles for sections with 3 id numbers	# Activate roles for sections with 3 id numbers
# set start, end times, and the url for the class	# set start, end times, and the url for the class
my $start = ( $ENV{'form.start_'.$1.'_'.$2} ?
$ENV{'form.start_'.$1.'_'.$2} :	my $start = ( $ENV{'form.start_'.$1.'_'.$2.'_'.$3} ?
	$ENV{'form.start_'.$1.'_'.$2.'_'.$3} :
$now );	$now );
my $end = ( $ENV{'form.end_'.$1.'_'.$2} ?	my $end = ( $ENV{'form.end_'.$1.'_'.$2.'_'.$3} ?
$ENV{'form.end_'.$1.'_'.$2} :	$ENV{'form.end_'.$1.'_'.$2.'_'.$3} :
0 );	0 );
my $url='/'.$1.'/'.$2;	my $url='/'.$1.'/'.$2;
if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {	if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
$url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};	$url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
}	}
# Assign the role and report it	# Assign the role and report it
$r->print('Assigning: '.$3.' in '.$url.': '.	$r->print(&mt('Assigning').' '.$3.' in '.$url.
	($start?', '.&mt('starting').' '.localtime($start):'').
	($end?', '.&mt('ending').' '.localtime($end):'').': <b>'.
&Apache::lonnet::assignrole(	&Apache::lonnet::assignrole(
$ENV{'form.ccdomain'},$ENV{'form.ccuname'},	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},
$url,$3,$end,$start).	$url,$3,$end,$start).
'<br>');	'</b><br>');
# Handle students differently	# Handle students differently
if ($3 eq 'st') {	if ($3 eq 'st') {
$url=~/^\/(\w+)\/(\w+)/;	$url=~/^\/(\w+)\/(\w+)/;
my $cid=$1.'_'.$2;	my $cid=$1.'_'.$2;
$r->print('Add to classlist: '.	$r->print(&mt('Add to classlist').': <b>'.
&Apache::lonnet::critical(	&Apache::lonnet::critical(
'put:'.$ENV{'course.'.$cid.'.domain'}.':'.	'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
$ENV{'course.'.$cid.'.num'}.':classlist:'.	$ENV{'course.'.$cid.'.num'}.':classlist:'.
Line 740 END	Line 981 END
$ENV{'form.ccdomain'} ).'='.	$ENV{'form.ccdomain'} ).'='.
&Apache::lonnet::escape($end.':'.$start),	&Apache::lonnet::escape($end.':'.$start),
$ENV{'course.'.$cid.'.home'})	$ENV{'course.'.$cid.'.home'})
.'<br>');	.'</b><br>');
}	}
} elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {	} elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
# Activate roles for sections with two id numbers	# Activate roles for sections with two id numbers
Line 753 END	Line 994 END
0 );	0 );
my $url='/'.$1.'/';	my $url='/'.$1.'/';
# Assign the role and report it.	# Assign the role and report it.
$r->print('Assigning: '.$2.' in '.$url.': '.	$r->print(&mt('Assigning').' '.$2.' in '.$url.': '.
	($start?', '.&mt('starting').' '.localtime($start):'').
	($end?', '.&mt('ending').' '.localtime($end):'').': <b>'.
&Apache::lonnet::assignrole(	&Apache::lonnet::assignrole(
$ENV{'form.ccdomain'},$ENV{'form.ccuname'},	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},
$url,$2,$end,$start)	$url,$2,$end,$start)
.'<br>');	.'</b><br>');
}	} else {
	$r->print('<p>'.&mt('ERROR').': '.&mt('Unknown command').' <tt>'.$_.'</tt></p><br>');
	}
}	}
} # End of foreach (keys(%ENV))	} # End of foreach (keys(%ENV))
	# Flush the course logs so reverse user roles immediately updated
	&Apache::lonnet::flushcourselogs();
	$r->print('</body></html>');
	}

	# ========================================================== Custom Role Editor

	sub custom_role_editor {
	my $r=shift;
	my $rolename=$ENV{'form.rolename'};

	if ($rolename eq 'make new role') {
	$rolename=$ENV{'form.newrolename'};
	}

	$rolename=~s/[^A-Za-z0-9]//gs;

	unless ($rolename) {
	&print_username_entry_form($r);
	return;
	}

	$r->print(&Apache::loncommon::bodytag(
	'Create Users, Change User Privileges').'<h2>');
	my $syspriv='';
	my $dompriv='';
	my $coursepriv='';
	my ($rdummy,$roledef)=
	&Apache::lonnet::get('roles',["rolesdef_$rolename"]);
	# ------------------------------------------------------- Does this role exist?
	if (($rdummy ne 'con_lost') && ($roledef ne '')) {
	$r->print(&mt('Existing Role').' "');
	# ------------------------------------------------- Get current role privileges
	($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
	} else {
	$r->print(&mt('New Role').' "');
	$roledef='';
	}
	$r->print($rolename.'"</h2>');
	# ------------------------------------------------------- What can be assigned?
	my %full=();
	my %courselevel=();
	my %courselevelcurrent=();
	foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
	my ($priv,$restrict)=split(/\&/,$_);
	unless ($restrict) { $restrict='F'; }
	$courselevel{$priv}=$restrict;
	if ($coursepriv=~/\:$priv/) {
	$courselevelcurrent{$priv}=1;
	}
	$full{$priv}=1;
	}
	my %domainlevel=();
	my %domainlevelcurrent=();
	foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
	my ($priv,$restrict)=split(/\&/,$_);
	unless ($restrict) { $restrict='F'; }
	$domainlevel{$priv}=$restrict;
	if ($dompriv=~/\:$priv/) {
	$domainlevelcurrent{$priv}=1;
	}
	$full{$priv}=1;
	}
	my %systemlevel=();
	my %systemlevelcurrent=();
	foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
	my ($priv,$restrict)=split(/\&/,$_);
	unless ($restrict) { $restrict='F'; }
	$systemlevel{$priv}=$restrict;
	if ($syspriv=~/\:$priv/) {
	$systemlevelcurrent{$priv}=1;
	}
	$full{$priv}=1;
	}
	my %lt=&Apache::lonlocal::texthash(
	'prv' => "Privilege",
	'crl' => "Course Level",
	'dml' => "Domain Level",
	'ssl' => "System Level"
	);
	$r->print(<<ENDCCF);
	<form method="post">
	<input type="hidden" name="phase" value="set_custom_roles" />
	<input type="hidden" name="rolename" value="$rolename" />
	<table border="2">
	<tr><th>$lt{'prv'}</th><th>$lt{'crl'}</th><th>$lt{'dml'}</th>
	<th>$lt{'ssl'}</th></tr>
	ENDCCF
	foreach (sort keys %full) {
	$r->print('<tr><td>'.&Apache::lonnet::plaintext($_).'</td><td>'.
	($courselevel{$_}?'<input type="checkbox" name="'.$_.':c" '.
	($courselevelcurrent{$_}?'checked="1"':'').' />':' ').
	'</td><td>'.
	($domainlevel{$_}?'<input type="checkbox" name="'.$_.':d" '.
	($domainlevelcurrent{$_}?'checked="1"':'').' />':' ').
	'</td><td>'.
	($systemlevel{$_}?'<input type="checkbox" name="'.$_.':s" '.
	($systemlevelcurrent{$_}?'checked="1"':'').' />':' ').
	'</td></tr>');
	}
	$r->print(
	'<table><input type="submit" value="'.&mt('Define Role').'" /></form></body></html>');
	}

	# ---------------------------------------------------------- Call to definerole
	sub set_custom_role {
	my $r=shift;

	my $rolename=$ENV{'form.rolename'};

	$rolename=~s/[^A-Za-z0-9]//gs;

	unless ($rolename) {
	&print_username_entry_form($r);
	return;
	}

	$r->print(&Apache::loncommon::bodytag(
	'Create Users, Change User Privileges').'<h2>');
	my ($rdummy,$roledef)=
	&Apache::lonnet::get('roles',["rolesdef_$rolename"]);
	# ------------------------------------------------------- Does this role exist?
	if (($rdummy ne 'con_lost') && ($roledef ne '')) {
	$r->print(&mt('Existing Role').' "');
	} else {
	$r->print(&mt('New Role').' "');
	$roledef='';
	}
	$r->print($rolename.'"</h2>');
	# ------------------------------------------------------- What can be assigned?
	my $sysrole='';
	my $domrole='';
	my $courole='';

	foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
	my ($priv,$restrict)=split(/\&/,$_);
	unless ($restrict) { $restrict=''; }
	if ($ENV{'form.'.$priv.':c'}) {
	$courole.=':'.$_;
	}
	}

	foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
	my ($priv,$restrict)=split(/\&/,$_);
	unless ($restrict) { $restrict=''; }
	if ($ENV{'form.'.$priv.':d'}) {
	$domrole.=':'.$_;
	}
	}

	foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
	my ($priv,$restrict)=split(/\&/,$_);
	unless ($restrict) { $restrict=''; }
	if ($ENV{'form.'.$priv.':s'}) {
	$sysrole.=':'.$_;
	}
	}
	$r->print('<br />Defining Role: '.
	&Apache::lonnet::definerole($rolename,$sysrole,$domrole,$courole));
	if ($ENV{'request.course.id'}) {
	my $url='/'.$ENV{'request.course.id'};
	$url=~s/\_/\//g;
	$r->print('<br />'.&mt('Assigning Role to Self').': '.
	&Apache::lonnet::assigncustomrole($ENV{'user.domain'},
	$ENV{'user.name'},
	$url,
	$ENV{'user.domain'},
	$ENV{'user.name'},
	$rolename));
	}
$r->print('</body></html>');	$r->print('</body></html>');
}	}

Line 769 sub handler {	Line 1184 sub handler {
my $r = shift;	my $r = shift;

if ($r->header_only) {	if ($r->header_only) {
$r->content_type('text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;
return OK;	return OK;
}	}
Line 780 sub handler {	Line 1195 sub handler {
(&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) \|\|	(&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) \|\|
(&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) \|\|	(&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) \|\|
(&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {	(&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {
$r->content_type('text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;
unless ($ENV{'form.phase'}) {	unless ($ENV{'form.phase'}) {
&print_username_entry_form($r);	&print_username_entry_form($r);
Line 789 sub handler {	Line 1204 sub handler {
&print_user_modification_page($r);	&print_user_modification_page($r);
} elsif ($ENV{'form.phase'} eq 'update_user_data') {	} elsif ($ENV{'form.phase'} eq 'update_user_data') {
&update_user_data($r);	&update_user_data($r);
	} elsif ($ENV{'form.phase'} eq 'selected_custom_edit') {
	&custom_role_editor($r);
	} elsif ($ENV{'form.phase'} eq 'set_custom_roles') {
	&set_custom_role($r);
}	}
} else {	} else {
$ENV{'user.error.msg'}=	$ENV{'user.error.msg'}=
Line 802 sub handler {	Line 1221 sub handler {
sub course_level_table {	sub course_level_table {
my %inccourses = @_;	my %inccourses = @_;
my $table = '';	my $table = '';
	# Custom Roles?

	my %customroles=&my_custom_roles();

foreach (sort( keys(%inccourses))) {	foreach (sort( keys(%inccourses))) {
my $thiscourse=$_;	my $thiscourse=$_;
my $protectedcourse=$_;	my $protectedcourse=$_;
$thiscourse=~s:_:/:g;	$thiscourse=~s:_:/:g;
my %coursedata=&Apache::lonnet::coursedescription($thiscourse);	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
my $area=$coursedata{'description'};	my $area=$coursedata{'description'};
	if (!defined($area)) { $area=&mt('Unavailable course').': '.$_; }
my $bgcol=$thiscourse;	my $bgcol=$thiscourse;
$bgcol=~s/[^8-9b-e]//g;	$bgcol=~s/[^7-9a-e]//g;
$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
foreach ('st','ta','ep','ad','in','cc') {	foreach ('st','ta','ep','ad','in','cc') {
if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {	if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
my $plrole=&Apache::lonnet::plaintext($_);	my $plrole=&Apache::lonnet::plaintext($_);
Line 829 ENDSECTION	Line 1253 ENDSECTION
<td>&nbsp</td>	<td>&nbsp</td>
ENDSECTION	ENDSECTION
}	}
	my %lt=&Apache::lonlocal::texthash(
	'ssd' => "Set Start Date",
	'sed' => "Set End Date"
	);
$table .= <<ENDTIMEENTRY;	$table .= <<ENDTIMEENTRY;
<td><input type=hidden name="start_$protectedcourse\_$_" value=''>	<td><input type=hidden name="start_$protectedcourse\_$_" value=''>
<a href=	<a href=
"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>	"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
<td><input type=hidden name="end_$protectedcourse\_$_" value=''>	<td><input type=hidden name="end_$protectedcourse\_$_" value=''>
<a href=	<a href=
"javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>	"javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
ENDTIMEENTRY	ENDTIMEENTRY
$table.= "</tr>\n";	$table.= "</tr>\n";
}	}
}	}
	foreach (sort keys %customroles) {
	if (&Apache::lonnet::allowed('ccr',$thiscourse)) {
	my $plrole=$_;
	my $customrole=$protectedcourse.'_cr_cr_'.$ENV{'user.domain'}.
	'_'.$ENV{'user.name'}.'_'.$plrole;
	my %lt=&Apache::lonlocal::texthash(
	'ssd' => "Set Start Date",
	'sed' => "Set End Date"
	);
	$table .= <<ENDENTRY;
	<tr bgcolor="#$bgcol">
	<td><input type="checkbox" name="act_$customrole"></td>
	<td>$plrole</td>
	<td>$area</td>
	<td><input type="text" size="5" name="sec_$customrole"></td>
	<td><input type=hidden name="start_$customrole" value=''>
	<a href=
	"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$customrole.value,'start_$customrole','cu.pres','dateset')">$lt{'ssd'}</a></td>
	<td><input type=hidden name="end_$customrole" value=''>
	<a href=
	"javascript:pjump('date_end','End Date $plrole',document.cu.end_$customrole.value,'end_$customrole','cu.pres','dateset')">$lt{'sed'}</a></td></tr>
	ENDENTRY
	}
	}
}	}
return '' if ($table eq ''); # return nothing if there is nothing	return '' if ($table eq ''); # return nothing if there is nothing
# in the table	# in the table
	my %lt=&Apache::lonlocal::texthash(
	'crl' => "Course Level",
	'act' => "Activate",
	'rol' => "Role",
	'ext' => "Extent",
	'grs' => "Group/Section",
	'sta' => "Start",
	'end' => "End"
	);
my $result = <<ENDTABLE;	my $result = <<ENDTABLE;
<h4>Course Level</h4>	<h4>$lt{'crl'}</h4>
<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>	<table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
<th>Group/Section</th><th>Start</th><th>End</th></tr>	<th>$lt{'grs'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
$table	$table
</table>	</table>
ENDTABLE	ENDTABLE

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

Removed from v.1.39.6.1
changed lines
	Added in v.1.77