--- loncom/interface/loncreateuser.pm 2001/11/16 07:00:53 1.21
+++ loncom/interface/loncreateuser.pm 2002/02/11 15:37:58 1.25
@@ -1,6 +1,30 @@
# The LearningOnline Network with CAPA
# Create a user
#
+# $Id: loncreateuser.pm,v 1.25 2002/02/11 15:37:58 matthew Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
# (Create a course
# (My Desk
#
@@ -21,8 +45,9 @@
# April Guy Albertelli
# 05/10,10/16 Gerd Kortemeyer
# 11/12,11/13,11/15 Scott Harrison
+# 02/11/02 Matthew Hall
#
-# $Id: loncreateuser.pm,v 1.21 2001/11/16 07:00:53 harris41 Exp $
+# $Id: loncreateuser.pm,v 1.25 2002/02/11 15:37:58 matthew Exp $
###
package Apache::loncreateuser;
@@ -39,7 +64,7 @@ my $authformint;
my $authformfsys;
my $authformloc;
-sub BEGIN {
+BEGIN {
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
my $krbdefdom=$1;
$krbdefdom=~tr/a-z/A-Z/;
@@ -196,7 +221,7 @@ sub phase_two {
$ccuname=~s/\W//g;
$ccdomain=~s/\W//g;
- $r->print(<The LearningOnline Network with CAPA
@@ -226,44 +251,55 @@ sub phase_two {
-
-
');
-
+ } 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
'.
'
Revoke
Role
Extent
'.
'
Start
End
');
- map {
+ 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);
@@ -307,36 +351,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;
}
}
}
my $active=1;
- if (($tend) && ($now>$tend)) { $active=0; }
-
- $r->print('
');
}
my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
@@ -345,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
@@ -430,8 +470,8 @@ $authformcurrent
Enter New Login Data
$authformother
END
- }
- }
+ }
+ } ## End of new user/old user logic
$r->print('