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.25 and 1.26

version 1.25, 2002/02/11 15:37:58	version 1.26, 2002/02/11 21:25:07
Line 207 ENDDOCUMENT	Line 207 ENDDOCUMENT
}	}

# =================================================================== Phase two	# =================================================================== Phase two

sub phase_two {	sub phase_two {
my $r=shift;	my $r=shift;
my $ccuname=$ENV{'form.ccuname'};	my $ccuname=$ENV{'form.ccuname'};
Line 276 ENDFORMINFO	Line 275 ENDFORMINFO
}	}
}	}
if ($uhome eq 'no_host') {	if ($uhome eq 'no_host') {
$r->print(<<ENDNUSER);	$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>
ENDNUSER
$r->print(<<ENDNUSER);
$loginscript	$loginscript
<input type='hidden' name='makeuser' value='1' />	<input type='hidden' name='makeuser' value='1' />
<h3>Personal Data</h3>	<h3>Personal Data</h3>
Line 307 $authformkrb	Line 304 $authformkrb
$authformint	$authformint
$authformfsys	$authformfsys
$authformloc	$authformloc
ENDNUSER	ENDNEWUSER
} else { # user already exists	} else { # user already exists
$r->print(<<ENDCHUSER);	$r->print(<<ENDCHANGEUSER);
$dochead	$dochead
<h1>Change User Privileges</h1>	<h1>Change User Privileges</h1>
$forminfo	$forminfo
<h2>User "$ccuname" in domain $ccdomain </h2>	<h2>User "$ccuname" in domain $ccdomain </h2>
ENDCHUSER	ENDCHANGEUSER
my $rolesdump=&Apache::lonnet::reply(	my $rolesdump=&Apache::lonnet::reply(
"dump:$ccdomain:$ccuname:roles",$uhome);	"dump:$ccdomain:$ccuname:roles",$uhome);
# Build up table of user roles to allow revocation of a role.	# Build up table of user roles to allow revocation of a role.
unless ($rolesdump eq 'con_lost') {	unless ($rolesdump eq 'con_lost' \|\| $rolesdump =~ m/^error/i) {
my $now=time;	my $now=time;
$r->print('<h4>Revoke Existing Roles</h4>'.	$r->print('<hr /><h3>Revoke Existing Roles</h3>'.
'<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.	'<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.
'<th>Start</th><th>End</th>');	'<th>Start</th><th>End</th>');
foreach (split(/&/,$rolesdump)) {	foreach (split(/&/,$rolesdump)) {
if ($_!~/^rolesdef\&/) {	if ($_!~/^rolesdef\&/) {
my ($area,$role)=split(/=/,$_);	my ($area,$role)=split(/=/,$_);
Line 338 ENDCHUSER	Line 335 ENDCHUSER
if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {	if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {
$allows=1;	$allows=1;
}	}
# What follows is an odd computation. It seems the value	# Compute the background color based on $area
# of the $area variable above is used to compute the
# background color. This makes sense, but I can't make
# heads or tail of the computation at this point..
$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);
Line 361 ENDCHUSER	Line 355 ENDCHUSER
}	}
}	}

	$r->print('<tr bgcolor=#"'.$bgcol.'"><td>');
my $active=1;	my $active=1;
if (($role_end_time) && ($now>$role_end_time)) { $active=0; }	if (($role_end_time) && ($now>$role_end_time)) { $active=0; }
$r->print('<tr bgcolor=#"'.$bgcol.'"><td>');
if (!($active) && ($allows)) {	if (!($active) && ($allows)) {
$r->print('<input type=checkbox name="rev:'.$thisrole.'">');	$r->print('<input type=checkbox name="rev:'.$thisrole.'">');
} else {	} else {
Line 387 ENDCHUSER	Line 381 ENDCHUSER
my $krbdefdom2=$1;	my $krbdefdom2=$1;
$loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;	$loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;
}	}
# Here is where we'll have to check against the permissions of the	# Check for a bad authentication type
# user attempting to modify this users data. Only users with
# MAU (Modify Authentication User) permissions should be able to
# make these changes. I think a subroutine would be in order here.
unless ($currentauth=~/^krb4:/ or	unless ($currentauth=~/^krb4:/ or
$currentauth=~/^unix:/ or	$currentauth=~/^unix:/ or
$currentauth=~/^internal:/ or	$currentauth=~/^internal:/ or
$currentauth=~/^localauth:/	$currentauth=~/^localauth:/
) {	) { # bad authentication scheme
$r->print(<<END);	if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
	$r->print(<<ENDBADAUTH);
<hr />	<hr />
$loginscript	$loginscript
<font color='#ff0000'>ERROR:</font>	<font color='#ff0000'>ERROR:</font>
Line 408 $authformkrb	Line 400 $authformkrb
$authformint	$authformint
$authformfsys	$authformfsys
$authformloc	$authformloc
END	ENDBADAUTH
}	} else {
else {	# This user is not allowed to modify the users
	# authentication scheme, so just notify them of the problem
	$r->print(<<ENDBADAUTH);
	<hr />
	$loginscript
	<font color="#ff0000"> ERROR: </font>
	This user has an unrecognized authentication scheme ($currentauth).
	Please alert a domain coordinator of this situation.
	<hr />
	ENDBADAUTH
	}
	} else { # Authentication type is valid
my $authformcurrent='';	my $authformcurrent='';
my $authformother='';	my $authform_other='';
if ($currentauth=~/^krb4:/) {	if ($currentauth=~/^krb4:/) {
$authformcurrent=$authformkrb;	$authformcurrent=$authformkrb;
$authformother=$authformint.$authformfsys.$authformloc;	$authform_other=$authformint.$authformfsys.$authformloc;
# embarrassing script hack here	# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[4\]/; # loc	$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[2\]/login\[3\]/; # fsys	$loginscript=~s/login\[2\]/login\[3\]/; # fsys
Line 424 END	Line 427 END
}	}
elsif ($currentauth=~/^internal:/) {	elsif ($currentauth=~/^internal:/) {
$authformcurrent=$authformint;	$authformcurrent=$authformint;
$authformother=$authformkrb.$authformfsys.$authformloc;	$authform_other=$authformkrb.$authformfsys.$authformloc;
# embarrassing script hack here	# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[4\]/; # loc	$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[2\]/login\[3\]/; # fsys	$loginscript=~s/login\[2\]/login\[3\]/; # fsys
Line 433 END	Line 436 END
}	}
elsif ($currentauth=~/^unix:/) {	elsif ($currentauth=~/^unix:/) {
$authformcurrent=$authformfsys;	$authformcurrent=$authformfsys;
$authformother=$authformkrb.$authformint.$authformloc;	$authform_other=$authformkrb.$authformint.$authformloc;
# embarrassing script hack here	# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[4\]/; # loc	$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[1\]/login\[3\]/; # int	$loginscript=~s/login\[1\]/login\[3\]/; # int
Line 442 END	Line 445 END
}	}
elsif ($currentauth=~/^localauth:/) {	elsif ($currentauth=~/^localauth:/) {
$authformcurrent=$authformloc;	$authformcurrent=$authformloc;
$authformother=$authformkrb.$authformint.$authformfsys;	$authform_other=$authformkrb.$authformint.$authformfsys;
# embarrassing script hack here	# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[loc\]/; # loc	$loginscript=~s/login\[3\]/login\[loc\]/; # loc
$loginscript=~s/login\[2\]/login\[4\]/; # fsys	$loginscript=~s/login\[2\]/login\[4\]/; # fsys
Line 450 END	Line 453 END
$loginscript=~s/login\[0\]/login\[2\]/; # krb4	$loginscript=~s/login\[0\]/login\[2\]/; # krb4
$loginscript=~s/login\[loc\]/login\[1\]/; # loc	$loginscript=~s/login\[loc\]/login\[1\]/; # loc
}	}
$authformcurrent=<<END;	$authformcurrent=<<ENDCURRENTAUTH;
<table border='1'>	<table border='1'>
<tr>	<tr>
<td><font color='#ff0000'>* * * WARNING * * *</font></td>	<td><font color='#ff0000'>* * * WARNING * * *</font></td>
Line 459 END	Line 462 END
<tr><td bgcolor='#cbbcbb'>$authformcurrent</td>	<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>	<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>
END	ENDCURRENTAUTH
$r->print(<<END);	if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
	# Current user has login modification privileges
	$r->print(<<ENDOTHERAUTHS);
<hr />	<hr />
$loginscript	$loginscript
<h3>Change Current Login Data</h3>	<h3>Change Current Login Data</h3>
Line 468 $generalrule	Line 473 $generalrule
$authformnop	$authformnop
$authformcurrent	$authformcurrent
<h3>Enter New Login Data</h3>	<h3>Enter New Login Data</h3>
$authformother	$authform_other
END	ENDOTHERAUTHS
}	}
	} ## 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>Add Roles</h3>');
#	#
Line 529 ENDDROW	Line 535 ENDDROW
#	#
# Course level	# Course level
#	#
$r->print('<h4>Course Level</h4>'.	$r->print(&course_level_table(%inccourses));
'<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.	$r->print("<hr /><input type=submit value=\"Modify User\">\n");
'<th>Group/Section</th><th>Start</th><th>End</th></tr>');	$r->print("</form></body></html>");
foreach (sort( keys(%inccourses))) {
my $thiscourse=$_;
my $protectedcourse=$_;
$thiscourse=~s:_:/:g;
my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
my $area=$coursedata{'description'};
my $bgcol=$thiscourse;
$bgcol=~s/[^8-9b-e]//g;
$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
foreach ('st','ta','ep','ad','in','cc') {
if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
my $plrole=&Apache::lonnet::plaintext($_);
$r->print("
<tr bgcolor=#$bgcol>
<td><input type=checkbox name=\"act_$protectedcourse\_$_\"></td>
<td>$plrole</td>
<td>$area</td>
<td>");
if ($_ ne 'cc') {
$r->print("<input type=text size=5 name=\"sec_$protectedcourse\_$_\">");
} else { $r->print("&nbsp"); }
$r->print(<<ENDROW);
<td><input type=hidden name="start_$protectedcourse\_$_" value=''>
<a href=
"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
<td><input type=hidden name="end_$protectedcourse\_$_" value=''>
<a href=
"javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
</tr>
ENDROW
}
}
}
$r->print('</table>');
$r->print('<input type=submit value="Modify User">');
$r->print('</form></body></html>');
}	}

