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.28 and 1.42

version 1.28, 2002/03/22 22:23:23	version 1.42, 2002/08/23 19:43:11
Line 68 BEGIN {	Line 68 BEGIN {
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;	$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
my $krbdefdom=$1;	my $krbdefdom=$1;
$krbdefdom=~tr/a-z/A-Z/;	$krbdefdom=~tr/a-z/A-Z/;
$authformnop=(<<END);	my %param = ( formname => 'document.cu',
<p>	kerb_def_dom => $krbdefdom
<input type="radio" name="login" value="" checked="checked"	);
onClick="clicknop(this.form);">	$loginscript = &Apache::loncommon::authform_header(%param);
Do not change login data	$generalrule = &Apache::loncommon::authform_authorwarning(%param);
</p>	$authformnop = &Apache::loncommon::authform_nochange(%param);
END	$authformkrb = &Apache::loncommon::authform_kerberos(%param);
$authformkrb=(<<END);	$authformint = &Apache::loncommon::authform_internal(%param);
<p>	$authformfsys = &Apache::loncommon::authform_filesystem(%param);
<input type=radio name=login value=krb onClick="clickkrb(this.form);">	$authformloc = &Apache::loncommon::authform_local(%param);
Kerberos authenticated with domain
<input type=text size=10 name=krbdom onChange="setkrb(this.form);">
</p>
END
$authformint=(<<END);
<p>
<input type=radio name=login value=int onClick="clickint(this.form);">
Internally authenticated (with initial password
<input type=text size=10 name=intpwd onChange="setint(this.form);">)
</p>
END
$authformfsys=(<<END);
<p>
<input type=radio name=login value=fsys onClick="clickfsys(this.form);">
Filesystem authenticated (with initial password
<input type=text size=10 name=fsyspwd onChange="setfsys(this.form);">)
</p>
END
$authformloc=(<<END);
<p>
<input type=radio name=login value=loc onClick="clickloc(this.form);" />
Local Authentication with argument
<input type=text size=10 name=locarg onChange="setloc(this.form);" />
</p>
END
$loginscript=(<<ENDLOGINSCRIPT);
<script>
function setkrb(vf) {
if (vf.krbdom.value!='') {
vf.login[0].checked=true;
vf.krbdom.value=vf.krbdom.value.toUpperCase();
vf.intpwd.value='';
vf.fsyspwd.value='';
vf.locarg.value='';
}
}

function setint(vf) {
if (vf.intpwd.value!='') {
vf.login[1].checked=true;
vf.krbdom.value='';
vf.fsyspwd.value='';
vf.locarg.value='';
}
}

function setfsys(vf) {
if (vf.fsyspwd.value!='') {
vf.login[2].checked=true;
vf.krbdom.value='';
vf.intpwd.value='';
vf.locarg.value='';
}
}

function setloc(vf) {
if (vf.locarg.value!='') {
vf.login[3].checked=true;
vf.krbdom.value='';
vf.intpwd.value='';
vf.fsyspwd.value='';
}
}

function clicknop(vf) {
vf.krbdom.value='';
vf.intpwd.value='';
vf.fsyspwd.value='';
vf.locarg.value='';
}

function clickkrb(vf) {
vf.krbdom.value='$krbdefdom';
vf.intpwd.value='';
vf.fsyspwd.value='';
vf.locarg.value='';
}

function clickint(vf) {
vf.krbdom.value='';
vf.fsyspwd.value='';
vf.locarg.value='';
}

function clickfsys(vf) {
vf.krbdom.value='';
vf.intpwd.value='';
vf.locarg.value='';
}

function clickloc(vf) {
vf.krbdom.value='';
vf.intpwd.value='';
vf.fsyspwd.value='';
}
</script>
ENDLOGINSCRIPT
$generalrule=<<END;
<p>
<i>As a general rule, only authors or co-authors should be filesystem
authenticated (which allows access to the server filesystem).</i>
</p>
END
}	}

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

