');
-
+ } else { # user already exists
+ $r->print(<Change User Privileges
+$forminfo
+
User "$ccuname" in domain $ccdomain
+ENDCHUSER
my $rolesdump=&Apache::lonnet::reply(
"dump:$ccdomain:$ccuname:roles",$uhome);
+ # Build up table of user roles to allow revocation of a role.
unless ($rolesdump eq 'con_lost') {
my $now=time;
$r->print('
Revoke Existing Roles
'.
@@ -308,20 +325,23 @@ ENDNUSER
'
Start
End
');
foreach (split(/&/,$rolesdump)) {
if ($_!~/^rolesdef\&/) {
-
my ($area,$role)=split(/=/,$_);
my $thisrole=$area;
$area=~s/\_\w\w$//;
- my ($trole,$tend,$tstart)=split(/_/,$role);
+ my ($role_code,$role_end_time,$role_start_time)=split(/_/,$role);
my $bgcol='ffffff';
my $allows=0;
if ($area=~/^\/(\w+)\/(\d\w+)/) {
my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);
my $carea='Course: '.$coursedata{'description'};
$inccourses{$1.'_'.$2}=1;
- if (&Apache::lonnet::allowed('c'.$trole,$1.'/'.$2)) {
+ if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {
$allows=1;
}
+ # What follows is an odd computation. It seems the value
+ # 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=~s/[^8-9b-e]//g;
$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
@@ -331,34 +351,32 @@ ENDNUSER
$area=$carea;
} else {
if ($area=~/^\/(\w+)\//) {
- if (&Apache::lonnet::allowed('c'.$trole,$1)) {
+ if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
$allows=1;
}
} else {
- if (&Apache::lonnet::allowed('c'.$trole,'/')) {
+ if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
$allows=1;
}
}
}
my $active=1;
- if (($tend) && ($now>$tend)) { $active=0; }
-
- $r->print('
\n");
}
}
$r->print('');
@@ -369,12 +387,10 @@ ENDNUSER
my $krbdefdom2=$1;
$loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;
}
- # minor script hack here
-# $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
-
+ # Here is where we'll have to check against the permissions of the
+ # 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
$currentauth=~/^unix:/ or
$currentauth=~/^internal:/ or
@@ -454,8 +470,8 @@ $authformcurrent
Enter New Login Data
$authformother
END
- }
- }
+ }
+ } ## End of new user/old user logic
$r->print('