File:  [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.134: download - view: text, annotated - select for diffs
Tue Nov 21 21:38:44 2006 UTC (17 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
Users with "mpq" privilege for a domain can set and modify the portfolio quota for a user in the domain.

When a user uploads a file to his/her portfolio, the user's portfolio quota is retrieved, if one has not been set, the default for the domain is used, if no default has been set, the original static value of 20 Mb for backwards compatibility.

In the future we might want to consider different defaults for different types of user in a single domain.

    1: # The LearningOnline Network with CAPA
    2: # Create a user
    3: #
    4: # $Id: loncreateuser.pm,v 1.134 2006/11/21 21:38:44 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###
   29: 
   30: package Apache::loncreateuser;
   31: 
   32: =pod
   33: 
   34: =head1 NAME
   35: 
   36: Apache::loncreateuser - handler to create users and custom roles
   37: 
   38: =head1 SYNOPSIS
   39: 
   40: Apache::loncreateuser provides an Apache handler for creating users,
   41:     editing their login parameters, roles, and removing roles, and
   42:     also creating and assigning custom roles.
   43: 
   44: =head1 OVERVIEW
   45: 
   46: =head2 Custom Roles
   47: 
   48: In LON-CAPA, roles are actually collections of privileges. "Teaching
   49: Assistant", "Course Coordinator", and other such roles are really just
   50: collection of privileges that are useful in many circumstances.
   51: 
   52: Creating custom roles can be done by the Domain Coordinator through
   53: the Create User functionality. That screen will show all privileges
   54: that can be assigned to users. For a complete list of privileges,
   55: please see C</home/httpd/lonTabs/rolesplain.tab>.
   56: 
   57: Custom role definitions are stored in the C<roles.db> file of the role
   58: author.
   59: 
   60: =cut
   61: 
   62: use strict;
   63: use Apache::Constants qw(:common :http);
   64: use Apache::lonnet;
   65: use Apache::loncommon;
   66: use Apache::lonlocal;
   67: use Apache::longroup;
   68: use lib '/home/httpd/lib/perl/';
   69: use LONCAPA;
   70: 
   71: my $loginscript; # piece of javascript used in two separate instances
   72: my $generalrule;
   73: my $authformnop;
   74: my $authformkrb;
   75: my $authformint;
   76: my $authformfsys;
   77: my $authformloc;
   78: 
   79: sub initialize_authen_forms {
   80:     my ($krbdefdom)=( $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/);
   81:     $krbdefdom= uc($krbdefdom);
   82:     my %param = ( formname => 'document.cu',
   83:                   kerb_def_dom => $krbdefdom 
   84:                   );
   85: # no longer static due to configurable kerberos defaults
   86: #    $loginscript  = &Apache::loncommon::authform_header(%param);
   87:     $generalrule  = &Apache::loncommon::authform_authorwarning(%param);
   88:     $authformnop  = &Apache::loncommon::authform_nochange(%param);
   89: # no longer static due to configurable kerberos defaults
   90: #    $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
   91:     $authformint  = &Apache::loncommon::authform_internal(%param);
   92:     $authformfsys = &Apache::loncommon::authform_filesystem(%param);
   93:     $authformloc  = &Apache::loncommon::authform_local(%param);
   94: }
   95: 
   96: 
   97: # ======================================================= Existing Custom Roles
   98: 
   99: sub my_custom_roles {
  100:     my %returnhash=();
  101:     my %rolehash=&Apache::lonnet::dump('roles');
  102:     foreach (keys %rolehash) {
  103: 	if ($_=~/^rolesdef\_(\w+)$/) {
  104: 	    $returnhash{$1}=$1;
  105: 	}
  106:     }
  107:     return %returnhash;
  108: }
  109: 
  110: # ==================================================== Figure out author access
  111: 
  112: sub authorpriv {
  113:     my ($auname,$audom)=@_;
  114:     unless ((&Apache::lonnet::allowed('cca',$audom.'/'.$auname))
  115:          || (&Apache::lonnet::allowed('caa',$audom.'/'.$auname))) { return ''; }
  116:     return 1;
  117: }
  118: 
  119: # ====================================================
  120: 
  121: sub portfolio_quota {
  122:     my ($ccuname,$ccdomain) = @_;
  123:     my %lt = &Apache::lonlocal::texthash(
  124:                    'disk' => "Disk space allocated to user's portfolio files",
  125:     );
  126:     my $output = '<h3>'.$lt{'disk'}.'</h3>'.
  127:                  '<input type="text" name="portfolioquota" size ="5" value="'.
  128:                  &Apache::loncommon::get_user_quota($ccuname,$ccdomain).
  129:                  '" />&nbsp;Mb';
  130:     return $output;
  131: }
  132: 
  133: # =================================================================== Phase one
  134: 
  135: sub print_username_entry_form {
  136:     my ($r) = @_;
  137:     my $defdom=$env{'request.role.domain'};
  138:     my @domains = &Apache::loncommon::get_domains();
  139:     my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
  140:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
  141:     my $start_page =
  142: 	&Apache::loncommon::start_page('Create Users, Change User Privileges',
  143: 				       $selscript);
  144: 
  145:     my $sellink=&Apache::loncommon::selectstudent_link
  146:                                         ('crtuser','ccuname','ccdomain');
  147:     my %existingroles=&my_custom_roles();
  148:     my $choice=&Apache::loncommon::select_form('make new role','rolename',
  149: 		('make new role' => 'Generate new role ...',%existingroles));
  150:     my %lt=&Apache::lonlocal::texthash(
  151: 		    'siur'   => "Set Individual User Roles",
  152: 		    'usr'  => "Username",
  153:                     'dom'  => "Domain",
  154:                     'usrr' => "User Roles",
  155:                     'ecrp' => "Edit Custom Role Privileges",
  156:                     'nr'   => "Name of Role",
  157:                     'cre'  => "Custom Role Editor"
  158: 				       );
  159:     my $help = &Apache::loncommon::help_open_menu(undef,undef,282,'Instructor Interface');
  160:     my $helpsiur=&Apache::loncommon::help_open_topic('Course_Change_Privileges');
  161:     my $helpecpr=&Apache::loncommon::help_open_topic('Course_Editing_Custom_Roles');
  162:     $r->print(<<"ENDDOCUMENT");
  163: $start_page
  164: <form action="/adm/createuser" method="post" name="crtuser">
  165: <input type="hidden" name="phase" value="get_user_info">
  166: <h2>$lt{siur}$helpsiur</h2>
  167: <table>
  168: <tr><td>$lt{usr}:</td><td><input type="text" size="15" name="ccuname">
  169: </td><td rowspan="2">$sellink</td></tr><tr><td>
  170: $lt{'dom'}:</td><td>$domform</td></tr>
  171: </table>
  172: <input name="userrole" type="submit" value="$lt{usrr}" />
  173: </form>
  174: ENDDOCUMENT
  175:    if (&Apache::lonnet::allowed('mcr','/')) {
  176:        $r->print(<<ENDCUSTOM);
  177: <form action="/adm/createuser" method="post" name="docustom">
  178: <input type="hidden" name="phase" value="selected_custom_edit">
  179: <h2>$lt{'ecrp'}$helpecpr</h2>
  180: $lt{'nr'}: $choice <input type="text" size="15" name="newrolename" /><br />
  181: <input name="customeditor" type="submit" value="$lt{'cre'}" />
  182: </form>
  183: ENDCUSTOM
  184:     }
  185:     $r->print(&Apache::loncommon::end_page());
  186: }
  187: 
  188: 
  189: sub user_modification_js {
  190:     my ($pjump_def,$dc_setcourse_code,$nondc_setsection_code,$groupslist)=@_;
  191:     
  192:     return <<END;
  193: <script type="text/javascript" language="Javascript">
  194: 
  195:     function pclose() {
  196:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
  197:                  "height=350,width=350,scrollbars=no,menubar=no");
  198:         parmwin.close();
  199:     }
  200: 
  201:     $pjump_def
  202:     $dc_setcourse_code
  203: 
  204:     function dateset() {
  205:         eval("document.cu."+document.cu.pres_marker.value+
  206:             ".value=document.cu.pres_value.value");
  207:         pclose();
  208:     }
  209: 
  210:     $nondc_setsection_code
  211: 
  212: </script>
  213: END
  214: }
  215: 
  216: # =================================================================== Phase two
  217: sub print_user_modification_page {
  218:     my $r=shift;
  219:     my $ccuname=$env{'form.ccuname'};
  220:     my $ccdomain=$env{'form.ccdomain'};
  221: 
  222:     $ccuname=~s/\W//g;
  223:     $ccdomain=~s/\W//g;
  224: 
  225:     unless (($ccuname) && ($ccdomain)) {
  226: 	&print_username_entry_form($r);
  227:         return;
  228:     }
  229: 
  230:     my $defdom=$env{'request.role.domain'};
  231: 
  232:     my ($krbdef,$krbdefdom) =
  233:        &Apache::loncommon::get_kerberos_defaults($defdom);
  234: 
  235:     my %param = ( formname => 'document.cu',
  236:                   kerb_def_dom => $krbdefdom,
  237:                   kerb_def_auth => $krbdef
  238:                   );
  239:     $loginscript  = &Apache::loncommon::authform_header(%param);
  240:     $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
  241: 
  242:     $ccuname=~s/\W//g;
  243:     $ccdomain=~s/\W//g;
  244:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
  245:     my $dc_setcourse_code = '';
  246:     my $nondc_setsection_code = '';                                        
  247: 
  248:     my %loaditem;
  249: 
  250:     my $groupslist;
  251:     my %curr_groups = &Apache::longroup::coursegroups();
  252:     if (%curr_groups) {
  253:         $groupslist = join('","',sort(keys(%curr_groups)));
  254:         $groupslist = '"'.$groupslist.'"';   
  255:     }
  256: 
  257:     if ($env{'request.role'} =~ m-^dc\./(\w+)/$-) {
  258:         my $dcdom = $1;
  259:         $loaditem{'onload'} = "document.cu.coursedesc.value='';";
  260:         my @rolevals = ('st','ta','ep','in','cc');
  261:         my (@crsroles,@grproles);
  262:         for (my $i=0; $i<@rolevals; $i++) {
  263:             $crsroles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Course');
  264:             $grproles[$i]=&Apache::lonnet::plaintext($rolevals[$i],'Group');
  265:         }
  266:         my $rolevalslist = join('","',@rolevals);
  267:         my $crsrolenameslist = join('","',@crsroles);
  268:         my $grprolenameslist = join('","',@grproles);
  269:         my $pickcrsfirst = '<--'.&mt('Pick course first');
  270:         my $pickgrpfirst = '<--'.&mt('Pick group first'); 
  271:         $dc_setcourse_code = <<"ENDSCRIPT";
  272:     function setCourse() {
  273:         var course = document.cu.dccourse.value;
  274:         if (course != "") {
  275:             if (document.cu.dcdomain.value != document.cu.origdom.value) {
  276:                 alert("You must select a course in the current domain");
  277:                 return;
  278:             } 
  279:             var userrole = document.cu.role.options[document.cu.role.selectedIndex].value
  280:             var section="";
  281:             var numsections = 0;
  282:             var newsecs = new Array();
  283:             for (var i=0; i<document.cu.currsec.length; i++) {
  284:                 if (document.cu.currsec.options[i].selected == true ) {
  285:                     if (document.cu.currsec.options[i].value != "" && document.cu.currsec.options[i].value != null) { 
  286:                         if (numsections == 0) {
  287:                             section = document.cu.currsec.options[i].value
  288:                             numsections = 1;
  289:                         }
  290:                         else {
  291:                             section = section + "," +  document.cu.currsec.options[i].value
  292:                             numsections ++;
  293:                         }
  294:                     }
  295:                 }
  296:             }
  297:             if (document.cu.newsec.value != "" && document.cu.newsec.value != null) {
  298:                 if (numsections == 0) {
  299:                     section = document.cu.newsec.value
  300:                 }
  301:                 else {
  302:                     section = section + "," +  document.cu.newsec.value
  303:                 }
  304:                 newsecs = document.cu.newsec.value.split(/,/g);
  305:                 numsections = numsections + newsecs.length;
  306:             }
  307:             if ((userrole == 'st') && (numsections > 1)) {
  308:                 alert("In each course, each user may only have one student role at a time. You had selected "+numsections+" sections.\\nPlease modify your selections so they include no more than one section.")
  309:                 return;
  310:             }
  311:             for (var j=0; j<newsecs.length; j++) {
  312:                 if ((newsecs[j] == 'all') || (newsecs[j] == 'none')) {
  313:                     alert("'"+newsecs[j]+"' may not be used as the name for a section, as it is a reserved word.\\nPlease choose a different section name.");
  314:                     return;
  315:                 }
  316:                 if (document.cu.groups.value != '') {
  317:                     var groups = document.cu.groups.value.split(/,/g);
  318:                     for (var k=0; k<groups.length; k++) {
  319:                         if (newsecs[j] == groups[k]) {
  320:                             alert("'"+newsecs[j]+"' may not be used as the name for a section, as it is the name of a course group.\\nSection names and group names must be distinct. Please choose a different section name.");
  321:                             return; 
  322:                         }
  323:                     }
  324:                 }
  325:             }
  326:             if ((userrole == 'cc') && (numsections > 0)) {
  327:                 alert("Section designations do not apply to Course Coordinator roles.\\nA course coordinator role will be added with access to all sections.");
  328:                 section = "";
  329:             }
  330:             var coursename = "_$dcdom"+"_"+course+"_"+userrole
  331:             var numcourse = getIndex(document.cu.dccourse);
  332:             if (numcourse == "-1") {
  333:                 alert("There was a problem with your course selection");
  334:                 return
  335:             }
  336:             else {
  337:                 document.cu.elements[numcourse].name = "act"+coursename;
  338:                 var numnewsec = getIndex(document.cu.newsec);
  339:                 if (numnewsec != "-1") {
  340:                     document.cu.elements[numnewsec].name = "sec"+coursename;
  341:                     document.cu.elements[numnewsec].value = section;
  342:                 }
  343:                 var numstart = getIndex(document.cu.start);
  344:                 if (numstart != "-1") {
  345:                     document.cu.elements[numstart].name = "start"+coursename;
  346:                 }
  347:                 var numend = getIndex(document.cu.end);
  348:                 if (numend != "-1") {
  349:                     document.cu.elements[numend].name = "end"+coursename
  350:                 }
  351:             }
  352:         }
  353:         document.cu.submit();
  354:     }
  355: 
  356:     function getIndex(caller) {
  357:         for (var i=0;i<document.cu.elements.length;i++) {
  358:             if (document.cu.elements[i] == caller) {
  359:                 return i;
  360:             }
  361:         }
  362:         return -1;
  363:     }
  364: 
  365:     function setType() {
  366:         var crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value;
  367:         rolevals = new Array("$rolevalslist");
  368:         if (crstype == 'Group') {
  369:             if (document.cu.currsec.options[0].text == "$pickcrsfirst") {
  370:                 document.cu.currsec.options[0].text = "$pickgrpfirst";
  371:             } 
  372:             grprolenames = new Array("$grprolenameslist");
  373:             for (var i=0; i<rolevals.length; i++) {
  374:                 if (document.cu.role.selectedIndex == i) {
  375:                     document.cu.role.options[i] = new Option(grprolenames[i],rolevals[i],true,false);
  376:                 } else {
  377:                     document.cu.role.options[i] = new Option(grprolenames[i],rolevals[i],false,false);
  378:                 }
  379:             }
  380:         } else {
  381:             if (document.cu.currsec.options[0].text == "$pickgrpfirst") {
  382:                 document.cu.currsec.options[0].text = "$pickcrsfirst";
  383:             }
  384:             crsrolenames = new Array("$crsrolenameslist");
  385:             for (var i=0; i<rolevals.length; i++) {
  386:                 if (document.cu.role.selectedIndex == i) {
  387:                     document.cu.role.options[i] = new Option(crsrolenames[i],rolevals[i],true,false);
  388:                 } else {
  389:                     document.cu.role.options[i] = new Option(crsrolenames[i],rolevals[i],false,false);
  390:                 }
  391:             }
  392:         }
  393:     }
  394: ENDSCRIPT
  395:     } else {
  396:         $nondc_setsection_code = <<"ENDSECCODE";
  397:     function setSections() {
  398:         var re1 = /^currsec_/;
  399:         var groups = new Array($groupslist);
  400:         for (var i=0;i<document.cu.elements.length;i++) {
  401:             var str = document.cu.elements[i].name;
  402:             var checkcurr = str.match(re1);
  403:             if (checkcurr != null) {
  404:                 if (document.cu.elements[i-1].checked == true) {
  405:                     var re2 = /^currsec_[a-zA-Z0-9]+_[a-zA-Z0-9]+_(\\w+)\$/;
  406:                     match = re2.exec(str);
  407:                     var role = match[1];
  408:                     if (role == 'cc') {
  409:                         alert("Section designations do not apply to Course Coordinator roles.\\nA course coordinator role will be added with access to all sections.");
  410:                     }
  411:                     else {
  412:                         var sections = '';
  413:                         var numsec = 0;
  414:                         var sections;
  415:                         for (var j=0; j<document.cu.elements[i].length; j++) {
  416:                             if (document.cu.elements[i].options[j].selected == true ) {
  417:                                 if (document.cu.elements[i].options[j].value != "") {
  418:                                     if (numsec == 0) {
  419:                                         if (document.cu.elements[i].options[j].value != "") {
  420:                                             sections = document.cu.elements[i].options[j].value;
  421:                                             numsec ++;
  422:                                         }
  423:                                     }
  424:                                     else {
  425:                                         sections = sections + "," +  document.cu.elements[i].options[j].value
  426:                                         numsec ++;
  427:                                     }
  428:                                 }
  429:                             }
  430:                         }
  431:                         if (numsec > 0) {
  432:                             if (document.cu.elements[i+1].value != "" && document.cu.elements[i+1].value != null) {
  433:                                 sections = sections + "," +  document.cu.elements[i+1].value;
  434:                             }
  435:                         }
  436:                         else {
  437:                             sections = document.cu.elements[i+1].value;
  438:                         }
  439:                         var newsecs = document.cu.elements[i+1].value;
  440: 			var numsplit;
  441:                         if (newsecs != null && newsecs != "") {
  442:                             numsplit = newsecs.split(/,/g);
  443:                             numsec = numsec + numsplit.length;
  444:                         }
  445: 
  446:                         if ((role == 'st') && (numsec > 1)) {
  447:                             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.")
  448:                             return;
  449:                         }
  450:                         else if (numsplit != null) {
  451:                             for (var j=0; j<numsplit.length; j++) {
  452:                                 if ((numsplit[j] == 'all') ||
  453:                                     (numsplit[j] == 'none')) {
  454:                                     alert("'"+numsplit[j]+"' may not be used as the name for a section, as it is a reserved word.\\nPlease choose a different section name.");
  455:                                     return;
  456:                                 }
  457:                                 for (var k=0; k<groups.length; k++) {
  458:                                     if (numsplit[j] == groups[k]) {
  459:                                         alert("'"+numsplit[j]+"' may not be used as a section name, as it is the name of a course group.\\nSection names and group names must be distinct. Please choose a different section name.");
  460:                                         return;
  461:                                     }
  462:                                 }
  463:                             }
  464:                         }
  465:                         document.cu.elements[i+2].value = sections;
  466:                     }
  467:                 }
  468:             }
  469:         }
  470:         document.cu.submit();
  471:     }
  472: ENDSECCODE
  473:     }
  474:     my $js = &user_modification_js($pjump_def,$dc_setcourse_code,
  475:                                    $nondc_setsection_code,$groupslist);
  476:     my $start_page = 
  477: 	&Apache::loncommon::start_page('Create Users, Change User Privileges',
  478: 				       $js,{'add_entries' => \%loaditem,});
  479: 
  480:     my $forminfo =<<"ENDFORMINFO";
  481: <form action="/adm/createuser" method="post" name="cu">
  482: <input type="hidden" name="phase"       value="update_user_data">
  483: <input type="hidden" name="ccuname"     value="$ccuname">
  484: <input type="hidden" name="ccdomain"    value="$ccdomain">
  485: <input type="hidden" name="pres_value"  value="" >
  486: <input type="hidden" name="pres_type"   value="" >
  487: <input type="hidden" name="pres_marker" value="" >
  488: ENDFORMINFO
  489:     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
  490:     my %incdomains; 
  491:     my %inccourses;
  492:     foreach (values(%Apache::lonnet::hostdom)) {
  493:        $incdomains{$_}=1;
  494:     }
  495:     foreach (keys(%env)) {
  496: 	if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
  497: 	    $inccourses{$1.'_'.$2}=1;
  498:         }
  499:     }
  500:     if ($uhome eq 'no_host') {
  501:         my $home_server_list=
  502:             '<option value="default" selected>default</option>'."\n".
  503:                 &Apache::loncommon::home_server_option_list($ccdomain);
  504:         
  505: 	my %lt=&Apache::lonlocal::texthash(
  506:                     'cnu'  => "Create New User",
  507:                     'nu'   => "New User",
  508:                     'id'   => "in domain",
  509:                     'pd'   => "Personal Data",
  510:                     'fn'   => "First Name",
  511:                     'mn'   => "Middle Name",
  512:                     'ln'   => "Last Name",
  513:                     'gen'  => "Generation",
  514:                     'idsn' => "ID/Student Number",
  515:                     'hs'   => "Home Server",
  516:                     'lg'   => "Login Data"
  517: 				       );
  518:         my $portfolioform;
  519:         if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) {
  520:             # Current user has quota modification privileges
  521:             $portfolioform = &portfolio_quota($ccuname,$ccdomain);
  522:         }
  523: 	my $genhelp=&Apache::loncommon::help_open_topic('Generation');
  524:         &initialize_authen_forms();
  525: 	$r->print(<<ENDNEWUSER);
  526: $start_page
  527: <h1>$lt{'cnu'}</h1>
  528: $forminfo
  529: <h2>$lt{'nu'} "$ccuname" $lt{'id'} $ccdomain</h2>
  530: <script type="text/javascript" language="Javascript">
  531: $loginscript
  532: </script>
  533: <input type='hidden' name='makeuser' value='1' />
  534: <h3>$lt{'pd'}</h3>
  535: <p>
  536: <table>
  537: <tr><td>$lt{'fn'}  </td>
  538:     <td><input type='text' name='cfirst'  size='15' /></td></tr>
  539: <tr><td>$lt{'mn'} </td> 
  540:     <td><input type='text' name='cmiddle' size='15' /></td></tr>
  541: <tr><td>$lt{'ln'}   </td>
  542:     <td><input type='text' name='clast'   size='15' /></td></tr>
  543: <tr><td>$lt{'gen'}$genhelp</td>
  544:     <td><input type='text' name='cgen'    size='5'  /></td></tr>
  545: </table>
  546: $lt{'idsn'} <input type='text' name='cstid'   size='15' /></p>
  547: $lt{'hs'}: <select name="hserver" size="1"> $home_server_list </select>
  548: <hr />
  549: <h3>$lt{'lg'}</h3>
  550: <p>$generalrule </p>
  551: <p>$authformkrb </p>
  552: <p>$authformint </p>
  553: <p>$authformfsys</p>
  554: <p>$authformloc </p>
  555: <hr />
  556: $portfolioform
  557: ENDNEWUSER
  558:     } else { # user already exists
  559: 	my %lt=&Apache::lonlocal::texthash(
  560:                     'cup'  => "Change User Privileges",
  561:                     'usr'  => "User",                    
  562:                     'id'   => "in domain",
  563:                     'fn'   => "first name",
  564:                     'mn'   => "middle name",
  565:                     'ln'   => "last name",
  566:                     'gen'  => "generation"
  567: 				       );
  568: 	$r->print(<<ENDCHANGEUSER);
  569: $start_page
  570: <h1>$lt{'cup'}</h1>
  571: $forminfo
  572: <h2>$lt{'usr'} "$ccuname" $lt{'id'} "$ccdomain"</h2>
  573: ENDCHANGEUSER
  574:         # Get the users information
  575:         my %userenv = &Apache::lonnet::get('environment',
  576:                           ['firstname','middlename','lastname','generation',
  577:                            'portfolioquota'],$ccdomain,$ccuname);
  578:         my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname);
  579:         $r->print(<<END);
  580: <hr />
  581: <table border="2">
  582: <tr>
  583: <th>$lt{'fn'}</th><th>$lt{'mn'}</th><th>$lt{'ln'}</th><th>$lt{'gen'}</th>
  584: </tr>
  585: <tr>
  586: END
  587:         foreach ('firstname','middlename','lastname','generation') {
  588:            if (&Apache::lonnet::allowed('mau',$ccdomain)) {
  589:               $r->print(<<"END");            
  590: <td><input type="text" name="c$_" value="$userenv{$_}" size="15" /></td>
  591: END
  592:            } else {
  593:                $r->print('<td>'.$userenv{$_}.'</td>');
  594:            }
  595:         }
  596:       $r->print(<<END);
  597: </tr>
  598: </table>
  599: END
  600:         # Build up table of user roles to allow revocation of a role.
  601:         my ($tmp) = keys(%rolesdump);
  602:         unless ($tmp =~ /^(con_lost|error)/i) {
  603:            my $now=time;
  604: 	   my %lt=&Apache::lonlocal::texthash(
  605: 		    'rer'  => "Revoke Existing Roles",
  606:                     'rev'  => "Revoke",                    
  607:                     'del'  => "Delete",
  608: 		    'ren'  => "Re-Enable",
  609:                     'rol'  => "Role",
  610:                     'ext'  => "Extent",
  611:                     'sta'  => "Start",
  612:                     'end'  => "End"
  613: 				       );
  614:            my (%roletext,%sortrole,%roleclass,%rolepriv);
  615: 	   foreach my $area (sort { my $a1=join('_',(split('_',$a))[1,0]);
  616: 				    my $b1=join('_',(split('_',$b))[1,0]);
  617: 				    return $a1 cmp $b1;
  618: 				} keys(%rolesdump)) {
  619:                next if ($area =~ /^rolesdef/);
  620: 	       my $envkey=$area;
  621:                my $role = $rolesdump{$area};
  622:                my $thisrole=$area;
  623:                $area =~ s/\_\w\w$//;
  624:                my ($role_code,$role_end_time,$role_start_time) = 
  625:                    split(/_/,$role);
  626: # Is this a custom role? Get role owner and title.
  627: 	       my ($croleudom,$croleuname,$croletitle)=
  628: 	           ($role_code=~/^cr\/(\w+)\/(\w+)\/(\w+)$/);
  629:                my $bgcol='ffffff';
  630:                my $allowed=0;
  631:                my $delallowed=0;
  632: 	       my $sortkey=$role_code;
  633: 	       my $class='Unknown';
  634:                if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
  635: 		   $class='Course';
  636:                    my ($coursedom,$coursedir) = ($1,$2);
  637: 		   $sortkey.="\0$coursedom";
  638:                    # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
  639:                    my %coursedata=
  640:                        &Apache::lonnet::coursedescription($1.'_'.$2);
  641: 		   my $carea;
  642: 		   if (defined($coursedata{'description'})) {
  643: 		       $carea=$coursedata{'description'}.
  644:                            '<br />'.&mt('Domain').': '.$coursedom.('&nbsp;'x8).
  645:      &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
  646: 		       $sortkey.="\0".$coursedata{'description'};
  647:                        $class=$coursedata{'type'};
  648: 		   } else {
  649: 		       $carea=&mt('Unavailable course').': '.$area;
  650: 		       $sortkey.="\0".&mt('Unavailable course').': '.$area;
  651: 		   }
  652: 		   $sortkey.="\0$coursedir";
  653:                    $inccourses{$1.'_'.$2}=1;
  654:                    if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
  655:                        (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
  656:                        $allowed=1;
  657:                    }
  658:                    if ((&Apache::lonnet::allowed('dro',$1)) ||
  659:                        (&Apache::lonnet::allowed('dro',$ccdomain))) {
  660:                        $delallowed=1;
  661:                    }
  662: # - custom role. Needs more info, too
  663: 		   if ($croletitle) {
  664: 		       if (&Apache::lonnet::allowed('ccr',$1.'/'.$2)) {
  665: 			   $allowed=1;
  666: 			   $thisrole.='.'.$role_code;
  667: 		       }
  668: 		   }
  669:                    # Compute the background color based on $area
  670:                    $bgcol=$1.'_'.$2;
  671:                    $bgcol=~s/[^7-9a-e]//g;
  672:                    $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
  673:                    if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
  674:                        $carea.='<br />Section: '.$3;
  675: 		       $sortkey.="\0$3";
  676:                    }
  677:                    $area=$carea;
  678:                } else {
  679: 		   $sortkey.="\0".$area;
  680:                    # Determine if current user is able to revoke privileges
  681:                    if ($area=~ /^\/(\w+)\//) {
  682:                        if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
  683:                        (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
  684:                            $allowed=1;
  685:                        }
  686:                        if (((&Apache::lonnet::allowed('dro',$1))  ||
  687:                             (&Apache::lonnet::allowed('dro',$ccdomain))) &&
  688:                            ($role_code ne 'dc')) {
  689:                            $delallowed=1;
  690:                        }
  691:                    } else {
  692:                        if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
  693:                            $allowed=1;
  694:                        }
  695:                    }
  696: 		   if ($role_code eq 'ca' || $role_code eq 'au') {
  697: 		       $class='Construction Space';
  698: 		   } elsif ($role_code eq 'su') {
  699: 		       $class='System';
  700: 		   } else {
  701: 		       $class='Domain';
  702: 		   }
  703:                }
  704:                if (($role_code eq 'ca') || ($role_code eq 'aa')) {
  705:                    $area=~/\/(\w+)\/(\w+)/;
  706: 		   if (&authorpriv($2,$1)) {
  707: 		       $allowed=1;
  708:                    } else {
  709:                        $allowed=0;
  710:                    }
  711:                }
  712: 	       $bgcol='77FF77';
  713:                my $row = '';
  714:                $row.='<tr bgcolor="#'.$bgcol.'"><td>';
  715:                my $active=1;
  716:                $active=0 if (($role_end_time) && ($now>$role_end_time));
  717:                if (($active) && ($allowed)) {
  718:                    $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
  719:                } else {
  720:                    if ($active) {
  721:                       $row.='&nbsp;';
  722: 		   } else {
  723:                       $row.=&mt('expired or revoked');
  724: 		   }
  725:                }
  726: 	       $row.='</td><td>';
  727:                if ($allowed && !$active) {
  728:                    $row.= '<input type="checkbox" name="ren:'.$thisrole.'">';
  729:                } else {
  730:                    $row.='&nbsp;';
  731:                }
  732: 	       $row.='</td><td>';
  733:                if ($delallowed) {
  734:                    $row.= '<input type="checkbox" name="del:'.$thisrole.'">';
  735:                } else {
  736:                    $row.='&nbsp;';
  737:                }
  738: 	       my $plaintext='';
  739: 	       unless ($croletitle) {
  740:                    $plaintext=&Apache::lonnet::plaintext($role_code,$class)
  741: 	       } else {
  742: 	           $plaintext=
  743: 		"Customrole '$croletitle' defined by $croleuname\@$croleudom";
  744: 	       }
  745:                $row.= '</td><td>'.$plaintext.
  746:                       '</td><td>'.$area.
  747:                       '</td><td>'.($role_start_time?localtime($role_start_time)
  748:                                                    : '&nbsp;' ).
  749:                       '</td><td>'.($role_end_time  ?localtime($role_end_time)
  750:                                                    : '&nbsp;' )
  751:                       ."</td></tr>\n";
  752: 	       $sortrole{$sortkey}=$envkey;
  753: 	       $roletext{$envkey}=$row;
  754: 	       $roleclass{$envkey}=$class;
  755:                $rolepriv{$envkey}=$allowed;
  756:                #$r->print($row);
  757:            } # end of foreach        (table building loop)
  758:            my $rolesdisplay = 0;
  759:            my %output = ();
  760: 	   foreach my $type ('Construction Space','Course','Group','Domain','System','Unknown') {
  761: 	       $output{$type} = '';
  762: 	       foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
  763: 		   if ( ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/ ) && ($rolepriv{$sortrole{$which}}) ) { 
  764: 		       $output{$type}.=$roletext{$sortrole{$which}};
  765: 		   }
  766: 	       }
  767: 	       unless($output{$type} eq '') {
  768: 		   $output{$type} = "<tr bgcolor='#BBffBB'>".
  769: 			     "<td align='center' colspan='7'>".&mt($type)."</td>".
  770:                               $output{$type};
  771:                    $rolesdisplay = 1;
  772: 	       }
  773: 	   }
  774:            if ($rolesdisplay == 1) {
  775:                $r->print(<<END);
  776: <hr />
  777: <h3>$lt{'rer'}</h3>
  778: <table>
  779: <tr><th>$lt{'rev'}</th><th>$lt{'ren'}</th><th>$lt{'del'}</th><th>$lt{'rol'}</th><th>$lt{'e
  780: xt'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th>
  781: END
  782:                foreach my $type ('Construction Space','Course','Group','Domain','System','Unknown') {
  783:                    if ($output{$type}) {
  784:                        $r->print($output{$type}."\n");
  785:                    }
  786:                }
  787: 	       $r->print('</table>');
  788:            }
  789:         }  # End of unless
  790: 	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
  791: 	if ($currentauth=~/^krb(4|5):/) {
  792: 	    $currentauth=~/^krb(4|5):(.*)/;
  793: 	    my $krbdefdom=$2;
  794:             my %param = ( formname => 'document.cu',
  795:                           kerb_def_dom => $krbdefdom 
  796:                           );
  797:             $loginscript  = &Apache::loncommon::authform_header(%param);
  798: 	}
  799: 	# Check for a bad authentication type
  800:         unless ($currentauth=~/^krb(4|5):/ or
  801: 		$currentauth=~/^unix:/ or
  802: 		$currentauth=~/^internal:/ or
  803: 		$currentauth=~/^localauth:/
  804: 		) { # bad authentication scheme
  805: 	    if (&Apache::lonnet::allowed('mau',$ccdomain)) {
  806:                 &initialize_authen_forms();
  807: 		my %lt=&Apache::lonlocal::texthash(
  808:                                'err'   => "ERROR",
  809: 			       'uuas'  => "This user has an unrecognized authentication scheme",
  810:                                'sldb'  => "Please specify login data below",
  811:                                'ld'    => "Login Data"
  812: 						   );
  813: 		$r->print(<<ENDBADAUTH);
  814: <hr />
  815: <script type="text/javascript" language="Javascript">
  816: $loginscript
  817: </script>
  818: <font color='#ff0000'>$lt{'err'}:</font>
  819: $lt{'uuas'} ($currentauth). $lt{'sldb'}.
  820: <h3>$lt{'ld'}</h3>
  821: <p>$generalrule</p>
  822: <p>$authformkrb</p>
  823: <p>$authformint</p>
  824: <p>$authformfsys</p>
  825: <p>$authformloc</p>
  826: ENDBADAUTH
  827:             } else { 
  828:                 # This user is not allowed to modify the user's 
  829:                 # authentication scheme, so just notify them of the problem
  830: 		my %lt=&Apache::lonlocal::texthash(
  831:                                'err'   => "ERROR",
  832: 			       'uuas'  => "This user has an unrecognized authentication scheme",
  833:                                'adcs'  => "Please alert a domain coordinator of this situation"
  834: 						   );
  835: 		$r->print(<<ENDBADAUTH);
  836: <hr />
  837: <font color="#ff0000"> $lt{'err'}: </font>
  838: $lt{'uuas'} ($currentauth). $lt{'adcs'}.
  839: <hr />
  840: ENDBADAUTH
  841:             }
  842:         } else { # Authentication type is valid
  843: 	    my $authformcurrent='';
  844: 	    my $authform_other='';
  845:             &initialize_authen_forms();
  846: 	    if ($currentauth=~/^krb(4|5):/) {
  847: 		$authformcurrent=$authformkrb;
  848: 		$authform_other="<p>$authformint</p>\n".
  849:                     "<p>$authformfsys</p><p>$authformloc</p>";
  850: 	    }
  851: 	    elsif ($currentauth=~/^internal:/) {
  852: 		$authformcurrent=$authformint;
  853: 		$authform_other="<p>$authformkrb</p>".
  854:                     "<p>$authformfsys</p><p>$authformloc</p>";
  855: 	    }
  856: 	    elsif ($currentauth=~/^unix:/) {
  857: 		$authformcurrent=$authformfsys;
  858: 		$authform_other="<p>$authformkrb</p>".
  859:                     "<p>$authformint</p><p>$authformloc;</p>";
  860: 	    }
  861: 	    elsif ($currentauth=~/^localauth:/) {
  862: 		$authformcurrent=$authformloc;
  863: 		$authform_other="<p>$authformkrb</p>".
  864:                     "<p>$authformint</p><p>$authformfsys</p>";
  865: 	    }
  866:             $authformcurrent.=' <i>(will override current values)</i><br />';
  867:             if (&Apache::lonnet::allowed('mau',$ccdomain)) {
  868: 		# Current user has login modification privileges
  869: 		my %lt=&Apache::lonlocal::texthash(
  870:                                'ccld'  => "Change Current Login Data",
  871: 			       'enld'  => "Enter New Login Data"
  872: 						   );
  873: 		$r->print(<<ENDOTHERAUTHS);
  874: <hr />
  875: <script type="text/javascript" language="Javascript">
  876: $loginscript
  877: </script>
  878: <h3>$lt{'ccld'}</h3>
  879: <p>$generalrule</p>
  880: <p>$authformnop</p>
  881: <p>$authformcurrent</p>
  882: <h3>$lt{'enld'}</h3>
  883: $authform_other
  884: ENDOTHERAUTHS
  885:             } else {
  886:                 if (&Apache::lonnet::allowed('mau',$env{'request.role.domain'})) {
  887:                     my %lt=&Apache::lonlocal::texthash(
  888:                                'ccld'  => "Change Current Login Data",
  889:                                'yodo'  => "You do not have privileges to modify the authentication configuration for this user.",
  890:                                'ifch'  => "If a change is required, contact a domain coordinator for the domain",
  891:                     );
  892:                     $r->print(<<ENDNOPRIV);
  893: <hr />
  894: <h3>$lt{'ccld'}</h3>
  895: $lt{'yodo'} $lt{'ifch'}: $ccdomain 
  896: ENDNOPRIV
  897:                 } 
  898:             }
  899:             if (&Apache::lonnet::allowed('mpq',$env{'request.role.domain'})) {
  900:                 # Current user has quota modification privileges
  901:                 $r->print(&portfolio_quota($ccuname,$ccdomain));
  902:             }
  903:         }  ## End of "check for bad authentication type" logic
  904:     } ## End of new user/old user logic
  905:     $r->print('<hr /><h3>'.&mt('Add Roles').'</h3>');
  906: #
  907: # Co-Author
  908: # 
  909:     if (&authorpriv($env{'user.name'},$env{'request.role.domain'}) &&
  910:         ($env{'user.name'} ne $ccuname || $env{'user.domain'} ne $ccdomain)) {
  911:         # No sense in assigning co-author role to yourself
  912: 	my $cuname=$env{'user.name'};
  913:         my $cudom=$env{'request.role.domain'};
  914: 	   my %lt=&Apache::lonlocal::texthash(
  915: 		    'cs'   => "Construction Space",
  916:                     'act'  => "Activate",                    
  917:                     'rol'  => "Role",
  918:                     'ext'  => "Extent",
  919:                     'sta'  => "Start",
  920:                     'end'  => "End",
  921:                     'cau'  => "Co-Author",
  922:                     'caa'  => "Assistant Co-Author",
  923:                     'ssd'  => "Set Start Date",
  924:                     'sed'  => "Set End Date"
  925: 				       );
  926:        $r->print(<<ENDCOAUTH);
  927: <h4>$lt{'cs'}</h4>
  928: <table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
  929: <th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
  930: <tr>
  931: <td><input type=checkbox name="act_$cudom\_$cuname\_ca" /></td>
  932: <td>$lt{'cau'}</td>
  933: <td>$cudom\_$cuname</td>
  934: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value='' />
  935: <a href=
  936: "javascript:pjump('date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset')">$lt{'ssd'}</a></td>
  937: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value='' />
  938: <a href=
  939: "javascript:pjump('date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset')">$lt{'sed'}</a></td>
  940: </tr>
  941: <tr>
  942: <td><input type=checkbox name="act_$cudom\_$cuname\_aa" /></td>
  943: <td>$lt{'caa'}</td>
  944: <td>$cudom\_$cuname</td>
  945: <td><input type=hidden name="start_$cudom\_$cuname\_aa" value='' />
  946: <a href=
  947: "javascript:pjump('date_start','Start Date Assistant Co-Author',document.cu.start_$cudom\_$cuname\_aa.value,'start_$cudom\_$cuname\_aa','cu.pres','dateset')">$lt{'ssd'}</a></td>
  948: <td><input type=hidden name="end_$cudom\_$cuname\_aa" value='' />
  949: <a href=
  950: "javascript:pjump('date_end','End Date Assistant Co-Author',document.cu.end_$cudom\_$cuname\_aa.value,'end_$cudom\_$cuname\_aa','cu.pres','dateset')">$lt{'sed'}</a></td>
  951: </tr>
  952: </table>
  953: ENDCOAUTH
  954:     }
  955: #
  956: # Domain level
  957: #
  958:     my $num_domain_level = 0;
  959:     my $domaintext = 
  960:     '<h4>'.&mt('Domain Level').'</h4>'.
  961:     '<table border=2><tr><th>'.&mt('Activate').'</th><th>'.&mt('Role').'</th><th>'.&mt('Extent').'</th>'.
  962:     '<th>'.&mt('Start').'</th><th>'.&mt('End').'</th></tr>';
  963:     foreach ( sort( keys(%incdomains))) {
  964: 	my $thisdomain=$_;
  965:         foreach ('dc','li','dg','au','sc') {
  966:             if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
  967:                my $plrole=&Apache::lonnet::plaintext($_);
  968: 	       my %lt=&Apache::lonlocal::texthash(
  969:                     'ssd'  => "Set Start Date",
  970:                     'sed'  => "Set End Date"
  971: 				       );
  972:                $num_domain_level ++;
  973:                $domaintext .= <<"ENDDROW";
  974: <tr>
  975: <td><input type=checkbox name="act_$thisdomain\_$_"></td>
  976: <td>$plrole</td>
  977: <td>$thisdomain</td>
  978: <td><input type=hidden name="start_$thisdomain\_$_" value=''>
  979: <a href=
  980: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
  981: <td><input type=hidden name="end_$thisdomain\_$_" value=''>
  982: <a href=
  983: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
  984: </tr>
  985: ENDDROW
  986:             }
  987:         } 
  988:     }
  989:     $domaintext.='</table>';
  990:     if ($num_domain_level > 0) {
  991:         $r->print($domaintext);
  992:     }
  993: #
  994: # Course and group levels
  995: #
  996: 
  997:     if ($env{'request.role'} =~ m-^dc\./(\w+)/$-) {
  998:         $r->print(&course_level_dc($1,'Course'));
  999:         $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setCourse()">'."\n");
 1000:     } else {
 1001:         $r->print(&course_level_table(%inccourses));
 1002:         $r->print('<hr /><input type="button" value="'.&mt('Modify User').'" onClick="setSections()">'."\n");
 1003:     }
 1004:     $r->print("</form>".&Apache::loncommon::end_page());
 1005: }
 1006: 
 1007: # ================================================================= Phase Three
 1008: sub update_user_data {
 1009:     my $r=shift;
 1010:     my $uhome=&Apache::lonnet::homeserver($env{'form.ccuname'},
 1011:                                           $env{'form.ccdomain'});
 1012:     # Error messages
 1013:     my $error     = '<font color="#ff0000">'.&mt('Error').':</font>';
 1014:     my $end       = &Apache::loncommon::end_page();
 1015: 
 1016:     my $title;
 1017:     if (exists($env{'form.makeuser'})) {
 1018: 	$title='Set Privileges for New User';
 1019:     } else {
 1020:         $title='Modify User Privileges';
 1021:     }
 1022:     $r->print(&Apache::loncommon::start_page($title));
 1023:     my %disallowed;
 1024:     # Check Inputs
 1025:     if (! $env{'form.ccuname'} ) {
 1026: 	$r->print($error.&mt('No login name specified').'.'.$end);
 1027: 	return;
 1028:     }
 1029:     if (  $env{'form.ccuname'}  =~/\W/) {
 1030: 	$r->print($error.&mt('Invalid login name').'.  '.
 1031: 		  &mt('Only letters, numbers, and underscores are valid').'.'.
 1032: 		  $end);
 1033: 	return;
 1034:     }
 1035:     if (! $env{'form.ccdomain'}       ) {
 1036: 	$r->print($error.&mt('No domain specified').'.'.$end);
 1037: 	return;
 1038:     }
 1039:     if (  $env{'form.ccdomain'} =~/\W/) {
 1040: 	$r->print($error.&mt ('Invalid domain name').'.  '.
 1041: 		  &mt('Only letters, numbers, and underscores are valid').'.'.
 1042: 		  $end);
 1043: 	return;
 1044:     }
 1045:     if (! exists($env{'form.makeuser'})) {
 1046:         # Modifying an existing user, so check the validity of the name
 1047:         if ($uhome eq 'no_host') {
 1048:             $r->print($error.&mt('Unable to determine home server for ').
 1049:                       $env{'form.ccuname'}.&mt(' in domain ').
 1050:                       $env{'form.ccdomain'}.'.');
 1051:             return;
 1052:         }
 1053:     }
 1054:     # Determine authentication method and password for the user being modified
 1055:     my $amode='';
 1056:     my $genpwd='';
 1057:     if ($env{'form.login'} eq 'krb') {
 1058: 	$amode='krb';
 1059: 	$amode.=$env{'form.krbver'};
 1060: 	$genpwd=$env{'form.krbarg'};
 1061:     } elsif ($env{'form.login'} eq 'int') {
 1062: 	$amode='internal';
 1063: 	$genpwd=$env{'form.intarg'};
 1064:     } elsif ($env{'form.login'} eq 'fsys') {
 1065: 	$amode='unix';
 1066: 	$genpwd=$env{'form.fsysarg'};
 1067:     } elsif ($env{'form.login'} eq 'loc') {
 1068: 	$amode='localauth';
 1069: 	$genpwd=$env{'form.locarg'};
 1070: 	$genpwd=" " if (!$genpwd);
 1071:     } elsif (($env{'form.login'} eq 'nochange') ||
 1072:              ($env{'form.login'} eq ''        )) { 
 1073:         # There is no need to tell the user we did not change what they
 1074:         # did not ask us to change.
 1075:         # If they are creating a new user but have not specified login
 1076:         # information this will be caught below.
 1077:     } else {
 1078: 	    $r->print($error.&mt('Invalid login mode or password').$end);    
 1079: 	    return;
 1080:     }
 1081:     if ($env{'form.makeuser'}) {
 1082:         # Create a new user
 1083: 	my %lt=&Apache::lonlocal::texthash(
 1084:                     'cru'  => "Creating user",                    
 1085:                     'id'   => "in domain"
 1086: 					   );
 1087: 	$r->print(<<ENDNEWUSERHEAD);
 1088: <h3>$lt{'cru'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h3>
 1089: ENDNEWUSERHEAD
 1090:         # Check for the authentication mode and password
 1091:         if (! $amode || ! $genpwd) {
 1092: 	    $r->print($error.&mt('Invalid login mode or password').$end);    
 1093: 	    return;
 1094: 	}
 1095:         # Determine desired host
 1096:         my $desiredhost = $env{'form.hserver'};
 1097:         if (lc($desiredhost) eq 'default') {
 1098:             $desiredhost = undef;
 1099:         } else {
 1100:             my %home_servers = &Apache::loncommon::get_library_servers
 1101:                 ($env{'form.ccdomain'});  
 1102:             if (! exists($home_servers{$desiredhost})) {
 1103:                 $r->print($error.&mt('Invalid home server specified'));
 1104:                 return;
 1105:             }
 1106:         }
 1107: 	# Call modifyuser
 1108: 	my $result = &Apache::lonnet::modifyuser
 1109: 	    ($env{'form.ccdomain'},$env{'form.ccuname'},$env{'form.cstid'},
 1110:              $amode,$genpwd,$env{'form.cfirst'},
 1111:              $env{'form.cmiddle'},$env{'form.clast'},$env{'form.cgen'},
 1112:              undef,$desiredhost
 1113: 	     );
 1114: 	$r->print(&mt('Generating user').': '.$result);
 1115:         my $home = &Apache::lonnet::homeserver($env{'form.ccuname'},
 1116:                                                $env{'form.ccdomain'});
 1117:         $r->print('<br />'.&mt('Home server').': '.$home.' '.
 1118:                   $Apache::lonnet::libserv{$home});
 1119:     } elsif (($env{'form.login'} ne 'nochange') &&
 1120:              ($env{'form.login'} ne ''        )) {
 1121: 	# Modify user privileges
 1122:     my %lt=&Apache::lonlocal::texthash(
 1123:                     'usr'  => "User",                    
 1124:                     'id'   => "in domain"
 1125: 				       );
 1126: 	$r->print(<<ENDMODIFYUSERHEAD);
 1127: <h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
 1128: ENDMODIFYUSERHEAD
 1129:         if (! $amode || ! $genpwd) {
 1130: 	    $r->print($error.'Invalid login mode or password'.$end);    
 1131: 	    return;
 1132: 	}
 1133: 	# Only allow authentification modification if the person has authority
 1134: 	if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'})) {
 1135: 	    $r->print('Modifying authentication: '.
 1136:                       &Apache::lonnet::modifyuserauth(
 1137: 		       $env{'form.ccdomain'},$env{'form.ccuname'},
 1138:                        $amode,$genpwd));
 1139:             $r->print('<br />'.&mt('Home server').': '.&Apache::lonnet::homeserver
 1140: 		  ($env{'form.ccuname'},$env{'form.ccdomain'}));
 1141: 	} else {
 1142: 	    # Okay, this is a non-fatal error.
 1143: 	    $r->print($error.&mt('You do not have the authority to modify this users authentification information').'.');    
 1144: 	}
 1145:     }
 1146:     ##
 1147:     if (! $env{'form.makeuser'} ) {
 1148:         # Check for need to change
 1149:         my %userenv = &Apache::lonnet::get
 1150:             ('environment',['firstname','middlename','lastname','generation',
 1151:              'portfolioquota'],$env{'form.ccdomain'},$env{'form.ccuname'});
 1152:         my ($tmp) = keys(%userenv);
 1153:         if ($tmp =~ /^(con_lost|error)/i) { 
 1154:             %userenv = ();
 1155:         }
 1156:         # Check to see if we need to change user information
 1157:         foreach ('firstname','middlename','lastname','generation') {
 1158:             # Strip leading and trailing whitespace
 1159:             $env{'form.c'.$_} =~ s/(\s+$|^\s+)//g; 
 1160:         }
 1161:         my ($quotachanged,$namechanged,$oldportfolioquota);
 1162:         my %changeHash;
 1163:         if (exists($userenv{'portfolioquota'})) {
 1164:             $oldportfolioquota = $userenv{'portfolioquota'};
 1165:             if (exists($env{'form.portfolioquota'})) {
 1166:                 if ($env{'form.portfolioquota'} ne $userenv{'portfolioquota'}) {
 1167:                     if (&Apache::lonnet::allowed('mpq',$env{'form.ccdomain'})) {
 1168:                         # Current user has quota modification privileges
 1169:                         $quotachanged = 1;
 1170:                         $changeHash{'portfolioquota'} = $env{'form.portfolioquota'};
 1171:                     }
 1172:                 }
 1173:             }
 1174:         } else {
 1175:             $oldportfolioquota = &default_quota($env{'form.ccdomain'});
 1176:         }
 1177:         if (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}) && 
 1178:             ($env{'form.cfirstname'}  ne $userenv{'firstname'}  ||
 1179:              $env{'form.cmiddlename'} ne $userenv{'middlename'} ||
 1180:              $env{'form.clastname'}   ne $userenv{'lastname'}   ||
 1181:              $env{'form.cgeneration'} ne $userenv{'generation'} )) {
 1182:             $namechanged = 1;
 1183:         }
 1184:         if ($namechanged) {
 1185:             # Make the change
 1186:             $changeHash{'firstname'}  = $env{'form.cfirstname'};
 1187:             $changeHash{'middlename'} = $env{'form.cmiddlename'};
 1188:             $changeHash{'lastname'}   = $env{'form.clastname'};
 1189:             $changeHash{'generation'} = $env{'form.cgeneration'};
 1190:             my $putresult = &Apache::lonnet::put
 1191:                 ('environment',\%changeHash,
 1192:                  $env{'form.ccdomain'},$env{'form.ccuname'});
 1193:             if ($putresult eq 'ok') {
 1194:             # Tell the user we changed the name
 1195: 		my %lt=&Apache::lonlocal::texthash(
 1196:                              'uic'  => "User Information Changed",             
 1197:                              'frst' => "first",
 1198:                              'mddl' => "middle",
 1199:                              'lst'  => "last",
 1200: 			     'gen'  => "generation",
 1201:                              'disk' => "disk space allocated to portfolio files",
 1202:                              'prvs' => "Previous",
 1203:                              'chto' => "Changed To"
 1204: 						   );
 1205:                 $r->print(<<"END");
 1206: <table border="2">
 1207: <caption>$lt{'uic'}</caption>
 1208: <tr><th>&nbsp;</th>
 1209:     <th>$lt{'frst'}</th>
 1210:     <th>$lt{'mddl'}</th>
 1211:     <th>$lt{'lst'}</th>
 1212:     <th>$lt{'gen'}</th>
 1213:     <th>$lt{'disk'}<th></tr>
 1214: <tr><td>$lt{'prvs'}</td>
 1215:     <td>$userenv{'firstname'}  </td>
 1216:     <td>$userenv{'middlename'} </td>
 1217:     <td>$userenv{'lastname'}   </td>
 1218:     <td>$userenv{'generation'} </td>
 1219:     <td>$oldportfolioquota</td>
 1220: </tr>
 1221: <tr><td>$lt{'chto'}</td>
 1222:     <td>$env{'form.cfirstname'}  </td>
 1223:     <td>$env{'form.cmiddlename'} </td>
 1224:     <td>$env{'form.clastname'}   </td>
 1225:     <td>$env{'form.cgeneration'} </td>
 1226:     <td>$env{'form.portfolioquota'} Mb</td></tr>
 1227: </table>
 1228: END
 1229:             } else { # error occurred
 1230:                 $r->print("<h2>".&mt('Unable to successfully change environment for')." ".
 1231:                       $env{'form.ccuname'}." ".&mt('in domain')." ".
 1232:                       $env{'form.ccdomain'}."</h2>");
 1233:             }
 1234:         }  else { # End of if ($env ... ) logic
 1235:             my $putresult;
 1236:             if ($quotachanged) {
 1237:                 $putresult = &Apache::lonnet::put
 1238:                                  ('environment',\%changeHash,
 1239:                                   $env{'form.ccdomain'},$env{'form.ccuname'});
 1240:             }
 1241:             # They did not want to change the users name but we can
 1242:             # still tell them what the name is
 1243: 	    my %lt=&Apache::lonlocal::texthash(
 1244:                            'usr'  => "User",                    
 1245:                            'id'   => "in domain",
 1246:                            'gen'  => "Generation",
 1247:                            'disk' => "Disk space allocated to user's portfolio files",
 1248: 					       );
 1249:             $r->print(<<"END");
 1250: <h2>$lt{'usr'} "$env{'form.ccuname'}" $lt{'id'} "$env{'form.ccdomain'}"</h2>
 1251: <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
 1252: <h4>$lt{'gen'}: $userenv{'generation'}</h4>
 1253: END
 1254:             if ($putresult eq 'ok') {
 1255:                 if ($oldportfolioquota ne $env{'form.portfolioquota'}) {
 1256:                     $r->print('<h4>'.$lt{'disk'}.': '.$env{'form.portfolioquota'}.' Mb</h4>');
 1257:                 }
 1258:             }
 1259:         }
 1260:     }
 1261:     ##
 1262:     my $now=time;
 1263:     $r->print('<h3>'.&mt('Modifying Roles').'</h3>');
 1264:     foreach (keys (%env)) {
 1265: 	next if (! $env{$_});
 1266: 	# Revoke roles
 1267: 	if ($_=~/^form\.rev/) {
 1268: 	    if ($_=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
 1269: # Revoke standard role
 1270: 	        $r->print(&mt('Revoking').' '.$2.' in '.$1.': <b>'.
 1271:                      &Apache::lonnet::revokerole($env{'form.ccdomain'},
 1272:                      $env{'form.ccuname'},$1,$2).'</b><br />');
 1273: 		if ($2 eq 'st') {
 1274: 		    $1=~/^\/(\w+)\/(\w+)/;
 1275: 		    my $cid=$1.'_'.$2;
 1276: 		    $r->print(&mt('Drop from classlist').': <b>'.
 1277: 			 &Apache::lonnet::critical('put:'.
 1278:                              $env{'course.'.$cid.'.domain'}.':'.
 1279: 	                     $env{'course.'.$cid.'.num'}.':classlist:'.
 1280:                          &escape($env{'form.ccuname'}.':'.
 1281:                              $env{'form.ccdomain'}).'='.
 1282:                          &escape($now.':'),
 1283: 	                     $env{'course.'.$cid.'.home'}).'</b><br />');
 1284: 		}
 1285: 	    } 
 1286: 	    if ($_=~/^form\.rev\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {
 1287: # Revoke custom role
 1288: 		$r->print(&mt('Revoking custom role:').
 1289:                       ' '.$4.' by '.$3.'@'.$2.' in '.$1.': <b>'.
 1290:                       &Apache::lonnet::revokecustomrole($env{'form.ccdomain'},
 1291: 				  $env{'form.ccuname'},$1,$2,$3,$4).
 1292: 		'</b><br />');
 1293: 	    }
 1294: 	} elsif ($_=~/^form\.del/) {
 1295: 	    if ($_=~/^form\.del\:([^\_]+)\_([^\_\.]+)$/) {
 1296: # Delete standard role
 1297: 	        $r->print(&mt('Deleting').' '.$2.' in '.$1.': '.
 1298:                      &Apache::lonnet::assignrole($env{'form.ccdomain'},
 1299:                      $env{'form.ccuname'},$1,$2,$now,0,1).'<br />');
 1300: 		if ($2 eq 'st') {
 1301: 		    $1=~/^\/(\w+)\/(\w+)/;
 1302: 		    my $cid=$1.'_'.$2;
 1303: 		    $r->print(&mt('Drop from classlist').': <b>'.
 1304: 			 &Apache::lonnet::critical('put:'.
 1305:                              $env{'course.'.$cid.'.domain'}.':'.
 1306: 	                     $env{'course.'.$cid.'.num'}.':classlist:'.
 1307:                          &escape($env{'form.ccuname'}.':'.
 1308:                              $env{'form.ccdomain'}).'='.
 1309:                          &escape($now.':'),
 1310: 	                     $env{'course.'.$cid.'.home'}).'</b><br />');
 1311: 		}
 1312:             }
 1313:             if ($_=~/^form\.del\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {
 1314:                 my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
 1315: # Delete custom role
 1316:                 $r->print(&mt('Deleting custom role [_1] by [_2]@[_3] in [_4]',
 1317:                       $rolename,$rnam,$rdom,$url).': <b>'.
 1318:                       &Apache::lonnet::assigncustomrole($env{'form.ccdomain'},
 1319:                          $env{'form.ccuname'},$url,$rdom,$rnam,$rolename,$now,
 1320:                          0,1).'</b><br />');
 1321:             }
 1322: 	} elsif ($_=~/^form\.ren/) {
 1323:             my $udom = $env{'form.ccdomain'};
 1324:             my $uname = $env{'form.ccuname'};
 1325: # Re-enable standard role
 1326: 	    if ($_=~/^form\.ren\:([^\_]+)\_([^\_\.]+)$/) {
 1327:                 my $url = $1;
 1328:                 my $role = $2;
 1329:                 my $logmsg;
 1330:                 my $output;
 1331:                 if ($role eq 'st') {
 1332:                     if ($url =~ m-^/(\w+)/(\w+)/?(\w*)$-) {
 1333:                         my $result = &Apache::loncommon::commit_studentrole(\$logmsg,$udom,$uname,$url,$role,$now,0,$1,$2,$3);
 1334:                         if (($result =~ /^error/) || ($result eq 'not_in_class') || ($result eq 'unknown_course')) {
 1335:                             $output = "Error: $result\n";
 1336:                         } else {
 1337:                             $output = &mt('Assigning').' '.$role.' in '.$url.
 1338:                                       &mt('starting').' '.localtime($now).
 1339:                                       ': <br />'.$logmsg.'<br />'.
 1340:                                       &mt('Add to classlist').': <b>ok</b><br />';
 1341:                         }
 1342:                     }
 1343:                 } else {
 1344: 		    my $result=&Apache::lonnet::assignrole($env{'form.ccdomain'},
 1345:                                $env{'form.ccuname'},$url,$role,0,$now);
 1346: 		    $output = &mt('Re-enabling [_1] in [_2]: <b>[_3]</b>',
 1347: 			      $role,$url,$result).'<br />';
 1348: 		}
 1349:                 $r->print($output);
 1350: 	    }
 1351: # Re-enable custom role
 1352:             if ($_=~/^form\.ren\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {
 1353:                 my ($url,$rdom,$rnam,$rolename) = ($1,$2,$3,$4);
 1354:                 my $result = &Apache::lonnet::assigncustomrole(
 1355:                                $env{'form.ccdomain'}, $env{'form.ccuname'},
 1356:                                $url,$rdom,$rnam,$rolename,0,$now);
 1357:                 $r->print(&mt('Re-enabling custom role [_1] by [_2]@[_3] in [_4] : <b>[_5]</b>',
 1358:                           $rolename,$rnam,$rdom,$url,$result).'<br />');
 1359:             }
 1360: 	} elsif ($_=~/^form\.act/) {
 1361:             my $udom = $env{'form.ccdomain'};
 1362:             my $uname = $env{'form.ccuname'};
 1363: 	    if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) {
 1364:                 # Activate a custom role
 1365: 		my ($one,$two,$three,$four,$five)=($1,$2,$3,$4,$5);
 1366: 		my $url='/'.$one.'/'.$two;
 1367: 		my $full=$one.'_'.$two.'_cr_cr_'.$three.'_'.$four.'_'.$five;
 1368: 
 1369:                 my $start = ( $env{'form.start_'.$full} ?
 1370:                               $env{'form.start_'.$full} :
 1371:                               $now );
 1372:                 my $end   = ( $env{'form.end_'.$full} ?
 1373:                               $env{'form.end_'.$full} :
 1374:                               0 );
 1375:                                                                                      
 1376:                 # split multiple sections
 1377:                 my %sections = ();
 1378:                 my $num_sections = &build_roles($env{'form.sec_'.$full},\%sections,$5);
 1379:                 if ($num_sections == 0) {
 1380:                     $r->print(&Apache::loncommon::commit_customrole($udom,$uname,$url,$three,$four,$five,$start,$end));
 1381:                 } else {
 1382: 		    my %curr_groups =
 1383: 			&Apache::longroup::coursegroups($one,$two);
 1384:                     foreach my $sec (sort {$a cmp $b} keys %sections) {
 1385:                         if (($sec eq 'none') || ($sec eq 'all') || 
 1386:                             exists($curr_groups{$sec})) {
 1387:                             $disallowed{$sec} = $url;
 1388:                             next;
 1389:                         }
 1390:                         my $securl = $url.'/'.$sec;
 1391: 		        $r->print(&Apache::loncommon::commit_customrole($udom,$uname,$securl,$three,$four,$five,$start,$end));
 1392:                     }
 1393:                 }
 1394: 	    } elsif ($_=~/^form\.act\_([^\_]+)\_(\w+)\_([^\_]+)$/) {
 1395: 		# Activate roles for sections with 3 id numbers
 1396: 		# set start, end times, and the url for the class
 1397: 		my ($one,$two,$three)=($1,$2,$3);
 1398: 		my $start = ( $env{'form.start_'.$one.'_'.$two.'_'.$three} ? 
 1399: 			      $env{'form.start_'.$one.'_'.$two.'_'.$three} : 
 1400: 			      $now );
 1401: 		my $end   = ( $env{'form.end_'.$one.'_'.$two.'_'.$three} ? 
 1402: 			      $env{'form.end_'.$one.'_'.$two.'_'.$three} :
 1403: 			      0 );
 1404: 		my $url='/'.$one.'/'.$two;
 1405:                 my $type = 'three';
 1406:                 # split multiple sections
 1407:                 my %sections = ();
 1408:                 my $num_sections = &build_roles($env{'form.sec_'.$one.'_'.$two.'_'.$three},\%sections,$three);
 1409:                 if ($num_sections == 0) {
 1410:                     $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,''));
 1411:                 } else {
 1412:                     my %curr_groups = 
 1413: 			&Apache::longroup::coursegroups($one,$two);
 1414:                     my $emptysec = 0;
 1415:                     foreach my $sec (sort {$a cmp $b} keys %sections) {
 1416:                         $sec =~ s/\W//g;
 1417:                         if ($sec ne '') {
 1418:                             if (($sec eq 'none') || ($sec eq 'all') || 
 1419:                                 exists($curr_groups{$sec})) {
 1420:                                 $disallowed{$sec} = $url;
 1421:                                 next;
 1422:                             }
 1423:                             my $securl = $url.'/'.$sec;
 1424:                             $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$securl,$three,$start,$end,$one,$two,$sec));
 1425:                         } else {
 1426:                             $emptysec = 1;
 1427:                         }
 1428:                     }
 1429:                     if ($emptysec) {
 1430:                         $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$three,$start,$end,$one,$two,''));
 1431:                     }
 1432:                 } 
 1433: 	    } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
 1434: 		# Activate roles for sections with two id numbers
 1435: 		# set start, end times, and the url for the class
 1436: 		my $start = ( $env{'form.start_'.$1.'_'.$2} ? 
 1437: 			      $env{'form.start_'.$1.'_'.$2} : 
 1438: 			      $now );
 1439: 		my $end   = ( $env{'form.end_'.$1.'_'.$2} ? 
 1440: 			      $env{'form.end_'.$1.'_'.$2} :
 1441: 			      0 );
 1442: 		my $url='/'.$1.'/';
 1443:                 # split multiple sections
 1444:                 my %sections = ();
 1445:                 my $num_sections = &build_roles($env{'form.sec_'.$1.'_'.$2},\%sections,$2);
 1446:                 if ($num_sections == 0) {
 1447:                     $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$2,$start,$end,$1,undef,''));
 1448:                 } else {
 1449:                     my $emptysec = 0;
 1450:                     foreach my $sec (sort {$a cmp $b} keys %sections) {
 1451:                         if ($sec ne '') {
 1452:                             my $securl = $url.'/'.$sec;
 1453:                             $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$securl,$2,$start,$end,$1,undef,$sec));
 1454:                         } else {
 1455:                             $emptysec = 1;
 1456:                         }
 1457:                     }
 1458:                     if ($emptysec) {
 1459:                         $r->print(&Apache::loncommon::commit_standardrole($udom,$uname,$url,$2,$start,$end,$1,undef,''));
 1460:                     }
 1461:                 }
 1462: 	    } else {
 1463: 		$r->print('<p>'.&mt('ERROR').': '.&mt('Unknown command').' <tt>'.$_.'</tt></p><br />');
 1464:             }
 1465:             foreach my $key (sort(keys(%disallowed))) {
 1466:                 if (($key eq 'none') || ($key eq 'all')) {  
 1467:                     $r->print('<p>'.&mt('[_1] may not be used as the name for a section, as it is a reserved word.',$key));
 1468:                 } else {
 1469:                     $r->print('<p>'.&mt('[_1] may not be used as the name for a section, as it is the name of a course group.',$key));
 1470:                 }
 1471:                 $r->print(' '.&mt('Please <a href="javascript:history.go(-1)">go back</a> and choose a different section name.').'</p><br />');
 1472:             }
 1473: 	}
 1474:     } # End of foreach (keys(%env))
 1475: # Flush the course logs so reverse user roles immediately updated
 1476:     &Apache::lonnet::flushcourselogs();
 1477:     $r->print('<p><a href="/adm/createuser">Create/Modify Another User</a></p>');
 1478:     $r->print(&Apache::loncommon::end_page());
 1479: }
 1480: 
 1481: sub build_roles {
 1482:     my ($sectionstr,$sections,$role) = @_;
 1483:     my $num_sections = 0;
 1484:     if ($sectionstr=~ /,/) {
 1485:         my @secnums = split/,/,$sectionstr;
 1486:         if ($role eq 'st') {
 1487:             $secnums[0] =~ s/\W//g;
 1488:             $$sections{$secnums[0]} = 1;
 1489:             $num_sections = 1;
 1490:         } else {
 1491:             foreach my $sec (@secnums) {
 1492:                 $sec =~ ~s/\W//g;
 1493:                 unless ($sec eq "") {
 1494:                     if (exists($$sections{$sec})) {
 1495:                         $$sections{$sec} ++;
 1496:                     } else {
 1497:                         $$sections{$sec} = 1;
 1498:                         $num_sections ++;
 1499:                     }
 1500:                 }
 1501:             }
 1502:         }
 1503:     } else {
 1504:         $sectionstr=~s/\W//g;
 1505:         unless ($sectionstr eq '') {
 1506:             $$sections{$sectionstr} = 1;
 1507:             $num_sections ++;
 1508:         }
 1509:     }
 1510: 
 1511:     return $num_sections;
 1512: }
 1513: 
 1514: # ========================================================== Custom Role Editor
 1515: 
 1516: sub custom_role_editor {
 1517:     my $r=shift;
 1518:     my $rolename=$env{'form.rolename'};
 1519: 
 1520:     if ($rolename eq 'make new role') {
 1521: 	$rolename=$env{'form.newrolename'};
 1522:     }
 1523: 
 1524:     $rolename=~s/[^A-Za-z0-9]//gs;
 1525: 
 1526:     unless ($rolename) {
 1527: 	&print_username_entry_form($r);
 1528:         return;
 1529:     }
 1530: 
 1531:     $r->print(&Apache::loncommon::start_page('Custom Role Editor'));
 1532:     my $syspriv='';
 1533:     my $dompriv='';
 1534:     my $coursepriv='';
 1535:     my ($rdummy,$roledef)=
 1536: 			 &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
 1537: # ------------------------------------------------------- Does this role exist?
 1538:     $r->print('<h2>');
 1539:     if (($rdummy ne 'con_lost') && ($roledef ne '')) {
 1540: 	$r->print(&mt('Existing Role').' "');
 1541: # ------------------------------------------------- Get current role privileges
 1542: 	($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
 1543:     } else {
 1544: 	$r->print(&mt('New Role').' "');
 1545: 	$roledef='';
 1546:     }
 1547:     $r->print($rolename.'"</h2>');
 1548: # ------------------------------------------------------- What can be assigned?
 1549:     my %full=();
 1550:     my %courselevel=();
 1551:     my %courselevelcurrent=();
 1552:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
 1553: 	my ($priv,$restrict)=split(/\&/,$_);
 1554:         unless ($restrict) { $restrict='F'; }
 1555:         $courselevel{$priv}=$restrict;
 1556:         if ($coursepriv=~/\:$priv/) {
 1557: 	    $courselevelcurrent{$priv}=1;
 1558: 	}
 1559: 	$full{$priv}=1;
 1560:     }
 1561:     my %domainlevel=();
 1562:     my %domainlevelcurrent=();
 1563:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
 1564: 	my ($priv,$restrict)=split(/\&/,$_);
 1565:         unless ($restrict) { $restrict='F'; }
 1566:         $domainlevel{$priv}=$restrict;
 1567:         if ($dompriv=~/\:$priv/) {
 1568: 	    $domainlevelcurrent{$priv}=1;
 1569: 	}
 1570: 	$full{$priv}=1;
 1571:     }
 1572:     my %systemlevel=();
 1573:     my %systemlevelcurrent=();
 1574:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
 1575: 	my ($priv,$restrict)=split(/\&/,$_);
 1576:         unless ($restrict) { $restrict='F'; }
 1577:         $systemlevel{$priv}=$restrict;
 1578:         if ($syspriv=~/\:$priv/) {
 1579: 	    $systemlevelcurrent{$priv}=1;
 1580: 	}
 1581: 	$full{$priv}=1;
 1582:     }
 1583:     my %lt=&Apache::lonlocal::texthash(
 1584: 		    'prv'  => "Privilege",
 1585: 		    'crl'  => "Course Level",
 1586:                     'dml'  => "Domain Level",
 1587:                     'ssl'  => "System Level"
 1588: 				       );
 1589:     $r->print(<<ENDCCF);
 1590: <form method="post">
 1591: <input type="hidden" name="phase" value="set_custom_roles" />
 1592: <input type="hidden" name="rolename" value="$rolename" />
 1593: <table border="2">
 1594: <tr><th>$lt{'prv'}</th><th>$lt{'crl'}</th><th>$lt{'dml'}</th>
 1595: <th>$lt{'ssl'}</th></tr>
 1596: ENDCCF
 1597:     foreach my $priv (sort keys %full) {
 1598:         my $privtext = &Apache::lonnet::plaintext($priv);
 1599: 	$r->print('<tr><td>'.$privtext.'</td><td>'.
 1600:     ($courselevel{$priv}?'<input type="checkbox" name="'.$priv.':c" '.
 1601:     ($courselevelcurrent{$priv}?'checked="1"':'').' />':'&nbsp;').
 1602:     '</td><td>'.
 1603:     ($domainlevel{$priv}?'<input type="checkbox" name="'.$priv.':d" '.
 1604:     ($domainlevelcurrent{$priv}?'checked="1"':'').' />':'&nbsp;').
 1605:     '</td><td>'.
 1606:     ($systemlevel{$priv}?'<input type="checkbox" name="'.$priv.':s" '.
 1607:     ($systemlevelcurrent{$priv}?'checked="1"':'').' />':'&nbsp;').
 1608:     '</td></tr>');
 1609:     }
 1610:     $r->print(
 1611:    '<table><input type="submit" value="'.&mt('Define Role').'" /></form>'.
 1612: 	      &Apache::loncommon::end_page());
 1613: }
 1614: 
 1615: # ---------------------------------------------------------- Call to definerole
 1616: sub set_custom_role {
 1617:     my ($r) = @_;
 1618: 
 1619:     my $rolename=$env{'form.rolename'};
 1620: 
 1621:     $rolename=~s/[^A-Za-z0-9]//gs;
 1622: 
 1623:     unless ($rolename) {
 1624: 	&print_username_entry_form($r);
 1625:         return;
 1626:     }
 1627: 
 1628:     $r->print(&Apache::loncommon::start_page('Save Custom Role').'<h2>');
 1629:     my ($rdummy,$roledef)=
 1630: 	&Apache::lonnet::get('roles',["rolesdef_$rolename"]);
 1631: 
 1632: # ------------------------------------------------------- Does this role exist?
 1633:     if (($rdummy ne 'con_lost') && ($roledef ne '')) {
 1634: 	$r->print(&mt('Existing Role').' "');
 1635:     } else {
 1636: 	$r->print(&mt('New Role').' "');
 1637: 	$roledef='';
 1638:     }
 1639:     $r->print($rolename.'"</h2>');
 1640: # ------------------------------------------------------- What can be assigned?
 1641:     my $sysrole='';
 1642:     my $domrole='';
 1643:     my $courole='';
 1644: 
 1645:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
 1646: 	my ($priv,$restrict)=split(/\&/,$_);
 1647:         unless ($restrict) { $restrict=''; }
 1648:         if ($env{'form.'.$priv.':c'}) {
 1649: 	    $courole.=':'.$_;
 1650: 	}
 1651:     }
 1652: 
 1653:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
 1654: 	my ($priv,$restrict)=split(/\&/,$_);
 1655:         unless ($restrict) { $restrict=''; }
 1656:         if ($env{'form.'.$priv.':d'}) {
 1657: 	    $domrole.=':'.$_;
 1658: 	}
 1659:     }
 1660: 
 1661:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
 1662: 	my ($priv,$restrict)=split(/\&/,$_);
 1663:         unless ($restrict) { $restrict=''; }
 1664:         if ($env{'form.'.$priv.':s'}) {
 1665: 	    $sysrole.=':'.$_;
 1666: 	}
 1667:     }
 1668:     $r->print('<br />Defining Role: '.
 1669: 	   &Apache::lonnet::definerole($rolename,$sysrole,$domrole,$courole));
 1670:     if ($env{'request.course.id'}) {
 1671:         my $url='/'.$env{'request.course.id'};
 1672:         $url=~s/\_/\//g;
 1673: 	$r->print('<br />'.&mt('Assigning Role to Self').': '.
 1674: 	      &Apache::lonnet::assigncustomrole($env{'user.domain'},
 1675: 						$env{'user.name'},
 1676: 						$url,
 1677: 						$env{'user.domain'},
 1678: 						$env{'user.name'},
 1679: 						$rolename));
 1680:     }
 1681:     $r->print('<p><a href="/adm/createuser">Create another role, or Create/Modify a user.</a></p>');
 1682:     $r->print(&Apache::loncommon::end_page());
 1683: }
 1684: 
 1685: # ================================================================ Main Handler
 1686: sub handler {
 1687:     my $r = shift;
 1688: 
 1689:     if ($r->header_only) {
 1690:        &Apache::loncommon::content_type($r,'text/html');
 1691:        $r->send_http_header;
 1692:        return OK;
 1693:     }
 1694: 
 1695:     if ((&Apache::lonnet::allowed('cta',$env{'request.course.id'})) ||
 1696:         (&Apache::lonnet::allowed('cin',$env{'request.course.id'})) || 
 1697:         (&Apache::lonnet::allowed('ccr',$env{'request.course.id'})) || 
 1698:         (&Apache::lonnet::allowed('cep',$env{'request.course.id'})) ||
 1699: 	(&authorpriv($env{'user.name'},$env{'request.role.domain'})) ||
 1700:         (&Apache::lonnet::allowed('mau',$env{'request.role.domain'}))) {
 1701:        &Apache::loncommon::content_type($r,'text/html');
 1702:        $r->send_http_header;
 1703:        unless ($env{'form.phase'}) {
 1704: 	   &print_username_entry_form($r);
 1705:        }
 1706:        if ($env{'form.phase'} eq 'get_user_info') {
 1707:            &print_user_modification_page($r);
 1708:        } elsif ($env{'form.phase'} eq 'update_user_data') {
 1709:            &update_user_data($r);
 1710:        } elsif ($env{'form.phase'} eq 'selected_custom_edit') {
 1711:            &custom_role_editor($r);
 1712:        } elsif ($env{'form.phase'} eq 'set_custom_roles') {
 1713: 	   &set_custom_role($r);
 1714:        }
 1715:    } else {
 1716:       $env{'user.error.msg'}=
 1717:         "/adm/createuser:mau:0:0:Cannot modify user data";
 1718:       return HTTP_NOT_ACCEPTABLE; 
 1719:    }
 1720:    return OK;
 1721: } 
 1722: 
 1723: #-------------------------------------------------- functions for &phase_two
 1724: sub course_level_table {
 1725:     my (%inccourses) = @_;
 1726:     my $table = '';
 1727: # Custom Roles?
 1728: 
 1729:     my %customroles=&my_custom_roles();
 1730:     my %lt=&Apache::lonlocal::texthash(
 1731:             'exs'  => "Existing sections",
 1732:             'new'  => "Define new section",
 1733:             'ssd'  => "Set Start Date",
 1734:             'sed'  => "Set End Date",
 1735:             'crl'  => "Course Level",
 1736:             'act'  => "Activate",
 1737:             'rol'  => "Role",
 1738:             'ext'  => "Extent",
 1739:             'grs'  => "Section",
 1740:             'sta'  => "Start",
 1741:             'end'  => "End"
 1742:     );
 1743: 
 1744:     foreach (sort( keys(%inccourses))) {
 1745: 	my $thiscourse=$_;
 1746: 	my $protectedcourse=$_;
 1747: 	$thiscourse=~s:_:/:g;
 1748: 	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
 1749: 	my $area=$coursedata{'description'};
 1750:         my $type=$coursedata{'type'};
 1751: 	if (!defined($area)) { $area=&mt('Unavailable course').': '.$_; }
 1752: 	my $bgcol=$thiscourse;
 1753: 	$bgcol=~s/[^7-9a-e]//g;
 1754: 	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
 1755: 	my ($domain,$cnum)=split(/\//,$thiscourse);
 1756:         my %sections_count;
 1757:         if (defined($env{'request.course.id'})) {
 1758:             if ($env{'request.course.id'} eq $domain.'_'.$cnum) {
 1759:                 %sections_count = 
 1760: 		    &Apache::loncommon::get_sections($domain,$cnum);
 1761:             }
 1762:         }
 1763: 	foreach  ('st','ta','ep','in','cc') {
 1764: 	    if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
 1765: 		my $plrole=&Apache::lonnet::plaintext($_);
 1766: 		$table .= <<ENDEXTENT;
 1767: <tr bgcolor="#$bgcol">
 1768: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
 1769: <td>$plrole</td>
 1770: <td>$area<br />Domain: $domain</td>
 1771: ENDEXTENT
 1772: 	        if ($_ ne 'cc') {
 1773:                     if (%sections_count) {
 1774:                         my $currsec = &course_sections(\%sections_count,$protectedcourse.'_'.$_);
 1775:                         $table .= 
 1776:                     '<td><table border="0" cellspacing="0" cellpadding="0">'.
 1777:                      '<tr><td valign="top">'.$lt{'exs'}.'<br />'.
 1778:                         $currsec.'</td>'.
 1779:                      '<td>&nbsp;&nbsp;</td>'.
 1780:                      '<td valign="top">&nbsp;'.$lt{'new'}.'<br />'.
 1781:                      '<input type="text" name="newsec_'.$protectedcourse.'_'.$_.'" value="" /></td>'.
 1782:                      '<input type="hidden" '.
 1783:                      'name="sec_'.$protectedcourse.'_'.$_.'"></td>'.
 1784:                      '</tr></table></td>';
 1785:                     } else {
 1786:                         $table .= '<td><input type="text" size="10" '.
 1787:                      'name="sec_'.$protectedcourse.'_'.$_.'"></td>';
 1788:                     }
 1789:                 } else { 
 1790: 		    $table .= '<td>&nbsp</td>';
 1791:                 }
 1792: 		$table .= <<ENDTIMEENTRY;
 1793: <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
 1794: <a href=
 1795: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">$lt{'ssd'}</a></td>
 1796: <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
 1797: <a href=
 1798: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">$lt{'sed'}</a></td>
 1799: ENDTIMEENTRY
 1800:                 $table.= "</tr>\n";
 1801:             }
 1802:         }
 1803:         foreach (sort keys %customroles) {
 1804: 	    if (&Apache::lonnet::allowed('ccr',$thiscourse)) {
 1805: 		my $plrole=$_;
 1806:                 my $customrole=$protectedcourse.'_cr_cr_'.$env{'user.domain'}.
 1807: 		    '_'.$env{'user.name'}.'_'.$plrole;
 1808: 		$table .= <<END;
 1809: <tr bgcolor="#$bgcol">
 1810: <td><input type="checkbox" name="act_$customrole"></td>
 1811: <td>$plrole</td>
 1812: <td>$area</td>
 1813: END
 1814:                 if (%sections_count) {
 1815:                     my $currsec = &course_sections(\%sections_count,$customrole);
 1816:                     $table.=
 1817:                    '<td><table border="0" cellspacing="0" cellpadding="0">'.
 1818:                    '<tr><td valign="top">'.$lt{'exs'}.'<br />'.
 1819:                      $currsec.'</td>'.
 1820:                    '<td>&nbsp;&nbsp;</td>'.
 1821:                    '<td valign="top">&nbsp;'.$lt{'new'}.'<br />'.
 1822:                    '<input type="text" name="newsec_'.$customrole.'" value="" /></td>'.
 1823:                    '<input type="hidden" '.
 1824:                    'name="sec_'.$customrole.'"></td>'.
 1825:                    '</tr></table></td>';
 1826:                 } else {
 1827:                     $table .= '<td><input type="text" size="10" '.
 1828:                      'name="sec_'.$customrole.'"></td>';
 1829:                 }
 1830:                 $table .= <<ENDENTRY;
 1831: <td><input type=hidden name="start_$customrole" value=''>
 1832: <a href=
 1833: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$customrole.value,'start_$customrole','cu.pres','dateset')">$lt{'ssd'}</a></td>
 1834: <td><input type=hidden name="end_$customrole" value=''>
 1835: <a href=
 1836: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$customrole.value,'end_$customrole','cu.pres','dateset')">$lt{'sed'}</a></td></tr>
 1837: ENDENTRY
 1838:            }
 1839: 	}
 1840:     }
 1841:     return '' if ($table eq ''); # return nothing if there is nothing 
 1842:                                  # in the table
 1843:     my $result = <<ENDTABLE;
 1844: <h4>$lt{'crl'}</h4>
 1845: <table border=2><tr><th>$lt{'act'}</th><th>$lt{'rol'}</th><th>$lt{'ext'}</th>
 1846: <th>$lt{'grs'}</th><th>$lt{'sta'}</th><th>$lt{'end'}</th></tr>
 1847: $table
 1848: </table>
 1849: ENDTABLE
 1850:     return $result;
 1851: }
 1852: 
 1853: sub course_sections {
 1854:     my ($sections_count,$role) = @_;
 1855:     my $output = '';
 1856:     my @sections = (sort {$a <=> $b} keys %{$sections_count});
 1857:     if (scalar(@sections) == 1) {
 1858:         $output = '<select name="currsec_'.$role.'" >'."\n".
 1859:                   '  <option value="">Select</option>'."\n".
 1860:                   '  <option value="">No section</option>'."\n".
 1861:                   '  <option value="'.$sections[0].'" >'.$sections[0].'</option>'."\n";
 1862:     } else {
 1863:         $output = '<select name="currsec_'.$role.'" ';
 1864:         my $multiple = 4;
 1865:         if (scalar(@sections) < 4) { $multiple = scalar(@sections); }
 1866:         $output .= '"multiple" size="'.$multiple.'">'."\n";
 1867:         foreach (@sections) {
 1868:             $output .= '<option value="'.$_.'">'.$_."</option>\n";
 1869:         }
 1870:     }
 1871:     $output .= '</select>'; 
 1872:     return $output;
 1873: }
 1874: 
 1875: sub course_level_dc {
 1876:     my ($dcdom) = @_;
 1877:     my %customroles=&my_custom_roles();
 1878:     my $hiddenitems = '<input type="hidden" name="dcdomain" value="'.$dcdom.'" />'.
 1879:                       '<input type="hidden" name="origdom" value="'.$dcdom.'" />'.
 1880:                       '<input type="hidden" name="dccourse" value="" />';
 1881:     my $courseform='<b>'.&Apache::loncommon::selectcourse_link
 1882:             ('cu','dccourse','dcdomain','coursedesc',undef,undef,'Course').'</b>';
 1883:     my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($dcdom,'currsec','cu');
 1884:     my %lt=&Apache::lonlocal::texthash(
 1885:                     'typ' => "Type",
 1886:                     'rol'  => "Role",
 1887:                     'grs'  => "Section",
 1888:                     'exs'  => "Existing sections",
 1889:                     'new'  => "Define new section", 
 1890:                     'sta'  => "Start",
 1891:                     'end'  => "End",
 1892:                     'ssd'  => "Set Start Date",
 1893:                     'sed'  => "Set End Date"
 1894:                   );
 1895:     my $header = '<h4>'.&mt('Course Level').'</h4>'.
 1896:                  '<table border="2"><tr><th>'.$lt{'typ'}.'</th><th>'.$courseform.'</th><th>'.$lt{'rol'}.'</th><th>'.$lt{'grs'}.'</th><th>'.$lt{'sta'}.'</th><th>'.$lt{'end'}.'</th></tr>';
 1897:     my $otheritems = '<tr><td><select name="crstype" onChange="javascript:setType();">'."\n".
 1898:                      ' <option value="">'.&mt('Please select')."\n".
 1899:                      ' <option value="Course">'.&mt('Course')."\n".
 1900:                      ' <option value="Non-standard course">'.&mt('Non-standard course')."\n".
 1901:                      '</select>'."\n".
 1902:                      '<td><input type="text" name="coursedesc" value="" onFocus="this.blur();opencrsbrowser('."'cu','dccourse','dcdomain','coursedesc',''".')" /></td>'."\n".
 1903:                      '<td><select name="role">'."\n";
 1904:     foreach  ('st','ta','ep','in','cc') {
 1905:         my $plrole=&Apache::lonnet::plaintext($_);
 1906:         $otheritems .= '  <option value="'.$_.'">'.$plrole;
 1907:     }
 1908:     if ( keys %customroles > 0) {
 1909:         foreach (sort keys %customroles) {
 1910:             my $custrole='cr_cr_'.$env{'user.domain'}.
 1911:                     '_'.$env{'user.name'}.'_'.$_;
 1912:             $otheritems .= '  <option value="'.$custrole.'">'.$_;
 1913:         }
 1914:     }
 1915:     $otheritems .= '</select></td><td>'.
 1916:                      '<table border="0" cellspacing="0" cellpadding="0">'.
 1917:                      '<tr><td valign="top"><b>'.$lt{'exs'}.'</b><br /><select name="currsec">'.
 1918:                      ' <option value=""><--'.&mt('Pick course first').'</select></td>'.
 1919:                      '<td>&nbsp;&nbsp;</td>'.
 1920:                      '<td valign="top">&nbsp;<b>'.$lt{'new'}.'</b><br />'.
 1921:                      '<input type="text" name="newsec" value="" />'.
 1922:                      '<input type="hidden" name="groups" value="" /></td>'.
 1923:                      '</tr></table></td>';
 1924:     $otheritems .= <<ENDTIMEENTRY;
 1925: <td><input type=hidden name="start" value=''>
 1926: <a href=
 1927: "javascript:pjump('date_start','Start Date',document.cu.start.value,'start','cu.pres','dateset')">$lt{'ssd'}</a></td>
 1928: <td><input type=hidden name="end" value=''>
 1929: <a href=
 1930: "javascript:pjump('date_end','End Date',document.cu.end.value,'end','cu.pres','dateset')">$lt{'sed'}</a></td>
 1931: ENDTIMEENTRY
 1932:     $otheritems .= "</tr></table>\n";
 1933:     return $cb_jscript.$header.$hiddenitems.$otheritems;
 1934: }
 1935: 
 1936: #---------------------------------------------- end functions for &phase_two
 1937: 
 1938: #--------------------------------- functions for &phase_two and &phase_three
 1939: 
 1940: #--------------------------end of functions for &phase_two and &phase_three
 1941: 
 1942: 1;
 1943: __END__
 1944: 
 1945: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>