sub phase_one {	sub print_username_entry_form {
my $r=shift;	my $r=shift;
my $defdom=$ENV{'user.domain'};	my $defdom=$ENV{'request.role.domain'};
$r->print(<<ENDDOCUMENT);	my @domains = &Apache::loncommon::get_domains();
	my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
	my $bodytag =&Apache::loncommon::bodytag(
	'Create Users, Change User Privileges');
	$r->print(<<"ENDDOCUMENT");
<html>	<html>
<head>	<head>
<title>The LearningOnline Network with CAPA</title>	<title>The LearningOnline Network with CAPA</title>
</head>	</head>
<body bgcolor="#FFFFFF">	$bodytag
<h1>Create User, Change User Privileges</h1>	<form action="/adm/createuser" method="post">
<form action=/adm/createuser method=post>	<input type="hidden" name="phase" value="get_user_info">
<input type=hidden name=phase value=two>	<p>
Username: <input type=text size=15 name=ccuname><br>	Username: <input type="text" size="15" name="ccuname"><br>
Domain: <input type=text size=15 name=ccdomain value=$defdom><p>	Domain: $domform
<input type=submit value="Continue">	</p>
	<input type="submit" value="Continue">
</form>	</form>
</body>	</body>
</html>	</html>
Line 207 ENDDOCUMENT	Line 109 ENDDOCUMENT
}	}

