--- loncom/interface/loncreateuser.pm 2007/03/12 17:06:59 1.148
+++ loncom/interface/loncreateuser.pm 2016/11/21 23:13:42 1.424
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Create a user
#
-# $Id: loncreateuser.pm,v 1.148 2007/03/12 17:06:59 albertel Exp $
+# $Id: loncreateuser.pm,v 1.424 2016/11/21 23:13:42 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,11 +33,13 @@ package Apache::loncreateuser;
=head1 NAME
-Apache::loncreateuser - handler to create users and custom roles
+Apache::loncreateuser.pm
=head1 SYNOPSIS
-Apache::loncreateuser provides an Apache handler for creating users,
+ Handler to create users and custom roles
+
+ Provides an Apache handler for creating users,
editing their login parameters, roles, and removing roles, and
also creating and assigning custom roles.
@@ -49,13 +51,14 @@ In LON-CAPA, roles are actually collecti
Assistant", "Course Coordinator", and other such roles are really just
collection of privileges that are useful in many circumstances.
-Creating custom roles can be done by the Domain Coordinator through
-the Create User functionality. That screen will show all privileges
-that can be assigned to users. For a complete list of privileges,
-please see C.
+Custom roles can be defined by a Domain Coordinator, Course Coordinator
+or Community Coordinator via the Manage User functionality.
+The custom role editor screen will show all privileges which can be
+assigned to users. For a complete list of privileges, please see
+C.
-Custom role definitions are stored in the C file of the role
-author.
+Custom role definitions are stored in the C file of the creator
+of the role.
=cut
@@ -65,11 +68,11 @@ use Apache::lonnet;
use Apache::loncommon;
use Apache::lonlocal;
use Apache::longroup;
-use lib '/home/httpd/lib/perl/';
+use Apache::lonuserutils;
+use Apache::loncoursequeueadmin;
use LONCAPA qw(:DEFAULT :match);
my $loginscript; # piece of javascript used in two separate instances
-my $generalrule;
my $authformnop;
my $authformkrb;
my $authformint;
@@ -77,125 +80,934 @@ my $authformfsys;
my $authformloc;
sub initialize_authen_forms {
- my ($krbdefdom)=( $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/);
- $krbdefdom= uc($krbdefdom);
- my %param = ( formname => 'document.cu',
- kerb_def_dom => $krbdefdom
- );
-# no longer static due to configurable kerberos defaults
-# $loginscript = &Apache::loncommon::authform_header(%param);
- $generalrule = &Apache::loncommon::authform_authorwarning(%param);
+ my ($dom,$formname,$curr_authtype,$mode) = @_;
+ my ($krbdef,$krbdefdom) = &Apache::loncommon::get_kerberos_defaults($dom);
+ my %param = ( formname => $formname,
+ kerb_def_dom => $krbdefdom,
+ kerb_def_auth => $krbdef,
+ domain => $dom,
+ );
+ my %abv_auth = &auth_abbrev();
+ if ($curr_authtype =~ /^(krb4|krb5|internal|localauth|unix):(.*)$/) {
+ my $long_auth = $1;
+ my $curr_autharg = $2;
+ my %abv_auth = &auth_abbrev();
+ $param{'curr_authtype'} = $abv_auth{$long_auth};
+ if ($long_auth =~ /^krb(4|5)$/) {
+ $param{'curr_kerb_ver'} = $1;
+ $param{'curr_autharg'} = $curr_autharg;
+ }
+ if ($mode eq 'modifyuser') {
+ $param{'mode'} = $mode;
+ }
+ }
+ $loginscript = &Apache::loncommon::authform_header(%param);
+ $authformkrb = &Apache::loncommon::authform_kerberos(%param);
$authformnop = &Apache::loncommon::authform_nochange(%param);
-# no longer static due to configurable kerberos defaults
-# $authformkrb = &Apache::loncommon::authform_kerberos(%param);
$authformint = &Apache::loncommon::authform_internal(%param);
$authformfsys = &Apache::loncommon::authform_filesystem(%param);
$authformloc = &Apache::loncommon::authform_local(%param);
}
+sub auth_abbrev {
+ my %abv_auth = (
+ krb5 => 'krb',
+ krb4 => 'krb',
+ internal => 'int',
+ localauth => 'loc',
+ unix => 'fsys',
+ );
+ return %abv_auth;
+}
-# ======================================================= Existing Custom Roles
+# ====================================================
-sub my_custom_roles {
- my %returnhash=();
- my %rolehash=&Apache::lonnet::dump('roles');
- foreach my $key (keys %rolehash) {
- if ($key=~/^rolesdef\_(\w+)$/) {
- $returnhash{$1}=$1;
- }
+sub user_quotas {
+ my ($ccuname,$ccdomain) = @_;
+ my %lt = &Apache::lonlocal::texthash(
+ 'usrt' => "User Tools",
+ 'cust' => "Custom quota",
+ 'chqu' => "Change quota",
+ );
+
+ my $quota_javascript = <<"END_SCRIPT";
+
+END_SCRIPT
+ my $longinsttype;
+ my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($ccdomain);
+ my $output = $quota_javascript."\n".
+ '
'.$lt{'usrt'}.'
'."\n".
+ &Apache::loncommon::start_data_table();
+
+ if ((&Apache::lonnet::allowed('mut',$ccdomain)) ||
+ (&Apache::lonnet::allowed('udp',$ccdomain))) {
+ $output .= &build_tools_display($ccuname,$ccdomain,'tools');
+ }
+
+ my %titles = &Apache::lonlocal::texthash (
+ portfolio => "Disk space allocated to user's portfolio files",
+ author => "Disk space allocated to user's Authoring Space (if role assigned)",
+ );
+ foreach my $name ('portfolio','author') {
+ my ($currquota,$quotatype,$inststatus,$defquota) =
+ &Apache::loncommon::get_user_quota($ccuname,$ccdomain,$name);
+ if ($longinsttype eq '') {
+ if ($inststatus ne '') {
+ if ($usertypes->{$inststatus} ne '') {
+ $longinsttype = $usertypes->{$inststatus};
+ }
+ }
+ }
+ my ($showquota,$custom_on,$custom_off,$defaultinfo);
+ $custom_on = ' ';
+ $custom_off = ' checked="checked" ';
+ if ($quotatype eq 'custom') {
+ $custom_on = $custom_off;
+ $custom_off = ' ';
+ $showquota = $currquota;
+ if ($longinsttype eq '') {
+ $defaultinfo = &mt('For this user, the default quota would be [_1]'
+ .' MB.',$defquota);
+ } else {
+ $defaultinfo = &mt("For this user, the default quota would be [_1]".
+ " MB, as determined by the user's institutional".
+ " affiliation ([_2]).",$defquota,$longinsttype);
+ }
+ } else {
+ if ($longinsttype eq '') {
+ $defaultinfo = &mt('For this user, the default quota is [_1]'
+ .' MB.',$defquota);
+ } else {
+ $defaultinfo = &mt("For this user, the default quota of [_1]".
+ " MB, is determined by the user's institutional".
+ " affiliation ([_2]).",$defquota,$longinsttype);
+ }
+ }
+
+ if (&Apache::lonnet::allowed('mpq',$ccdomain)) {
+ $output .= '
');
+ } else {
+ $r->print($response.'');
+ }
+}
- my $defdom=$env{'request.role.domain'};
+sub print_user_query_page {
+ my ($r,$caller,$brcrum) = @_;
+# FIXME - this is for a network-wide name search (similar to catalog search)
+# To use frames with similar behavior to catalog/portfolio search.
+# To be implemented.
+ return;
+}
- my ($krbdef,$krbdefdom) =
- &Apache::loncommon::get_kerberos_defaults($defdom);
+sub print_user_modification_page {
+ my ($r,$ccuname,$ccdomain,$srch,$response,$context,$permission,$crstype,
+ $brcrum,$showcredits) = @_;
+ if (($ccuname eq '') || ($ccdomain eq '')) {
+ my $usermsg = &mt('No username and/or domain provided.');
+ $env{'form.phase'} = '';
+ &print_username_entry_form($r,$context,$usermsg,'','',$crstype,$brcrum);
+ return;
+ }
+ my ($form,$formname);
+ if ($env{'form.action'} eq 'singlestudent') {
+ $form = 'document.enrollstudent';
+ $formname = 'enrollstudent';
+ } else {
+ $form = 'document.cu';
+ $formname = 'cu';
+ }
+ my %abv_auth = &auth_abbrev();
+ my (%rulematch,%inst_results,$newuser,%alerts,%curr_rules,%got_rules);
+ my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
+ if ($uhome eq 'no_host') {
+ my $usertype;
+ my ($rules,$ruleorder) =
+ &Apache::lonnet::inst_userrules($ccdomain,'username');
+ $usertype =
+ &Apache::lonuserutils::check_usertype($ccdomain,$ccuname,$rules,
+ \%curr_rules,\%got_rules);
+ my $cancreate =
+ &Apache::lonuserutils::can_create_user($ccdomain,$context,
+ $usertype);
+ if (!$cancreate) {
+ my $helplink = 'javascript:helpMenu('."'display'".')';
+ my %usertypetext = (
+ official => 'institutional',
+ unofficial => 'non-institutional',
+ );
+ my $response;
+ if ($env{'form.origform'} eq 'crtusername') {
+ $response = ''.
+ &mt('No match found for the username [_1] in LON-CAPA domain: [_2]',
+ ''.$ccuname.'',$ccdomain).
+ ' ';
+ }
+ $response .= '
'
+ .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
+ .' ';
+ if ($context eq 'domain') {
+ $response .= &mt('Please contact a [_1] for assistance.',
+ &Apache::lonnet::plaintext('dc'));
+ } else {
+ $response .= &mt('Please contact the [_1]helpdesk[_2] for assistance.'
+ ,'','');
+ }
+ $response .= '
';
+ $env{'form.phase'} = '';
+ &print_username_entry_form($r,$context,$response,undef,undef,$crstype,$brcrum);
+ return;
+ }
+ $newuser = 1;
+ my $checkhash;
+ my $checks = { 'username' => 1 };
+ $checkhash->{$ccuname.':'.$ccdomain} = { 'newuser' => $newuser };
+ &Apache::loncommon::user_rule_check($checkhash,$checks,
+ \%alerts,\%rulematch,\%inst_results,\%curr_rules,\%got_rules);
+ if (ref($alerts{'username'}) eq 'HASH') {
+ if (ref($alerts{'username'}{$ccdomain}) eq 'HASH') {
+ my $domdesc =
+ &Apache::lonnet::domain($ccdomain,'description');
+ if ($alerts{'username'}{$ccdomain}{$ccuname}) {
+ my $userchkmsg;
+ if (ref($curr_rules{$ccdomain}) eq 'HASH') {
+ $userchkmsg =
+ &Apache::loncommon::instrule_disallow_msg('username',
+ $domdesc,1).
+ &Apache::loncommon::user_rule_formats($ccdomain,
+ $domdesc,$curr_rules{$ccdomain}{'username'},
+ 'username');
+ }
+ $env{'form.phase'} = '';
+ &print_username_entry_form($r,$context,$userchkmsg,undef,undef,$crstype,$brcrum);
+ return;
+ }
+ }
+ }
+ } else {
+ $newuser = 0;
+ }
+ if ($response) {
+ $response = ' '.$response;
+ }
- my %param = ( formname => 'document.cu',
- kerb_def_dom => $krbdefdom,
- kerb_def_auth => $krbdef
- );
- $loginscript = &Apache::loncommon::authform_header(%param);
- $authformkrb = &Apache::loncommon::authform_kerberos(%param);
-
- $ccuname =&LONCAPA::clean_username($ccuname);
- $ccdomain=&LONCAPA::clean_domain($ccdomain);
my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
my $dc_setcourse_code = '';
my $nondc_setsection_code = '';
-
my %loaditem;
- my $groupslist;
- my %curr_groups = &Apache::longroup::coursegroups();
- if (%curr_groups) {
- $groupslist = join('","',sort(keys(%curr_groups)));
- $groupslist = '"'.$groupslist.'"';
- }
-
- if ($env{'request.role'} =~ m-^dc\./($match_domain)/$-) {
- my $dcdom = $1;
- $loaditem{'onload'} = "document.cu.coursedesc.value='';";
- my @rolevals = ('st','ta','ep','in','cc');
- my (@crsroles,@grproles);
- for (my $i=0; $i<@rolevals; $i++) {
- $crsroles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Course');
- $grproles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Group');
- }
- my $rolevalslist = join('","',@rolevals);
- my $crsrolenameslist = join('","',@crsroles);
- my $grprolenameslist = join('","',@grproles);
- my $pickcrsfirst = '<--'.&mt('Pick course first');
- my $pickgrpfirst = '<--'.&mt('Pick group first');
- $dc_setcourse_code = <<"ENDSCRIPT";
- function setCourse() {
- var course = document.cu.dccourse.value;
- if (course != "") {
- if (document.cu.dcdomain.value != document.cu.origdom.value) {
- alert("You must select a course in the current domain");
- return;
- }
- var userrole = document.cu.role.options[document.cu.role.selectedIndex].value
- var section="";
- var numsections = 0;
- var newsecs = new Array();
- for (var i=0; i "javascript:backPage($form)",
+ text => $breadcrumb_text{'search'},
+ faq => 282,
+ bug => 'Instructor Interface',});
+ if ($env{'form.phase'} eq 'userpicked') {
+ push(@{$brcrum},
+ {href => "javascript:backPage($form,'get_user_info','select')",
+ text => $breadcrumb_text{'userpicked'},
+ faq => 282,
+ bug => 'Instructor Interface',});
+ }
+ push(@{$brcrum},
+ {href => "javascript:backPage($form,'$env{'form.phase'}','modify')",
+ text => $breadcrumb_text{'modify'},
+ faq => 282,
+ bug => 'Instructor Interface',
+ help => $helpitem});
+ my $args = {'add_entries' => \%loaditem,
+ 'bread_crumbs' => $brcrum,
+ 'bread_crumbs_component' => 'User Management'};
+ if ($env{'form.popup'}) {
+ $args->{'no_nav_bar'} = 1;
+ }
+ my $start_page =
+ &Apache::loncommon::start_page('User Management',$js,$args);
+
+ my $forminfo =<<"ENDFORMINFO";
+
');
+ return;
+}
- function getIndex(caller) {
- for (var i=0;i 0) {
- if (document.cu.elements[i+1].value != "" && document.cu.elements[i+1].value != null) {
- sections = sections + "," + document.cu.elements[i+1].value;
- }
- }
- else {
- sections = document.cu.elements[i+1].value;
- }
- var newsecs = document.cu.elements[i+1].value;
- var numsplit;
- if (newsecs != null && newsecs != "") {
- numsplit = newsecs.split(/,/g);
- numsec = numsec + numsplit.length;
- }
-
- if ((role == 'st') && (numsec > 1)) {
- alert("In each course, each user may only have one student role at a time. You had selected "+numsec+" sections.\\nPlease modify your selections so they include no more than one section.")
- return;
- }
- else if (numsplit != null) {
- for (var j=0; j'.&mt('Starting and Ending Dates').''."\n".
+ &Apache::lonuserutils::date_setting_table(undef,undef,$context,
+ undef,$formname,$permission);
+ my $rowtitle = 'Section';
+ my $secbox = '
'.&mt('Section and Credits').'
'."\n".
+ &Apache::lonuserutils::section_picker($cdom,$cnum,'st',$rowtitle,
+ $permission,$context,'',$crstype,
+ $showcredits,$credits);
+ my $output = $date_table.$secbox;
+ return $output;
+}
+
+sub validation_javascript {
+ my ($context,$ccdomain,$pjump_def,$crstype,$groupslist,$newuser,$formname,
+ $loaditem) = @_;
+ my $dc_setcourse_code = '';
+ my $nondc_setsection_code = '';
+ if ($context eq 'domain') {
+ my $dcdom = $env{'request.role.domain'};
+ $loaditem->{'onload'} = "document.cu.coursedesc.value='';";
+ $dc_setcourse_code =
+ &Apache::lonuserutils::dc_setcourse_js('cu','singleuser',$context);
+ } else {
+ my $checkauth;
+ if (($newuser) || (&Apache::lonnet::allowed('mau',$ccdomain))) {
+ $checkauth = 1;
+ }
+ if ($context eq 'course') {
+ $nondc_setsection_code =
+ &Apache::lonuserutils::setsections_javascript($formname,$groupslist,
+ undef,$checkauth,
+ $crstype);
+ }
+ if ($checkauth) {
+ $nondc_setsection_code .=
+ &Apache::lonuserutils::verify_authen($formname,$context);
+ }
}
my $js = &user_modification_js($pjump_def,$dc_setcourse_code,
$nondc_setsection_code,$groupslist);
- my $start_page =
- &Apache::loncommon::start_page('Create Users, Change User Privileges',
- $js,{'add_entries' => \%loaditem,});
+ my ($jsback,$elements) = &crumb_utilities();
+ $js .= "\n".
+ ''."\n";
+ return $js;
+}
- my $forminfo =<<"ENDFORMINFO";
-
'.
-&Apache::loncommon::end_data_table_header_row());
- foreach my $type ('Construction Space','Course','Group','Domain','System','Unknown') {
- if ($output{$type}) {
- $r->print($output{$type}."\n");
- }
- }
- $r->print(&Apache::loncommon::end_data_table());
- }
- } # End of unless
- my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
- if ($currentauth=~/^krb(4|5):/) {
- $currentauth=~/^krb(4|5):(.*)/;
- my $krbdefdom=$2;
- my %param = ( formname => 'document.cu',
- kerb_def_dom => $krbdefdom
- );
- $loginscript = &Apache::loncommon::authform_header(%param);
- }
- # Check for a bad authentication type
- unless ($currentauth=~/^krb(4|5):/ or
- $currentauth=~/^unix:/ or
- $currentauth=~/^internal:/ or
- $currentauth=~/^localauth:/
- ) { # bad authentication scheme
- if (&Apache::lonnet::allowed('mau',$ccdomain)) {
- &initialize_authen_forms();
- my %lt=&Apache::lonlocal::texthash(
- 'err' => "ERROR",
- 'uuas' => "This user has an unrecognized authentication scheme",
- 'sldb' => "Please specify login data below",
- 'ld' => "Login Data"
- );
- $r->print(<
-
-$lt{'err'}:
-$lt{'uuas'} ($currentauth). $lt{'sldb'}.
-
$lt{'ld'}
-
$generalrule
-
$authformkrb
-
$authformint
-
$authformfsys
-
$authformloc
-ENDBADAUTH
- } else {
- # This user is not allowed to modify the user's
- # authentication scheme, so just notify them of the problem
- my %lt=&Apache::lonlocal::texthash(
- 'err' => "ERROR",
- 'uuas' => "This user has an unrecognized authentication scheme",
- 'adcs' => "Please alert a domain coordinator of this situation"
- );
- $r->print(<
- $lt{'err'}:
-$lt{'uuas'} ($currentauth). $lt{'adcs'}.
-
-ENDBADAUTH
+ if ($croletitle) {
+ if (&Apache::lonnet::allowed('ccr',$coursedom.'/'.$coursedir)) {
+ $allowed=1;
+ $thisrole.='.'.$role_code;
+ }
}
- } else { # Authentication type is valid
- my $authformcurrent='';
- my $authform_other='';
- &initialize_authen_forms();
- if ($currentauth=~/^krb(4|5):/) {
- $authformcurrent=$authformkrb;
- $authform_other="
";
- }
- $authformcurrent.=' (will override current values) ';
- if (&Apache::lonnet::allowed('mau',$ccdomain)) {
- # Current user has login modification privileges
- my %lt=&Apache::lonlocal::texthash(
- 'ccld' => "Change Current Login Data",
- 'enld' => "Enter New Login Data"
- );
- $r->print(<
-
-
$lt{'ccld'}
-
$generalrule
-
$authformnop
-
$authformcurrent
-
$lt{'enld'}
-$authform_other
-ENDOTHERAUTHS
- } else {
- if (&Apache::lonnet::allowed('mau',$env{'request.role.domain'})) {
- my %lt=&Apache::lonlocal::texthash(
- 'ccld' => "Change Current Login Data",
- 'yodo' => "You do not have privileges to modify the authentication configuration for this user.",
- 'ifch' => "If a change is required, contact a domain coordinator for the domain",
- );
- $r->print(<
-
$lt{'ccld'}
-$lt{'yodo'} $lt{'ifch'}: $ccdomain
-ENDNOPRIV
- }
+ if ($area=~m{^/($match_domain/$match_courseid/(\w+))}) {
+ $csec = $2;
+ $carea.=' '.&mt('Section: [_1]',$csec);
+ $sortkey.="\0$csec";
+ if (!$allowed) {
+ if ($env{'request.course.sec'} eq $csec) {
+ if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
+ $allowed = 1;
+ }
+ }
+ }
}
- if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) {
- # Current user has quota modification privileges
- $r->print(&portfolio_quota($ccuname,$ccdomain));
+ $area=$carea;
+ } else {
+ $sortkey.="\0".$area;
+ # Determine if current user is able to revoke privileges
+ if ($area=~m{^/($match_domain)/}) {
+ if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
+ (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
+ $allowed=1;
+ }
+ if (((&Apache::lonnet::allowed('dro',$1)) ||
+ (&Apache::lonnet::allowed('dro',$ccdomain))) &&
+ ($role_code ne 'dc')) {
+ $delallowed=1;
+ }
+ } else {
+ if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
+ $allowed=1;
+ }
}
- } ## End of "check for bad authentication type" logic
- } ## End of new user/old user logic
- $r->print('
'.
&Apache::loncommon::end_data_table_row();
}
- }
+ }
}
$domaintext.= &Apache::loncommon::end_data_table();
if ($num_domain_level > 0) {
$r->print($domaintext);
+ $addrolesdisplay = 1;
+ }
+ return $addrolesdisplay;
+}
+
+sub user_authentication {
+ my ($ccuname,$ccdomain,$formname) = @_;
+ my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
+ my $outcome;
+ my %lt=&Apache::lonlocal::texthash(
+ 'err' => "ERROR",
+ 'uuas' => "This user has an unrecognized authentication scheme",
+ 'adcs' => "Please alert a domain coordinator of this situation",
+ 'sldb' => "Please specify login data below",
+ 'ld' => "Login Data"
+ );
+ # Check for a bad authentication type
+ if ($currentauth !~ /^(krb4|krb5|unix|internal|localauth):/) {
+ # bad authentication scheme
+ if (&Apache::lonnet::allowed('mau',$ccdomain)) {
+ &initialize_authen_forms($ccdomain,$formname);
+
+ my $choices = &Apache::lonuserutils::set_login($ccdomain,$authformkrb,$authformint,$authformloc);
+ $outcome = <
+//
+
+$lt{'err'}:
+$lt{'uuas'} ($currentauth). $lt{'sldb'}.
+
$lt{'ld'}
+$choices
+ENDBADAUTH
+ } else {
+ # This user is not allowed to modify the user's
+ # authentication scheme, so just notify them of the problem
+ $outcome = < $lt{'err'}:
+$lt{'uuas'} ($currentauth). $lt{'adcs'}.
+
+ENDBADAUTH
+ }
+ } else { # Authentication type is valid
+
+ &initialize_authen_forms($ccdomain,$formname,$currentauth,'modifyuser');
+ my ($authformcurrent,$can_modify,@authform_others) =
+ &modify_login_block($ccdomain,$currentauth);
+ if (&Apache::lonnet::allowed('mau',$ccdomain)) {
+ # Current user has login modification privileges
+ $outcome =
+ ''."\n".
+ '
';
+ }
+ return $output;
+}
+
+sub selfcreate_canmodify {
+ my ($context,$dom,$userinfo,$inst_results,$rolesarray) = @_;
+ if (ref($inst_results) eq 'HASH') {
+ my @inststatuses = &get_inststatuses($inst_results);
+ if (@inststatuses == 0) {
+ @inststatuses = ('default');
+ }
+ $rolesarray = \@inststatuses;
}
- $r->print("".&Apache::loncommon::end_page());
+ my %canmodify =
+ &Apache::lonuserutils::can_modify_userinfo($context,$dom,$userinfo,
+ $rolesarray);
+ return %canmodify;
+}
+
+sub get_inststatuses {
+ my ($insthashref) = @_;
+ my @inststatuses = ();
+ if (ref($insthashref) eq 'HASH') {
+ if (ref($insthashref->{'inststatus'}) eq 'ARRAY') {
+ @inststatuses = @{$insthashref->{'inststatus'}};
+ }
+ }
+ return @inststatuses;
}
# ================================================================= Phase Three
sub update_user_data {
- my $r=shift;
+ my ($r,$context,$crstype,$brcrum,$showcredits) = @_;
my $uhome=&Apache::lonnet::homeserver($env{'form.ccuname'},
$env{'form.ccdomain'});
# Error messages
- my $error = ''.&mt('Error').':';
- my $end = &Apache::loncommon::end_page();
-
+ my $error = ''.&mt('Error').': ';
+ my $end = '
';
+ my $rtnlink = ''.
+ &mt('Return to previous page').''.
+ &Apache::loncommon::end_page();
+ my $now = time;
my $title;
if (exists($env{'form.makeuser'})) {
$title='Set Privileges for New User';
} else {
$title='Modify User Privileges';
}
- $r->print(&Apache::loncommon::start_page($title));
- my %disallowed;
+ my $newuser = 0;
+ my ($jsback,$elements) = &crumb_utilities();
+ my $jscript = ''."\n";
+ my %breadcrumb_text = &singleuser_breadcrumb($crstype,$context,$env{'form.ccdomain'});
+ push (@{$brcrum},
+ {href => "javascript:backPage(document.userupdate)",
+ text => $breadcrumb_text{'search'},
+ faq => 282,
+ bug => 'Instructor Interface',}
+ );
+ if ($env{'form.prevphase'} eq 'userpicked') {
+ push(@{$brcrum},
+ {href => "javascript:backPage(document.userupdate,'get_user_info','select')",
+ text => $breadcrumb_text{'userpicked'},
+ faq => 282,
+ bug => 'Instructor Interface',});
+ }
+ my $helpitem = 'Course_Change_Privileges';
+ if ($env{'form.action'} eq 'singlestudent') {
+ $helpitem = 'Course_Add_Student';
+ }
+ push(@{$brcrum},
+ {href => "javascript:backPage(document.userupdate,'$env{'form.prevphase'}','modify')",
+ text => $breadcrumb_text{'modify'},
+ faq => 282,
+ bug => 'Instructor Interface',},
+ {href => "/adm/createuser",
+ text => "Result",
+ faq => 282,
+ bug => 'Instructor Interface',
+ help => $helpitem});
+ my $args = {bread_crumbs => $brcrum,
+ bread_crumbs_component => 'User Management'};
+ if ($env{'form.popup'}) {
+ $args->{'no_nav_bar'} = 1;
+ }
+ $r->print(&Apache::loncommon::start_page($title,$jscript,$args));
+ $r->print(&update_result_form($uhome));
# Check Inputs
if (! $env{'form.ccuname'} ) {
- $r->print($error.&mt('No login name specified').'.'.$end);
+ $r->print($error.&mt('No login name specified').'.'.$end.$rtnlink);
return;
}
if ( $env{'form.ccuname'} ne
&LONCAPA::clean_username($env{'form.ccuname'}) ) {
- $r->print($error.&mt('Invalid login name').'. '.
- &mt('Only letters, numbers, and underscores are valid').'.'.
- $end);
+ $r->print($error.&mt('Invalid login name.').' '.
+ &mt('Only letters, numbers, periods, dashes, @, and underscores are valid.').
+ $end.$rtnlink);
return;
}
if (! $env{'form.ccdomain'} ) {
- $r->print($error.&mt('No domain specified').'.'.$end);
+ $r->print($error.&mt('No domain specified').'.'.$end.$rtnlink);
return;
}
if ( $env{'form.ccdomain'} ne
&LONCAPA::clean_domain($env{'form.ccdomain'}) ) {
- $r->print($error.&mt ('Invalid domain name').'. '.
- &mt('Only letters, numbers, periods, dashes, and underscores are valid').'.'.
- $end);
+ $r->print($error.&mt('Invalid domain name.').' '.
+ &mt('Only letters, numbers, periods, dashes, and underscores are valid.').
+ $end.$rtnlink);
return;
}
+ if ($uhome eq 'no_host') {
+ $newuser = 1;
+ }
if (! exists($env{'form.makeuser'})) {
# Modifying an existing user, so check the validity of the name
if ($uhome eq 'no_host') {
- $r->print($error.&mt('Unable to determine home server for ').
- $env{'form.ccuname'}.&mt(' in domain ').
- $env{'form.ccdomain'}.'.');
+ $r->print(
+ $error
+ .'
'
+ .&mt('Unable to determine home server for [_1] in domain [_2].',
+ '"'.$env{'form.ccuname'}.'"','"'.$env{'form.ccdomain'}.'"')
+ .'
');
return;
}
}
@@ -1042,21 +2809,30 @@ sub update_user_data {
# If they are creating a new user but have not specified login
# information this will be caught below.
} else {
- $r->print($error.&mt('Invalid login mode or password').$end);
- return;
+ $r->print($error.&mt('Invalid login mode or password').$end.$rtnlink);
+ return;
}
+
+ $r->print('
");
- }
- } else { # End of if ($env ... ) logic
- my $putresult;
- if ($quotachanged) {
- $putresult = &Apache::lonnet::put
- ('environment',\%changeHash,
- $env{'form.ccdomain'},$env{'form.ccuname'});
+ $r->print(
+ '
'
+ .&mt('Unable to successfully change environment for [_1] in domain [_2].',
+ '"'.$env{'form.ccuname'}.'"',
+ '"'.$env{'form.ccdomain'}.'"')
+ .'
');
}
- # They did not want to change the users name but we can
- # still tell them what the name is
- my %lt=&Apache::lonlocal::texthash(
- 'usr' => "User",
- 'id' => "in domain",
- 'gen' => "Generation",
- 'disk' => "Disk space allocated to user's portfolio files",
- );
- $r->print(<<"END");
-
');
+ } else { # End of if ($env ... ) logic
+ # They did not want to change the users name, quota, tool availability,
+ # or ability to request creation of courses,
+ # but we can still tell them what the name and quota and availabilities are
+ &display_userinfo($r,undef,\@disporder,\%canshow,\@requestcourses,
+ \@usertools,\@requestauthor,\%userenv,\%changed,\%namechanged,\%oldsettings,
+ \%oldsettingstext,\%newsettings,\%newsettingstext);
+ }
+ if (@mod_disallowed) {
+ my ($rolestr,$contextname);
+ if (@longroles > 0) {
+ $rolestr = join(', ',@longroles);
+ } else {
+ $rolestr = &mt('No roles');
+ }
+ if ($context eq 'course') {
+ $contextname = 'course';
+ } elsif ($context eq 'author') {
+ $contextname = 'co-author';
+ }
+ $r->print(&mt('The following fields were not updated: ').'
');
+ my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
+ foreach my $field (@mod_disallowed) {
+ $r->print('
'.$fieldtitles{$field}.'
'."\n");
+ }
+ $r->print('
');
+ if (@mod_disallowed == 1) {
+ $r->print(&mt("You do not have the authority to change this field given the user's current set of active/future $contextname roles:"));
+ } else {
+ $r->print(&mt("You do not have the authority to change these fields given the user's current set of active/future $contextname roles:"));
+ }
+ my $helplink = 'javascript:helpMenu('."'display'".')';
+ $r->print(''.$rolestr.' '
+ .&mt('Please contact your [_1]helpdesk[_2] for more information.'
+ ,'','')
+ .' ');
+ }
+ $r->print(''
+ .$no_forceid_alert
+ .&Apache::lonuserutils::print_namespacing_alerts($env{'form.ccdomain'},\%alerts,\%curr_rules)
+ .'');
+ }
+ &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
+ if ($env{'form.action'} eq 'singlestudent') {
+ &enroll_single_student($r,$uhome,$amode,$genpwd,$now,$newuser,$context,
+ $crstype,$showcredits,$defaultcredits);
+ my $linktext = ($crstype eq 'Community' ?
+ &mt('Enroll Another Member') : &mt('Enroll Another Student'));
+ $r->print(
+ &Apache::lonhtmlcommon::actionbox([
+ ''
+ .($crstype eq 'Community' ?
+ &mt('Enroll Another Member') : &mt('Enroll Another Student'))
+ .'']));
+ } else {
+ my @rolechanges = &update_roles($r,$context,$showcredits);
+ if (keys(%namechanged) > 0) {
+ if ($context eq 'course') {
+ if (@userroles > 0) {
+ if ((@rolechanges == 0) ||
+ (!(grep(/^st$/,@rolechanges)))) {
+ if (grep(/^st$/,@userroles)) {
+ my $classlistupdated =
+ &Apache::lonuserutils::update_classlist($cdom,
+ $cnum,$env{'form.ccdomain'},
+ $env{'form.ccuname'},\%userupdate);
+ }
+ }
}
}
}
+ my $userinfo = &Apache::loncommon::plainname($env{'form.ccuname'},
+ $env{'form.ccdomain'});
+ if ($env{'form.popup'}) {
+ $r->print('
'.&mt('[_1] may not be used as the name for a section, as it is a reserved word.',$key));
+ $r->print(&mt('[_1] may not be used as the name for a section, as it is a reserved word.',''.$key.''));
} else {
- $r->print('
'.&mt('[_1] may not be used as the name for a section, as it is the name of a course group.',$key));
+ $r->print(&mt('[_1] may not be used as the name for a section, as it is the name of a course group.',''.$key.''));
}
- $r->print(' '.&mt('Please go back and choose a different section name.').'
');
+
+ # Remove non alphanumeric values from section
+ $env{'form.sections'}=~s/\W//g;
+
+ my $credits;
+ if (($showcredits) && ($env{'form.credits'} ne '')) {
+ $credits = $env{'form.credits'};
+ $credits =~ s/[^\d\.]//g;
+ if ($credits ne '') {
+ if ($credits eq $defaultcredits) {
+ undef($credits);
+ }
+ }
+ }
+
+ # Clean out any old student roles the user has in this class.
+ &Apache::lonuserutils::modifystudent($env{'form.ccdomain'},
+ $env{'form.ccuname'},$env{'request.course.id'},undef,$uhome);
+ my ($startdate,$enddate) = &Apache::lonuserutils::get_dates_from_form();
+ my $enroll_result =
+ &Apache::lonnet::modify_student_enrollment($env{'form.ccdomain'},
+ $env{'form.ccuname'},$env{'form.cid'},$env{'form.cfirstname'},
+ $env{'form.cmiddlename'},$env{'form.clastname'},
+ $env{'form.generation'},$env{'form.sections'},$enddate,
+ $startdate,'manual',undef,$env{'request.course.id'},'',$context,
+ $credits);
+ if ($enroll_result =~ /^ok/) {
+ $r->print(&mt('[_1] enrolled',''.$env{'form.ccuname'}.':'.$env{'form.ccdomain'}.''));
+ if ($env{'form.sections'} ne '') {
+ $r->print(' '.&mt('in section [_1]',$env{'form.sections'}));
+ }
+ my ($showstart,$showend);
+ if ($startdate <= $now) {
+ $showstart = &mt('Access starts immediately');
+ } else {
+ $showstart = &mt('Access starts: ').&Apache::lonlocal::locallocaltime($startdate);
+ }
+ if ($enddate == 0) {
+ $showend = &mt('ends: no ending date');
+ } else {
+ $showend = &mt('ends: ').&Apache::lonlocal::locallocaltime($enddate);
+ }
+ $r->print('. '.$showstart.'; '.$showend);
+ if ($startdate <= $now && !$newuser) {
+ $r->print('
');
+ if ($crstype eq 'Community') {
+ $r->print(&mt('If the member is currently logged-in to LON-CAPA, the new role can be displayed by using the "Check for changes" link on the Roles/Courses page.'));
+ } else {
+ $r->print(&mt('If the student is currently logged-in to LON-CAPA, the new role can be displayed by using the "Check for changes" link on the Roles/Courses page.'));
+ }
+ $r->print('
');
+ }
+ } else {
+ $r->print(&mt('unable to enroll').": ".$enroll_result);
+ }
+ return;
+}
+
+sub get_defaultquota_text {
+ my ($settingstatus) = @_;
+ my $defquotatext;
+ if ($settingstatus eq '') {
+ $defquotatext = &mt('default');
+ } else {
+ my ($usertypes,$order) =
+ &Apache::lonnet::retrieve_inst_usertypes($env{'form.ccdomain'});
+ if ($usertypes->{$settingstatus} eq '') {
+ $defquotatext = &mt('default');
+ } else {
+ $defquotatext = &mt('default for [_1]',$usertypes->{$settingstatus});
+ }
+ }
+ return $defquotatext;
+}
+
+sub update_result_form {
+ my ($uhome) = @_;
+ my $outcome =
+ '';
+ return $outcome;
+}
+
+sub quota_admin {
+ my ($setquota,$changeHash,$name) = @_;
+ my $quotachanged;
+ if (&Apache::lonnet::allowed('mpq',$env{'form.ccdomain'})) {
+ # Current user has quota modification privileges
+ if (ref($changeHash) eq 'HASH') {
+ $quotachanged = 1;
+ $changeHash->{$name.'quota'} = $setquota;
+ }
+ }
+ return $quotachanged;
+}
+
+sub tool_admin {
+ my ($tool,$settool,$changeHash,$context) = @_;
+ my $canchange = 0;
+ if ($context eq 'requestcourses') {
+ if (&Apache::lonnet::allowed('ccc',$env{'form.ccdomain'})) {
+ $canchange = 1;
+ }
+ } elsif ($context eq 'reqcrsotherdom') {
+ if (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'})) {
+ $canchange = 1;
+ }
+ } elsif ($context eq 'requestauthor') {
+ if (&Apache::lonnet::allowed('cau',$env{'request.role.domain'})) {
+ $canchange = 1;
+ }
+ } elsif (&Apache::lonnet::allowed('mut',$env{'form.ccdomain'})) {
+ # Current user has quota modification privileges
+ $canchange = 1;
+ }
+ my $toolchanged;
+ if ($canchange) {
+ if (ref($changeHash) eq 'HASH') {
+ $toolchanged = 1;
+ if ($tool eq 'requestauthor') {
+ $changeHash->{$context} = $settool;
+ } else {
+ $changeHash->{$context.'.'.$tool} = $settool;
+ }
+ }
+ }
+ return $toolchanged;
}
sub build_roles {
@@ -1458,7 +4456,7 @@ sub build_roles {
} else {
foreach my $sec (@secnums) {
$sec =~ ~s/\W//g;
- unless ($sec eq "") {
+ if (!($sec eq "")) {
if (exists($$sections{$sec})) {
$$sections{$sec} ++;
} else {
@@ -1482,223 +4480,3405 @@ sub build_roles {
# ========================================================== Custom Role Editor
sub custom_role_editor {
- my $r=shift;
- my $rolename=$env{'form.rolename'};
+ my ($r,$brcrum,$prefix) = @_;
+ my $action = $env{'form.customroleaction'};
+ my $rolename;
+ if ($action eq 'new') {
+ $rolename=$env{'form.newrolename'};
+ } else {
+ $rolename=$env{'form.rolename'};
+ }
- if ($rolename eq 'make new role') {
- $rolename=$env{'form.newrolename'};
+ my ($crstype,$context);
+ if ($env{'request.course.id'}) {
+ $crstype = &Apache::loncommon::course_type();
+ $context = 'course';
+ } else {
+ $context = 'domain';
+ $crstype = 'course';
}
$rolename=~s/[^A-Za-z0-9]//gs;
-
- unless ($rolename) {
- &print_username_entry_form($r);
+ if (!$rolename || $env{'form.phase'} eq 'pickrole') {
+ &print_username_entry_form($r,undef,undef,undef,undef,$crstype,$brcrum);
return;
}
- $r->print(&Apache::loncommon::start_page('Custom Role Editor'));
- my $syspriv='';
- my $dompriv='';
- my $coursepriv='';
+ my $formname = 'form1';
+ my %privs=();
+ my $body_top = '
';
+# ------------------------------------------------------- Does this role exist?
my ($rdummy,$roledef)=
&Apache::lonnet::get('roles',["rolesdef_$rolename"]);
-# ------------------------------------------------------- Does this role exist?
- $r->print('
';
+
# ------------------------------------------------------- What can be assigned?
my %full=();
- my %courselevel=();
- my %courselevelcurrent=();
- foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
- my ($priv,$restrict)=split(/\&/,$item);
- unless ($restrict) { $restrict='F'; }
- $courselevel{$priv}=$restrict;
- if ($coursepriv=~/\:$priv/) {
- $courselevelcurrent{$priv}=1;
- }
- $full{$priv}=1;
- }
- my %domainlevel=();
- my %domainlevelcurrent=();
- foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
- my ($priv,$restrict)=split(/\&/,$item);
- unless ($restrict) { $restrict='F'; }
- $domainlevel{$priv}=$restrict;
- if ($dompriv=~/\:$priv/) {
- $domainlevelcurrent{$priv}=1;
- }
- $full{$priv}=1;
- }
- my %systemlevel=();
- my %systemlevelcurrent=();
- foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
- my ($priv,$restrict)=split(/\&/,$item);
- unless ($restrict) { $restrict='F'; }
- $systemlevel{$priv}=$restrict;
- if ($syspriv=~/\:$priv/) {
- $systemlevelcurrent{$priv}=1;
- }
- $full{$priv}=1;
- }
- my %lt=&Apache::lonlocal::texthash(
- 'prv' => "Privilege",
- 'crl' => "Course Level",
- 'dml' => "Domain Level",
- 'ssl' => "System Level"
- );
+ my %levels=(
+ course => {},
+ domain => {},
+ system => {},
+ );
+ my %levelscurrent=(
+ course => {},
+ domain => {},
+ system => {},
+ );
+ &Apache::lonuserutils::custom_role_privs(\%privs,\%full,\%levels,\%levelscurrent);
+ my ($jsback,$elements) = &crumb_utilities();
+ my @templateroles = &Apache::lonuserutils::custom_template_roles($context,$crstype);
+ my $head_script =
+ &Apache::lonuserutils::custom_roledefs_js($context,$crstype,$formname,
+ \%full,\@templateroles,$jsback);
+ push (@{$brcrum},
+ {href => "javascript:backPage(document.$formname,'pickrole','')",
+ text => "Pick custom role",
+ faq => 282,bug=>'Instructor Interface',},
+ {href => "javascript:backPage(document.$formname,'','')",
+ text => "Edit custom role",
+ faq => 282,
+ bug => 'Instructor Interface',
+ help => 'Course_Editing_Custom_Roles'}
+ );
+ my $args = { bread_crumbs => $brcrum,
+ bread_crumbs_component => 'User Management'};
+
+ $r->print(&Apache::loncommon::start_page('Custom Role Editor',
+ $head_script,$args).
+ $body_top);
+ $r->print(''.
- &Apache::loncommon::end_page());
+ ''.
+ ''."\n".''."\n".
+ ''."\n".
+ '');
}
# ---------------------------------------------------------- Call to definerole
sub set_custom_role {
- my ($r) = @_;
-
+ my ($r,$context,$brcrum,$prefix) = @_;
my $rolename=$env{'form.rolename'};
-
$rolename=~s/[^A-Za-z0-9]//gs;
-
- unless ($rolename) {
- &print_username_entry_form($r);
+ if (!$rolename) {
+ &custom_role_editor($r,$brcrum,$prefix);
return;
}
+ my ($jsback,$elements) = &crumb_utilities();
+ my $jscript = ''."\n";
+ push(@{$brcrum},
+ {href => "javascript:backPage(document.customresult,'pickrole','')",
+ text => "Pick custom role",
+ faq => 282,
+ bug => 'Instructor Interface',},
+ {href => "javascript:backPage(document.customresult,'selected_custom_edit','')",
+ text => "Edit custom role",
+ faq => 282,
+ bug => 'Instructor Interface',},
+ {href => "javascript:backPage(document.customresult,'set_custom_roles','')",
+ text => "Result",
+ faq => 282,
+ bug => 'Instructor Interface',
+ help => 'Course_Editing_Custom_Roles'},
+ );
+ my $args = { bread_crumbs => $brcrum,
+ bread_crumbs_component => 'User Management'};
+ $r->print(&Apache::loncommon::start_page('Save Custom Role',$jscript,$args));
- $r->print(&Apache::loncommon::start_page('Save Custom Role').'
');
+ my $newrole;
my ($rdummy,$roledef)=
&Apache::lonnet::get('roles',["rolesdef_$rolename"]);
# ------------------------------------------------------- Does this role exist?
+ $r->print('
');
if (($rdummy ne 'con_lost') && ($roledef ne '')) {
$r->print(&mt('Existing Role').' "');
} else {
$r->print(&mt('New Role').' "');
$roledef='';
+ $newrole = 1;
}
- $r->print($rolename.'"
');
-# ------------------------------------------------------- What can be assigned?
- my $sysrole='';
- my $domrole='';
- my $courole='';
-
- foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
- my ($priv,$restrict)=split(/\&/,$item);
- unless ($restrict) { $restrict=''; }
- if ($env{'form.'.$priv.':c'}) {
- $courole.=':'.$item;
- }
- }
+ $r->print($rolename.'"');
+# ------------------------------------------------- Assign role and show result
- foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
- my ($priv,$restrict)=split(/\&/,$item);
- unless ($restrict) { $restrict=''; }
- if ($env{'form.'.$priv.':d'}) {
- $domrole.=':'.$item;
- }
- }
-
- foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
- my ($priv,$restrict)=split(/\&/,$item);
- unless ($restrict) { $restrict=''; }
- if ($env{'form.'.$priv.':s'}) {
- $sysrole.=':'.$item;
- }
- }
- $r->print(' Defining Role: '.
- &Apache::lonnet::definerole($rolename,$sysrole,$domrole,$courole));
+ my $errmsg;
+ my %newprivs = &Apache::lonuserutils::custom_role_update($rolename,$prefix);
+ # Assign role and return result
+ my $result = &Apache::lonnet::definerole($rolename,$newprivs{'s'},$newprivs{'d'},
+ $newprivs{'c'});
+ if ($result ne 'ok') {
+ $errmsg = ': '.$result;
+ }
+ my $message =
+ &Apache::lonhtmlcommon::confirm_success(
+ &mt('Defining Role').$errmsg, ($result eq 'ok' ? 0 : 1));
if ($env{'request.course.id'}) {
my $url='/'.$env{'request.course.id'};
$url=~s/\_/\//g;
- $r->print(' '.&mt('Assigning Role to Self').': '.
- &Apache::lonnet::assigncustomrole($env{'user.domain'},
- $env{'user.name'},
- $url,
- $env{'user.domain'},
- $env{'user.name'},
- $rolename));
- }
- $r->print('