');
-
+ENDNEWUSER
+ } else { # user already exists
+ $r->print(<Change User Privileges
+$forminfo
+
User "$ccuname" in domain $ccdomain
+ENDCHANGEUSER
my $rolesdump=&Apache::lonnet::reply(
"dump:$ccdomain:$ccuname:roles",$uhome);
- unless ($rolesdump eq 'con_lost') {
+ # Build up table of user roles to allow revocation of a role.
+ unless ($rolesdump eq 'con_lost' || $rolesdump =~ m/^error/i) {
my $now=time;
- $r->print('
Revoke Existing Roles
'.
+ $r->print('
Revoke Existing Roles
'.
'
Revoke
Role
Extent
'.
- '
Start
End
');
- map {
+ '
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;
}
+ # Compute the background color based on $area
$bgcol=$1.'_'.$2;
$bgcol=~s/[^8-9b-e]//g;
$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
@@ -331,36 +345,34 @@ 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;
}
}
}
+ $r->print('
');
my $active=1;
- if (($tend) && ($now>$tend)) { $active=0; }
-
- $r->print('
');
}
my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
@@ -369,18 +381,14 @@ 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
-
+ # Check for a bad authentication type
unless ($currentauth=~/^krb4:/ or
$currentauth=~/^unix:/ or
$currentauth=~/^internal:/ or
$currentauth=~/^localauth:/
- ) {
- $r->print(<print(<
$loginscript
ERROR:
@@ -392,14 +400,25 @@ $authformkrb
$authformint
$authformfsys
$authformloc
-END
- }
- else {
+ENDBADAUTH
+ } else {
+ # This user is not allowed to modify the users
+ # authentication scheme, so just notify them of the problem
+ $r->print(<
+$loginscript
+ ERROR:
+This user has an unrecognized authentication scheme ($currentauth).
+Please alert a domain coordinator of this situation.
+
+ENDBADAUTH
+ }
+ } else { # Authentication type is valid
my $authformcurrent='';
- my $authformother='';
+ my $authform_other='';
if ($currentauth=~/^krb4:/) {
$authformcurrent=$authformkrb;
- $authformother=$authformint.$authformfsys.$authformloc;
+ $authform_other=$authformint.$authformfsys.$authformloc;
# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[2\]/login\[3\]/; # fsys
@@ -408,7 +427,7 @@ END
}
elsif ($currentauth=~/^internal:/) {
$authformcurrent=$authformint;
- $authformother=$authformkrb.$authformfsys.$authformloc;
+ $authform_other=$authformkrb.$authformfsys.$authformloc;
# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[2\]/login\[3\]/; # fsys
@@ -417,7 +436,7 @@ END
}
elsif ($currentauth=~/^unix:/) {
$authformcurrent=$authformfsys;
- $authformother=$authformkrb.$authformint.$authformloc;
+ $authform_other=$authformkrb.$authformint.$authformloc;
# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[4\]/; # loc
$loginscript=~s/login\[1\]/login\[3\]/; # int
@@ -426,7 +445,7 @@ END
}
elsif ($currentauth=~/^localauth:/) {
$authformcurrent=$authformloc;
- $authformother=$authformkrb.$authformint.$authformfsys;
+ $authform_other=$authformkrb.$authformint.$authformfsys;
# embarrassing script hack here
$loginscript=~s/login\[3\]/login\[loc\]/; # loc
$loginscript=~s/login\[2\]/login\[4\]/; # fsys
@@ -434,7 +453,7 @@ END
$loginscript=~s/login\[0\]/login\[2\]/; # krb4
$loginscript=~s/login\[loc\]/login\[1\]/; # loc
}
- $authformcurrent=<
* * * WARNING * * *
@@ -443,8 +462,10 @@ END
$authformcurrent
Changing this value will overwrite existing authentication for the user; you should notify the user of this change.
-$authformother
-END
- }
- }
+$authform_other
+ENDOTHERAUTHS
+ }
+ } ## End of "check for bad authentication type" logic
+ } ## End of new user/old user logic
$r->print('