--- loncom/interface/loncreateuser.pm 2001/02/21 20:38:35 1.3
+++ loncom/interface/loncreateuser.pm 2002/01/06 01:29:52 1.23
@@ -1,6 +1,30 @@
-# The LearningOnline Network
+# The LearningOnline Network with CAPA
# Create a user
#
+# $Id: loncreateuser.pm,v 1.23 2002/01/06 01:29:52 harris41 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
#
@@ -10,20 +34,154 @@
# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
# 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
#
+# YEAR=2001
# 3/1/1 Gerd Kortemeyer)
#
# 3/1 Gerd Kortemeyer)
#
# 2/14 Gerd Kortemeyer)
#
-# 2/14,2/17,2/19,2/20,2/21 Gerd Kortemeyer
+# 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer
+# April Guy Albertelli
+# 05/10,10/16 Gerd Kortemeyer
+# 11/12,11/13,11/15 Scott Harrison
#
+# $Id: loncreateuser.pm,v 1.23 2002/01/06 01:29:52 harris41 Exp $
+###
+
package Apache::loncreateuser;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
+my $loginscript; # piece of javascript used in two separate instances
+my $generalrule;
+my $authformnop;
+my $authformkrb;
+my $authformint;
+my $authformfsys;
+my $authformloc;
+
+BEGIN {
+ $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
+ my $krbdefdom=$1;
+ $krbdefdom=~tr/a-z/A-Z/;
+ $authformnop=(<
+
+Do not change login data
+
+END
+ $authformkrb=(<
+
+Kerberos authenticated with domain
+
+
+END
+ $authformint=(<
+
+Internally authenticated (with initial password
+)
+
+END
+ $authformfsys=(<
+
+Filesystem authenticated (with initial password
+)
+
+END
+ $authformloc=(<
+
+Local Authentication with argument
+
+
+END
+ $loginscript=(<
+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='';
+}
+
+ENDLOGINSCRIPT
+ $generalrule=<
+As a general rule, only authors or co-authors should be filesystem
+authenticated (which allows access to the server filesystem).
+
+END
+}
+
# =================================================================== Phase one
sub phase_one {
@@ -53,6 +211,13 @@ sub phase_two {
my $r=shift;
my $ccuname=$ENV{'form.ccuname'};
my $ccdomain=$ENV{'form.ccdomain'};
+
+ $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
+ my $krbdefdom=$1;
+ $krbdefdom=~tr/a-z/A-Z/;
+
+ my $defdom=$ENV{'user.domain'};
+
$ccuname=~s/\W//g;
$ccdomain=~s/\W//g;
$r->print(<
+
+
ENDENHEAD
my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
my %incdomains;
my %inccourses;
- $incdomains{$ENV{'user.domain'}}=1;
+ map {
+ $incdomains{$_}=1;
+ } values %Apache::lonnet::hostdom;
map {
if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
$inccourses{$1.'_'.$2}=1;
}
} %ENV;
if ($uhome eq 'no_host') {
- $r->print('
New user '.$ccuname.' at '.$ccdomain.'
');
+ $r->print(<New user $ccuname at $ccdomain
+ENDNUSER
+ $r->print(<
+
');
+
my $rolesdump=&Apache::lonnet::reply(
"dump:$ccdomain:$ccuname:roles",$uhome);
unless ($rolesdump eq 'con_lost') {
@@ -125,23 +315,29 @@ ENDENHEAD
my ($trole,$tend,$tstart)=split(/_/,$role);
my $bgcol='ffffff';
my $allows=0;
- if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
+ if ($area=~/^\/(\w+)\/(\d\w+)/) {
my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);
- $area='Course: '.
- $coursedata{'description'}.' Section/Group: '.$3;
+ my $carea='Course: '.$coursedata{'description'};
$inccourses{$1.'_'.$2}=1;
- if (&Apache::lonnet::allowed('c'.$trole,$1.'_'.$2)) {
+ if (&Apache::lonnet::allowed('c'.$trole,$1.'/'.$2)) {
$allows=1;
}
$bgcol=$1.'_'.$2;
$bgcol=~s/[^8-9b-e]//g;
$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
+ if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
+ $carea.=' Section/Group: '.$3;
+ }
+ $area=$carea;
} else {
- if ($1) {
- $incdomains{$1}=1;
+ if ($area=~/^\/(\w+)\//) {
if (&Apache::lonnet::allowed('c'.$trole,$1)) {
$allows=1;
}
+ } else {
+ if (&Apache::lonnet::allowed('c'.$trole,'/')) {
+ $allows=1;
+ }
}
}
@@ -167,22 +363,163 @@ ENDENHEAD
} split(/&/,$rolesdump);
$r->print('');
}
+ my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
+ if ($currentauth=~/^krb4:/) {
+ $currentauth=~/^krb4:(.*)/;
+ 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
+
+ unless ($currentauth=~/^krb4:/ or
+ $currentauth=~/^unix:/ or
+ $currentauth=~/^internal:/ or
+ $currentauth=~/^localauth:/
+ ) {
+ $r->print(<
+$loginscript
+ERROR:
+This user has an unrecognized authentication scheme ($currentauth).
+Please specify login data below.
+
Login Data
+$generalrule
+$authformkrb
+$authformint
+$authformfsys
+$authformloc
+END
+ }
+ else {
+ my $authformcurrent='';
+ my $authformother='';
+ if ($currentauth=~/^krb4:/) {
+ $authformcurrent=$authformkrb;
+ $authformother=$authformint.$authformfsys.$authformloc;
+ # embarrassing 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
+ }
+ elsif ($currentauth=~/^internal:/) {
+ $authformcurrent=$authformint;
+ $authformother=$authformkrb.$authformfsys.$authformloc;
+ # embarrassing script hack here
+ $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:/) {
+ $authformcurrent=$authformfsys;
+ $authformother=$authformkrb.$authformint.$authformloc;
+ # embarrassing script hack here
+ $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:/) {
+ $authformcurrent=$authformloc;
+ $authformother=$authformkrb.$authformint.$authformfsys;
+ # embarrassing script hack here
+ $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=<
+
+
* * * WARNING * * *
+
* * * WARNING * * *
+
+
$authformcurrent
+
Changing this value will overwrite existing authentication for the user; you should notify the user of this change.
+
+END
+ $r->print(<
+$loginscript
+
Change Current Login Data
+$generalrule
+$authformnop
+$authformcurrent
+
Enter New Login Data
+$authformother
+END
+ }
}
- $r->print('
Add Roles
System Level
');
- $r->print('
Domain Level
');
+ $r->print('
Add Roles
');
+#
+# Co-Author
+#
+
+ if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {
+ my $cuname=$ENV{'user.name'};
+ my $cudom=$ENV{'user.domain'};
+ $r->print(<Construction Space
+
');
map {
my $thiscourse=$_;
+ my $protectedcourse=$_;
+ $thiscourse=~s:_:/:g;
my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
my $area=$coursedata{'description'};
my $bgcol=$thiscourse;
@@ -191,28 +528,183 @@ ENDENHEAD
map {
if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
my $plrole=&Apache::lonnet::plaintext($_);
- $r->print(<print("
-
+
$plrole
$area
-
-
+
");
+ if ($_ ne 'cc') {
+ $r->print("");
+ } else { $r->print(" "); }
+ $r->print(<Set Start Date
-
+"javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date
+"javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date