# =================================================================== Phase two	# =================================================================== Phase two
sub phase_two {	sub print_user_modification_page {
my $r=shift;	my $r=shift;
my $ccuname=$ENV{'form.ccuname'};	my $ccuname=$ENV{'form.ccuname'};
my $ccdomain=$ENV{'form.ccdomain'};	my $ccdomain=$ENV{'form.ccdomain'};
Line 215 sub phase_two {	Line 117 sub phase_two {
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;	$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
my $krbdefdom=$1;	my $krbdefdom=$1;
$krbdefdom=~tr/a-z/A-Z/;	$krbdefdom=~tr/a-z/A-Z/;
	my %param = ( formname => 'document.cu',
	kerb_def_dom => $krbdefdom
	);
	$loginscript = &Apache::loncommon::authform_header(%param);

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

$ccuname=~s/\W//g;	$ccuname=~s/\W//g;
$ccdomain=~s/\W//g;	$ccdomain=~s/\W//g;
Line 224 sub phase_two {	Line 130 sub phase_two {
<html>	<html>
<head>	<head>
<title>The LearningOnline Network with CAPA</title>	<title>The LearningOnline Network with CAPA</title>
<script>	<script type="text/javascript" language="Javascript">

function pclose() {	function pclose() {
parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",	parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
Line 249 sub phase_two {	Line 155 sub phase_two {

</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="three">	<input type="hidden" name="phase" value="update_user_data">
<input type="hidden" name="ccuname" value="$ccuname">	<input type="hidden" name="ccuname" value="$ccuname">
<input type="hidden" name="ccdomain" value="$ccdomain">	<input type="hidden" name="ccdomain" value="$ccdomain">
<input type="hidden" name="pres_value" value="" >	<input type="hidden" name="pres_value" value="" >
<input type="hidden" name="pres_type" value="" >	<input type="hidden" name="pres_type" value="" >
<input type="hidden" name="pres_marker" value="" >	<input type="hidden" name="pres_marker" value="" >
<input type="hidden" name="cuname" value="$ccuname">
<input type="hidden" name="cdomain" value="$ccdomain">
ENDFORMINFO	ENDFORMINFO
my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);	my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
my %incdomains;	my %incdomains;
Line 275 ENDFORMINFO	Line 179 ENDFORMINFO
}	}
}	}
if ($uhome eq 'no_host') {	if ($uhome eq 'no_host') {
	my $home_server_list=
	'<option value="default" selected>default</option>'."\n".
	&Apache::loncommon::home_server_option_list($ccdomain);

$r->print(<<ENDNEWUSER);	$r->print(<<ENDNEWUSER);
$dochead	$dochead
<h1>Create New User</h1>	<h1>Create New User</h1>
$forminfo	$forminfo
<h2>New user "$ccuname" in domain $ccdomain</h2>	<h2>New user "$ccuname" in domain $ccdomain</h2>
	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
	</script>
<input type='hidden' name='makeuser' value='1' />	<input type='hidden' name='makeuser' value='1' />
<h3>Personal Data</h3>	<h3>Personal Data</h3>
<p>	<p>
Line 295 $loginscript	Line 205 $loginscript
<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>	ID/Student Number <input type='text' name='cstid' size='15' /></p>
	Home Server: <select name="hserver" size="1"> $home_server_list </select>
<hr />	<hr />
<h3>Login Data</h3>	<h3>Login Data</h3>
$generalrule	<p>$generalrule </p>
$authformkrb	<p>$authformkrb </p>
$authformint	<p>$authformint </p>
$authformfsys	<p>$authformfsys</p>
$authformloc	<p>$authformloc </p>
ENDNEWUSER	ENDNEWUSER
} else { # user already exists	} else { # user already exists
$r->print(<<ENDCHANGEUSER);	$r->print(<<ENDCHANGEUSER);
Line 340 END	Line 251 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;
$r->print('<hr /><h3>Revoke Existing Roles</h3>'.	$r->print(<<END);
'<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.	<hr />
'<th>Start</th><th>End</th>');	<h3>Revoke Existing Roles</h3>
	<table border=2>
	<tr><th>Revoke</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>
	END
foreach my $area (keys(%rolesdump)) {	foreach my $area (keys(%rolesdump)) {
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);
my $bgcol='ffffff';	my $bgcol='ffffff';
my $allows=0;	my $allowed=0;
if ($area=~/^\/(\w+)\/(\d\w+)/) {	if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
my %coursedata=	my %coursedata=
&Apache::lonnet::coursedescription($1.'_'.$2);	&Apache::lonnet::coursedescription($1.'_'.$2);
my $carea='Course: '.$coursedata{'description'};	my $carea='Course: '.$coursedata{'description'};
$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)) {
$allows=1;	$allowed=1;
}	}
# 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/[^8-9b-e]//g;
$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {	if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
$carea.='<br>Section/Group: '.$3;	$carea.='<br>Section/Group: '.$3;
}	}
$area=$carea;	$area=$carea;
} 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)) {
$allows=1;	$allowed=1;
}	}
} else {	} else {
if (&Apache::lonnet::allowed('c'.$role_code,'/')) {	if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
$allows=1;	$allowed=1;
}	}
}	}
}	}
$r->print('<tr bgcolor=#"'.$bgcol.'"><td>');	# I have no idea what the hell the above code does
my $active=1;	# So the following is a check:
$active=0 if (($role_end_time) && ($now>$role_end_time));	if ($allowed) {
if (($active) && ($allows)) {	# If we are looking at a co-author role, make sure it is
$r->print('<input type="checkbox" name="rev:'	# for the current users construction space before we let
.$thisrole.'">');	# them revoke it.
} else {	if (($role_code eq 'ca') &&
$r->print(' ');	($ENV{'request.role'} !~ /^dc/)) {
}	if ($area !~
$r->print('</td><td>'.	/^\/$ENV{'request.role.domain'}\/$ENV{'user.name'}/) {
&Apache::lonnet::plaintext($role_code).	$allowed = 0;
'</td><td>'.$area.'</td><td>'.	}
($role_start_time ? localtime($role_start_time)	}
: ' ' )	}
.'</td><td>'.	my $row = '';
($role_end_time ? localtime($role_end_time)	$row.='<tr bgcolor=#"'.$bgcol.'"><td>';
: ' ' )	my $active=1;
."</td></tr>\n");	$active=0 if (($role_end_time) && ($now>$role_end_time));
}	if (($active) && ($allowed)) {
	$row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
	} else {
	$row.=' ';
	}
	$row.= '</td><td>'.&Apache::lonnet::plaintext($role_code).
	'</td><td>'.$area.
	'</td><td>'.($role_start_time?localtime($role_start_time)
	: ' ' ).
	'</td><td>'.($role_end_time ?localtime($role_end_time)
	: ' ' )
	."</td></tr>\n";
	$r->print($row);
} # end of foreach (table building loop)	} # end of foreach (table building loop)
$r->print('</table>');	$r->print('</table>');
} # End of unless	} # End of unless
my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
if ($currentauth=~/^krb4:/) {	if ($currentauth=~/^krb(4\|5):/) {
$currentauth=~/^krb4:(.*)/;	$currentauth=~/^krb(4\|5):(.*)/;
my $krbdefdom2=$1;	my $krbdefdom2=$1;
$loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;	my %param = ( formname => 'document.cu',
	kerb_def_dom => $krbdefdom
	);
	$loginscript = &Apache::loncommon::authform_header(%param);
}	}
# Check for a bad authentication type	# Check for a bad authentication type
unless ($currentauth=~/^krb4:/ or	unless ($currentauth=~/^krb(4\|5):/ or
$currentauth=~/^unix:/ or	$currentauth=~/^unix:/ or
$currentauth=~/^internal:/ or	$currentauth=~/^internal:/ or
$currentauth=~/^localauth:/	$currentauth=~/^localauth:/
) { # bad authentication scheme	) { # bad authentication scheme
if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {	if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
$r->print(<<ENDBADAUTH);	$r->print(<<ENDBADAUTH);
<hr />	<hr />
	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
	</script>
<font color='#ff0000'>ERROR:</font>	<font color='#ff0000'>ERROR:</font>
This user has an unrecognized authentication scheme ($currentauth).	This user has an unrecognized authentication scheme ($currentauth).
Please specify login data below.	Please specify login data below.
<h3>Login Data</h3>	<h3>Login Data</h3>
$generalrule	<p>$generalrule</p>
$authformkrb	<p>$authformkrb</p>
$authformint	<p>$authformint</p>
$authformfsys	<p>$authformfsys</p>
$authformloc	<p>$authformloc</p>
ENDBADAUTH	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
$r->print(<<ENDBADAUTH);	$r->print(<<ENDBADAUTH);
<hr />	<hr />
	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
	</script>
<font color="#ff0000"> ERROR: </font>	<font color="#ff0000"> ERROR: </font>
This user has an unrecognized authentication scheme ($currentauth).	This user has an unrecognized authentication scheme ($currentauth).
Please alert a domain coordinator of this situation.	Please alert a domain coordinator of this situation.
Line 443 ENDBADAUTH	Line 376 ENDBADAUTH
} else { # Authentication type is valid	} else { # Authentication type is valid
my $authformcurrent='';	my $authformcurrent='';
my $authform_other='';	my $authform_other='';
if ($currentauth=~/^krb4:/) {	if ($currentauth=~/^krb(4\|5):/) {
$authformcurrent=$authformkrb;	$authformcurrent=$authformkrb;
$authform_other=$authformint.$authformfsys.$authformloc;	$authform_other="<p>$authformint</p>\n".
# embarrassing script hack here	"<p>$authformfsys</p><p>$authformloc</p>";
$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[2\]/login\[3\]/; # fsys
$loginscript=~s/login\[1\]/login\[2\]/; # int
$loginscript=~s/login\[0\]/login\[1\]/; # krb4
}	}
elsif ($currentauth=~/^internal:/) {	elsif ($currentauth=~/^internal:/) {
$authformcurrent=$authformint;	$authformcurrent=$authformint;
$authform_other=$authformkrb.$authformfsys.$authformloc;	$authform_other="<p>$authformkrb</p>".
# embarrassing script hack here	"<p>$authformfsys</p><p>$authformloc</p>";
$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[2\]/login\[3\]/; # fsys
$loginscript=~s/login\[1\]/login\[1\]/; # int
$loginscript=~s/login\[0\]/login\[2\]/; # krb4
}	}
elsif ($currentauth=~/^unix:/) {	elsif ($currentauth=~/^unix:/) {
$authformcurrent=$authformfsys;	$authformcurrent=$authformfsys;
$authform_other=$authformkrb.$authformint.$authformloc;	$authform_other="<p>$authformkrb</p>".
# embarrassing script hack here	"<p>$authformint</p><p>$authformloc;</p>";
$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[1\]/login\[3\]/; # int
$loginscript=~s/login\[2\]/login\[1\]/; # fsys
$loginscript=~s/login\[0\]/login\[2\]/; # krb4
}	}
elsif ($currentauth=~/^localauth:/) {	elsif ($currentauth=~/^localauth:/) {
$authformcurrent=$authformloc;	$authformcurrent=$authformloc;
$authform_other=$authformkrb.$authformint.$authformfsys;	$authform_other="<p>$authformkrb</p>".
# embarrassing script hack here	"<p>$authformint</p><p>$authformfsys</p>";
$loginscript=~s/login\[3\]/login\[loc\]/; # loc
$loginscript=~s/login\[2\]/login\[4\]/; # fsys
$loginscript=~s/login\[1\]/login\[3\]/; # int
$loginscript=~s/login\[0\]/login\[2\]/; # krb4
$loginscript=~s/login\[loc\]/login\[1\]/; # loc
}	}
$authformcurrent=<<ENDCURRENTAUTH;	$authformcurrent=<<ENDCURRENTAUTH;
<table border='1'>	<table border='1'>
Line 490 ENDBADAUTH	Line 406 ENDBADAUTH
<td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>	<td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
</table>	</table>
ENDCURRENTAUTH	ENDCURRENTAUTH
if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {	if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
# Current user has login modification privileges	# Current user has login modification privileges
$r->print(<<ENDOTHERAUTHS);	$r->print(<<ENDOTHERAUTHS);
<hr />	<hr />
	<script type="text/javascript" language="Javascript">
$loginscript	$loginscript
	</script>
<h3>Change Current Login Data</h3>	<h3>Change Current Login Data</h3>
$generalrule	<p>$generalrule</p>
$authformnop	<p>$authformnop</p>
$authformcurrent	<p>$authformcurrent</p>
<h3>Enter New Login Data</h3>	<h3>Enter New Login Data</h3>
$authform_other	$authform_other
ENDOTHERAUTHS	ENDOTHERAUTHS
Line 509 ENDOTHERAUTHS	Line 427 ENDOTHERAUTHS
#	#
# Co-Author	# Co-Author
#	#
	if (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) {
if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {
my $cuname=$ENV{'user.name'};	my $cuname=$ENV{'user.name'};
my $cudom=$ENV{'user.domain'};	my $cudom=$ENV{'request.role.domain'};
$r->print(<<ENDCOAUTH);	$r->print(<<ENDCOAUTH);
<h4>Construction Space</h4>	<h4>Construction Space</h4>
<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>	<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
Line 568 ENDDROW	Line 485 ENDDROW
}	}

# ================================================================= Phase Three	# ================================================================= Phase Three
sub phase_three {	sub update_user_data {
my $r=shift;	my $r=shift;
	my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
	$ENV{'form.ccdomain'});
# Error messages	# Error messages
my $error = '<font color="#ff0000">Error:</font>';	my $error = '<font color="#ff0000">Error:</font>';
my $end = '</body></html>';	my $end = '</body></html>';
Line 579 sub phase_three {	Line 498 sub phase_three {
<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.cuname'} ) {	if (! $ENV{'form.ccuname'} ) {
$r->print($error.'No login name specified.'.$end);	$r->print($error.'No login name specified.'.$end);
return;	return;
}	}
if ( $ENV{'form.cuname'} =~/\W/) {	if ( $ENV{'form.ccuname'} =~/\W/) {
$r->print($error.'Invalid login name. '.	$r->print($error.'Invalid login name. '.
'Only letters, numbers, and underscores are valid.'.	'Only letters, numbers, and underscores are valid.'.
$end);	$end);
return;	return;
}	}
if (! $ENV{'form.cdomain'} ) {	if (! $ENV{'form.ccdomain'} ) {
$r->print($error.'No domain specified.'.$end);	$r->print($error.'No domain specified.'.$end);
return;	return;
}	}
if ( $ENV{'form.cdomain'} =~/\W/) {	if ( $ENV{'form.ccdomain'} =~/\W/) {
$r->print($error.'Invalid domain name. '.	$r->print($error.'Invalid domain name. '.
'Only letters, numbers, and underscores are valid.'.	'Only letters, numbers, and underscores are valid.'.
$end);	$end);
return;	return;
}	}
	if (! exists($ENV{'form.makeuser'})) {
	# Modifying an existing user, so check the validity of the name
	if ($uhome eq 'no_host') {
	$r->print($error.'Unable to determine home server for '.
	$ENV{'form.ccuname'}.' in domain '.
	$ENV{'form.ccdomain'}.'.');
	return;
	}
	}
# Determine authentication method and password for the user being modified	# Determine authentication method and password for the user being modified
my $amode='';	my $amode='';
my $genpwd='';	my $genpwd='';
if ($ENV{'form.login'} eq 'krb') {	if ($ENV{'form.login'} eq 'krb') {
$amode='krb4';	$amode='krb';
$genpwd=$ENV{'form.krbdom'};	$amode.=$ENV{'form.krbver'};
	$genpwd=$ENV{'form.krbarg'};
} elsif ($ENV{'form.login'} eq 'int') {	} elsif ($ENV{'form.login'} eq 'int') {
$amode='internal';	$amode='internal';
$genpwd=$ENV{'form.intpwd'};	$genpwd=$ENV{'form.intarg'};
} elsif ($ENV{'form.login'} eq 'fsys') {	} elsif ($ENV{'form.login'} eq 'fsys') {
$amode='unix';	$amode='unix';
$genpwd=$ENV{'form.fsyspwd'};	$genpwd=$ENV{'form.fsysarg'};
} elsif ($ENV{'form.login'} eq 'loc') {	} elsif ($ENV{'form.login'} eq 'loc') {
$amode='localauth';	$amode='localauth';
$genpwd=$ENV{'form.locarg'};	$genpwd=$ENV{'form.locarg'};
$genpwd=" " if (!$genpwd);	$genpwd=" " if (!$genpwd);
	} elsif (($ENV{'form.login'} eq 'nochange') \|\|
	($ENV{'form.login'} eq '' )) {
	# There is no need to tell the user we did not change what they
	# did not ask us to change.
	# If they are creating a new user but have not specified login
	# information this will be caught below.
	} else {
	$r->print($error.'Invalid login mode or password'.$end);
	return;
}	}
if ($ENV{'form.makeuser'}) {	if ($ENV{'form.makeuser'}) {
# Create a new user	# Create a new user
$r->print(<<ENDNEWUSERHEAD);	$r->print(<<ENDNEWUSERHEAD);
<h1>Create User</h1>	<h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
<h3>Creating user "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</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.'Invalid login mode or password'.$end);
return;	return;
}	}
	# Determine desired host
	my $desiredhost = $ENV{'form.hserver'};
	if (lc($desiredhost) eq 'default') {
	$desiredhost = undef;
	} else {
	my %home_servers = &Apache::loncommon::get_library_servers
	($ENV{'form.ccdomain'});
	if (! exists($home_servers{$desiredhost})) {
	$r->print($error.'Invalid home server specified');
	return;
	}
	}
# Call modifyuser	# Call modifyuser
my $result = &Apache::lonnet::modifyuser	my $result = &Apache::lonnet::modifyuser
($ENV{'form.cdomain'},$ENV{'form.cuname'},	($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'},
$ENV{'form.cstid'},$amode,$genpwd,	$amode,$genpwd,$ENV{'form.cfirst'},
$ENV{'form.cfirst'},$ENV{'form.cmiddle'},	$ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},
$ENV{'form.clast'},$ENV{'form.cgen'}	undef,$desiredhost
);	);
$r->print('Generating user: '.$result);	$r->print('Generating user: '.$result);
$r->print('<br>Home server: '.&Apache::lonnet::homeserver	my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
($ENV{'form.cuname'},$ENV{'form.cdomain'}));	$ENV{'form.ccdomain'});
} elsif ($ENV{'form.login'} ne '') {	$r->print('<br>Home server: '.$home.' '.
	$Apache::lonnet::libserv{$home});
	} elsif (($ENV{'form.login'} ne 'nochange') &&
	($ENV{'form.login'} ne '' )) {
# Modify user privileges	# Modify user privileges
$r->print(<<ENDMODIFYUSERHEAD);	$r->print(<<ENDMODIFYUSERHEAD);
<h1>Change User Privileges</h1>	<h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
<h2>User "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</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);
return;	return;
}	}
# Only allow authentification modification if the person has authority	# Only allow authentification modification if the person has authority
if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {	if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'})) {
$r->print('Modifying authentication: '.	$r->print('Modifying authentication: '.
&Apache::lonnet::modifyuserauth(	&Apache::lonnet::modifyuserauth(
$ENV{'form.cdomain'},$ENV{'form.cuname'},	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},
$amode,$genpwd));	$amode,$genpwd));
$r->print('<br>Home server: '.&Apache::lonnet::homeserver	$r->print('<br>Home server: '.&Apache::lonnet::homeserver
($ENV{'form.cuname'},$ENV{'form.cdomain'}));	($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.'You do not have the authority to modify '.
Line 670 ENDMODIFYUSERHEAD	Line 626 ENDMODIFYUSERHEAD
# Check for need to change	# Check for need to change
my %userenv = &Apache::lonnet::get	my %userenv = &Apache::lonnet::get
('environment',['firstname','middlename','lastname','generation'],	('environment',['firstname','middlename','lastname','generation'],
$ENV{'form.cdomain'},$ENV{'form.cuname'});	$ENV{'form.ccdomain'},$ENV{'form.ccuname'});
my ($tmp) = keys(%userenv);	my ($tmp) = keys(%userenv);
if ($tmp =~ /^(con_lost\|error)/i) {	if ($tmp =~ /^(con_lost\|error)/i) {
%userenv = ();	%userenv = ();
Line 680 ENDMODIFYUSERHEAD	Line 636 ENDMODIFYUSERHEAD
# Strip leading and trailing whitespace	# Strip leading and trailing whitespace
$ENV{'form.c'.$_} =~ s/(\s+$\|^\s+)//g;	$ENV{'form.c'.$_} =~ s/(\s+$\|^\s+)//g;
}	}
if (&Apache::lonnet::allowed('mau',$ENV{'form.cdomain'}) &&	if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'}) &&
($ENV{'form.cfirstname'} ne $userenv{'firstname'} \|\|	($ENV{'form.cfirstname'} ne $userenv{'firstname'} \|\|
$ENV{'form.cmiddlename'} ne $userenv{'middlename'} \|\|	$ENV{'form.cmiddlename'} ne $userenv{'middlename'} \|\|
$ENV{'form.clastname'} ne $userenv{'lastname'} \|\|	$ENV{'form.clastname'} ne $userenv{'lastname'} \|\|
Line 693 ENDMODIFYUSERHEAD	Line 649 ENDMODIFYUSERHEAD
$changeHash{'generation'} = $ENV{'form.cgeneration'};	$changeHash{'generation'} = $ENV{'form.cgeneration'};
my $putresult = &Apache::lonnet::put	my $putresult = &Apache::lonnet::put
('environment',\%changeHash,	('environment',\%changeHash,
$ENV{'form.cdomain'},$ENV{'form.cuname'});	$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
$r->print(<<"END");	$r->print(<<"END");
Line 718 ENDMODIFYUSERHEAD	Line 674 ENDMODIFYUSERHEAD
END	END
} else { # error occurred	} else { # error occurred
$r->print("<h2>Unable to successfully change environment for ".	$r->print("<h2>Unable to successfully change environment for ".
$ENV{'form.cuname'}." in domain ".	$ENV{'form.ccuname'}." in domain ".
$ENV{'form.cdomain'}."</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
$r->print(<<"END");	$r->print(<<"END");
<h2>User "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2>	<h2>User "$ENV{'form.ccuname'}" in domain "$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>Generation: $userenv{'generation'}</h4>
END	END
Line 740 END	Line 696 END
if ($_=~/^form\.rev/) {	if ($_=~/^form\.rev/) {
if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {	if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {
$r->print('Revoking '.$2.' in '.$1.': '.	$r->print('Revoking '.$2.' in '.$1.': '.
&Apache::lonnet::assignrole($ENV{'form.cdomain'},	&Apache::lonnet::assignrole($ENV{'form.ccdomain'},
$ENV{'form.cuname'},$1,$2,$now).'<br>');	$ENV{'form.ccuname'},$1,$2,$now).'<br>');
if ($2 eq 'st') {	if ($2 eq 'st') {
$1=~/^\/(\w+)\/(\w+)/;	$1=~/^\/(\w+)\/(\w+)/;
my $cid=$1.'_'.$2;	my $cid=$1.'_'.$2;
Line 749 END	Line 705 END
&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.cuname'}.':'.	&Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
$ENV{'form.cdomain'}).'='.	$ENV{'form.ccdomain'}).'='.
&Apache::lonnet::escape($now.':'),	&Apache::lonnet::escape($now.':'),
$ENV{'course.'.$cid.'.home'}).'<br>');	$ENV{'course.'.$cid.'.home'}).'<br>');
}	}
Line 772 END	Line 728 END
# Assign the role and report it	# Assign the role and report it
$r->print('Assigning: '.$3.' in '.$url.': '.	$r->print('Assigning: '.$3.' in '.$url.': '.
&Apache::lonnet::assignrole(	&Apache::lonnet::assignrole(
$ENV{'form.cdomain'},$ENV{'form.cuname'},	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},
$url,$3,$end,$start).	$url,$3,$end,$start).
'<br>');	'<br>');
# Handle students differently	# Handle students differently
Line 784 END	Line 740 END
'put:'.$ENV{'course.'.$cid.'.domain'}.':'.	'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
$ENV{'course.'.$cid.'.num'}.':classlist:'.	$ENV{'course.'.$cid.'.num'}.':classlist:'.
&Apache::lonnet::escape(	&Apache::lonnet::escape(
$ENV{'form.cuname'}.':'.	$ENV{'form.ccuname'}.':'.
$ENV{'form.cdomain'} ).'='.	$ENV{'form.ccdomain'} ).'='.
&Apache::lonnet::escape($end.':'.$start),	&Apache::lonnet::escape($end.':'.$start),
$ENV{'course.'.$cid.'.home'})	$ENV{'course.'.$cid.'.home'})
.'<br>');	.'<br>');
Line 803 END	Line 759 END
# Assign the role and report it.	# Assign the role and report it.
$r->print('Assigning: '.$2.' in '.$url.': '.	$r->print('Assigning: '.$2.' in '.$url.': '.
&Apache::lonnet::assignrole(	&Apache::lonnet::assignrole(
$ENV{'form.cdomain'},$ENV{'form.cuname'},	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},
$url,$2,$end,$start)	$url,$2,$end,$start)
.'<br>');	.'<br>');
}	}
Line 826 sub handler {	Line 782 sub handler {
(&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) \|\|	(&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) \|\|
(&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) \|\|	(&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) \|\|
(&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) \|\|	(&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) \|\|
(&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) \|\|	(&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) \|\|
(&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {	(&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {
$r->content_type('text/html');	$r->content_type('text/html');
$r->send_http_header;	$r->send_http_header;
unless ($ENV{'form.phase'}) {	unless ($ENV{'form.phase'}) {
&phase_one($r);	&print_username_entry_form($r);
}	}
if ($ENV{'form.phase'} eq 'two') {	if ($ENV{'form.phase'} eq 'get_user_info') {
&phase_two($r);	&print_user_modification_page($r);
} elsif ($ENV{'form.phase'} eq 'three') {	} elsif ($ENV{'form.phase'} eq 'update_user_data') {
&phase_three($r);	&update_user_data($r);
}	}
} else {	} else {
$ENV{'user.error.msg'}=	$ENV{'user.error.msg'}=
Line 902 ENDTABLE	Line 858 ENDTABLE
}	}
#---------------------------------------------- end functions for &phase_two	#---------------------------------------------- end functions for &phase_two

	#--------------------------------- functions for &phase_two and &phase_three

	#--------------------------end of functions for &phase_two and &phase_three

1;	1;
__END__	__END__

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

Removed from v.1.28
changed lines
	Added in v.1.42