# ================================================================= Phase Three	# ================================================================= Phase Three

sub phase_three {	sub phase_three {
my $r=shift;	my $r=shift;
$r->print(<<ENDTHREEHEAD);	$r->print(<<ENDTHREEHEAD);
Line 755 sub handler {	Line 724 sub handler {
return OK;	return OK;
}	}


	sub course_level_table {
	my %inccourses = @_;
	my $table = '';
	foreach (sort( keys(%inccourses))) {
	my $thiscourse=$_;
	my $protectedcourse=$_;
	$thiscourse=~s:_:/:g;
	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
	my $area=$coursedata{'description'};
	my $bgcol=$thiscourse;
	$bgcol=~s/[^8-9b-e]//g;
	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
	foreach ('st','ta','ep','ad','in','cc') {
	if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
	my $plrole=&Apache::lonnet::plaintext($_);
	$table .= <<ENDEXTENT;
	<tr bgcolor="#$bgcol">
	<td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
	<td>$plrole</td>
	<td>$area</td>
	ENDEXTENT
	if ($_ ne 'cc') {
	$table .= <<ENDSECTION;
	<td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td>
	ENDSECTION
	} else {
	$table .= <<ENDSECTION;
	<td>&nbsp</td>
	ENDSECTION
	}
	$table .= <<ENDTIMEENTRY;
	<td><input type=hidden name="start_$protectedcourse\_$_" value=''>
	<a href=
	"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
	<td><input type=hidden name="end_$protectedcourse\_$_" value=''>
	<a href=
	"javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
	ENDTIMEENTRY
	$table.= "</tr>\n";
	}
	}
	}
	return '' if ($table eq ''); # return nothing if there is nothing
	# in the table
	my $result = <<ENDTABLE;
	<h4>Course Level</h4>
	<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
	<th>Group/Section</th><th>Start</th><th>End</th></tr>
	$table
	</table>
	ENDTABLE
	return $result;
	}

1;	1;
__END__	__END__

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

Removed from v.1.25
changed lines
	Added in v.1.26