File:  [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.65: download - view: text, annotated - select for diffs
Sun Jul 20 00:39:01 2003 UTC (20 years, 10 months ago) by www
Branches: MAIN
CVS tags: version_1_0_3, version_1_0_2, version_1_0_1, version_1_0_0, version_0_99_5, version_0_99_4, HEAD
Fixed bug #795: handling of custom roles in CUSR

    1: # The LearningOnline Network with CAPA
    2: # Create a user
    3: #
    4: # $Id: loncreateuser.pm,v 1.65 2003/07/20 00:39:01 www 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: use strict;
   33: use Apache::Constants qw(:common :http);
   34: use Apache::lonnet;
   35: use Apache::loncommon;
   36: 
   37: my $loginscript; # piece of javascript used in two separate instances
   38: my $generalrule;
   39: my $authformnop;
   40: my $authformkrb;
   41: my $authformint;
   42: my $authformfsys;
   43: my $authformloc;
   44: 
   45: BEGIN {
   46:     $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
   47:     my $krbdefdom=$1;
   48:     $krbdefdom=~tr/a-z/A-Z/;
   49:     my %param = ( formname => 'document.cu',
   50:                   kerb_def_dom => $krbdefdom 
   51:                   );
   52: # no longer static due to configurable kerberos defaults
   53: #    $loginscript  = &Apache::loncommon::authform_header(%param);
   54:     $generalrule  = &Apache::loncommon::authform_authorwarning(%param);
   55:     $authformnop  = &Apache::loncommon::authform_nochange(%param);
   56: # no longer static due to configurable kerberos defaults
   57: #    $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
   58:     $authformint  = &Apache::loncommon::authform_internal(%param);
   59:     $authformfsys = &Apache::loncommon::authform_filesystem(%param);
   60:     $authformloc  = &Apache::loncommon::authform_local(%param);
   61: }
   62: 
   63: 
   64: # ======================================================= Existing Custom Roles
   65: 
   66: sub my_custom_roles {
   67:     my %returnhash=();
   68:     my %rolehash=&Apache::lonnet::dump('roles');
   69:     foreach (keys %rolehash) {
   70: 	if ($_=~/^rolesdef\_(\w+)$/) {
   71: 	    $returnhash{$1}=$1;
   72: 	}
   73:     }
   74:     return %returnhash;
   75: }
   76: 
   77: # ==================================================== Figure out author access
   78: 
   79: sub authorpriv {
   80:     my ($auname,$audom)=@_;
   81:     if (($auname ne $ENV{'user.name'}) ||
   82:         (($audom ne $ENV{'user.domain'}) &&
   83:          ($audom ne $ENV{'request.role.domain'}))) { return ''; }
   84:     unless (&Apache::lonnet::allowed('cca',$audom)) { return ''; }
   85:     return 1;
   86: }
   87: 
   88: # =================================================================== Phase one
   89: 
   90: sub print_username_entry_form {
   91:     my $r=shift;
   92:     my $defdom=$ENV{'request.role.domain'};
   93:     my @domains = &Apache::loncommon::get_domains();
   94:     my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
   95:     my $bodytag =&Apache::loncommon::bodytag(
   96:                                   'Create Users, Change User Privileges');
   97:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
   98:     my $sellink=&Apache::loncommon::selectstudent_link
   99:                                         ('crtuser','ccuname','ccdomain');
  100:     my %existingroles=&my_custom_roles();
  101:     my $choice=&Apache::loncommon::select_form('make new role','rolename',
  102: 		('make new role' => 'Generate new role ...',%existingroles));
  103:     $r->print(<<"ENDDOCUMENT");
  104: <html>
  105: <head>
  106: <title>The LearningOnline Network with CAPA</title>
  107: $selscript
  108: </head>
  109: $bodytag
  110: <form action="/adm/createuser" method="post" name="crtuser">
  111: <input type="hidden" name="phase" value="get_user_info">
  112: <h2>Set Individual User Roles</h2>
  113: <table>
  114: <tr><td>Username:</td><td><input type="text" size="15" name="ccuname">
  115: </td><td rowspan="2">$sellink</td></tr><tr><td>
  116: Domain:</td><td>$domform</td></tr>
  117: </table>
  118: <input name="userrole" type="submit" value="User Roles" />
  119: </form>
  120: <form action="/adm/createuser" method="post" name="docustom">
  121: <input type="hidden" name="phase" value="selected_custom_edit">
  122: <h2>Edit Custom Role Privileges</h2>
  123: Name of Role: $choice <input type="text" size="15" name="newrolename" /><br />
  124: <input name="customeditor" type="submit" value="Custom Role Editor" />
  125: </body>
  126: </html>
  127: ENDDOCUMENT
  128: }
  129: 
  130: # =================================================================== Phase two
  131: sub print_user_modification_page {
  132:     my $r=shift;
  133:     my $ccuname=$ENV{'form.ccuname'};
  134:     my $ccdomain=$ENV{'form.ccdomain'};
  135: 
  136:     $ccuname=~s/\W//gs;
  137:     $ccdomain=~s/\W//gs;
  138: 
  139:     unless (($ccuname) && ($ccdomain)) {
  140: 	&print_username_entry_form($r);
  141:         return;
  142:     }
  143: 
  144:     my $defdom=$ENV{'request.role.domain'};
  145: 
  146:     my ($krbdef,$krbdefdom) =
  147:        &Apache::loncommon::get_kerberos_defaults($defdom);
  148: 
  149:     my %param = ( formname => 'document.cu',
  150:                   kerb_def_dom => $krbdefdom,
  151:                   kerb_def_auth => $krbdef
  152:                   );
  153:     $loginscript  = &Apache::loncommon::authform_header(%param);
  154:     $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
  155: 
  156:     $ccuname=~s/\W//g;
  157:     $ccdomain=~s/\W//g;
  158:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
  159:     my $dochead =<<"ENDDOCHEAD";
  160: <html>
  161: <head>
  162: <title>The LearningOnline Network with CAPA</title>
  163: <script type="text/javascript" language="Javascript">
  164: 
  165:     function pclose() {
  166:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
  167:                  "height=350,width=350,scrollbars=no,menubar=no");
  168:         parmwin.close();
  169:     }
  170: 
  171:     $pjump_def
  172: 
  173:     function dateset() {
  174:         eval("document.cu."+document.cu.pres_marker.value+
  175:             ".value=document.cu.pres_value.value");
  176:         pclose();
  177:     }
  178: 
  179: </script>
  180: </head>
  181: ENDDOCHEAD
  182:     $r->print(&Apache::loncommon::bodytag(
  183:                                      'Create Users, Change User Privileges'));
  184:     my $forminfo =<<"ENDFORMINFO";
  185: <form action="/adm/createuser" method="post" name="cu">
  186: <input type="hidden" name="phase"       value="update_user_data">
  187: <input type="hidden" name="ccuname"     value="$ccuname">
  188: <input type="hidden" name="ccdomain"    value="$ccdomain">
  189: <input type="hidden" name="pres_value"  value="" >
  190: <input type="hidden" name="pres_type"   value="" >
  191: <input type="hidden" name="pres_marker" value="" >
  192: ENDFORMINFO
  193:     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
  194:     my %incdomains; 
  195:     my %inccourses;
  196:     foreach (values(%Apache::lonnet::hostdom)) {
  197:        $incdomains{$_}=1;
  198:     }
  199:     foreach (keys(%ENV)) {
  200: 	if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
  201: 	    $inccourses{$1.'_'.$2}=1;
  202:         }
  203:     }
  204:     if ($uhome eq 'no_host') {
  205:         my $home_server_list=
  206:             '<option value="default" selected>default</option>'."\n".
  207:                 &Apache::loncommon::home_server_option_list($ccdomain);
  208:         
  209: 	$r->print(<<ENDNEWUSER);
  210: $dochead
  211: <h1>Create New User</h1>
  212: $forminfo
  213: <h2>New user "$ccuname" in domain $ccdomain</h2>
  214: <script type="text/javascript" language="Javascript">
  215: $loginscript
  216: </script>
  217: <input type='hidden' name='makeuser' value='1' />
  218: <h3>Personal Data</h3>
  219: <p>
  220: <table>
  221: <tr><td>First Name  </td>
  222:     <td><input type='text' name='cfirst'  size='15' /></td></tr>
  223: <tr><td>Middle Name </td> 
  224:     <td><input type='text' name='cmiddle' size='15' /></td></tr>
  225: <tr><td>Last Name   </td>
  226:     <td><input type='text' name='clast'   size='15' /></td></tr>
  227: <tr><td>Generation  </td>
  228:     <td><input type='text' name='cgen'    size='5'  /></td></tr>
  229: </table>
  230: ID/Student Number <input type='text' name='cstid'   size='15' /></p>
  231: Home Server: <select name="hserver" size="1"> $home_server_list </select>
  232: <hr />
  233: <h3>Login Data</h3>
  234: <p>$generalrule </p>
  235: <p>$authformkrb </p>
  236: <p>$authformint </p>
  237: <p>$authformfsys</p>
  238: <p>$authformloc </p>
  239: ENDNEWUSER
  240:     } else { # user already exists
  241: 	$r->print(<<ENDCHANGEUSER);
  242: $dochead
  243: <h1>Change User Privileges</h1>
  244: $forminfo
  245: <h2>User "$ccuname" in domain "$ccdomain"</h2>
  246: ENDCHANGEUSER
  247:         # Get the users information
  248:         my %userenv = &Apache::lonnet::get('environment',
  249:                           ['firstname','middlename','lastname','generation'],
  250:                           $ccdomain,$ccuname);
  251:         my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname);
  252:         $r->print(<<END);
  253: <hr />
  254: <table border="2">
  255: <tr>
  256: <th>first name</th><th>middle name</th><th>last name</th><th>generation</th>
  257: </tr>
  258: <tr>
  259: END
  260:         foreach ('firstname','middlename','lastname','generation') {
  261:            if (&Apache::lonnet::allowed('mau',$ccdomain)) {
  262:               $r->print(<<"END");            
  263: <td><input type="text" name="c$_" value="$userenv{$_}" size="15" /></td>
  264: END
  265:            } else {
  266:                $r->print('<td>'.$userenv{$_}.'</td>');
  267:            }
  268:         }
  269:         $r->print(<<END);
  270: </tr>
  271: </table>
  272: END
  273:         # Build up table of user roles to allow revocation of a role.
  274:         my ($tmp) = keys(%rolesdump);
  275:         unless ($tmp =~ /^(con_lost|error)/i) {
  276:            my $now=time;
  277:            $r->print(<<END);
  278: <hr />
  279: <h3>Revoke Existing Roles</h3>
  280: <table border=2>
  281: <tr><th>Revoke</th><th>Delete</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>
  282: END
  283: 	   foreach my $area (sort keys(%rolesdump)) {
  284:                next if ($area =~ /^rolesdef/);
  285:                my $role = $rolesdump{$area};
  286:                my $thisrole=$area;
  287:                $area =~ s/\_\w\w$//;
  288:                my ($role_code,$role_end_time,$role_start_time) = 
  289:                    split(/_/,$role);
  290: # Is this a custom role? Get role owner and title.
  291: 	       my ($croleudom,$croleuname,$croletitle)=
  292: 	           ($role_code=~/^cr\/(\w+)\/(\w+)\/(\w+)$/);
  293:                my $bgcol='ffffff';
  294:                my $allowed=0;
  295:                my $delallowed=0;
  296:                if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
  297:                    my ($coursedom,$coursedir) = ($1,$2);
  298:                    # $1.'_'.$2 is the course id (eg. 103_12345abcef103l3).
  299:                    my %coursedata=
  300:                        &Apache::lonnet::coursedescription($1.'_'.$2);
  301: 		   my $carea;
  302: 		   if (defined($coursedata{'description'})) {
  303: 		       $carea='Course: '.$coursedata{'description'}.
  304:                            '<br />Domain: '.$coursedom.('&nbsp;'x8).
  305:      &Apache::loncommon::syllabuswrapper('Syllabus',$coursedir,$coursedom);
  306: 		   } else {
  307: 		       $carea='Unavailable course: '.$area;
  308: 		   }
  309:                    $inccourses{$1.'_'.$2}=1;
  310:                    if ((&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) ||
  311:                        (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
  312:                        $allowed=1;
  313:                    }
  314:                    if ((&Apache::lonnet::allowed('dro',$1)) ||
  315:                        (&Apache::lonnet::allowed('dro',$ccdomain))) {
  316:                        $delallowed=1;
  317:                    }
  318: # - custom role. Needs more info, too
  319: 		   if ($croletitle) {
  320: 		       if (&Apache::lonnet::allowed('ccr',$1.'/'.$2)) {
  321: 			   $allowed=1;
  322: 			   $thisrole.='.'.$role_code;
  323: 		       }
  324: 		   }
  325:                    # Compute the background color based on $area
  326:                    $bgcol=$1.'_'.$2;
  327:                    $bgcol=~s/[^7-9a-e]//g;
  328:                    $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
  329:                    if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
  330:                        $carea.='<br>Section/Group: '.$3;
  331:                    }
  332:                    $area=$carea;
  333:                } else {
  334:                    # Determine if current user is able to revoke privileges
  335:                    if ($area=~ /^\/(\w+)\//) {
  336:                        if ((&Apache::lonnet::allowed('c'.$role_code,$1)) ||
  337:                        (&Apache::lonnet::allowed('c'.$role_code,$ccdomain))) {
  338:                            $allowed=1;
  339:                        }
  340:                        if (((&Apache::lonnet::allowed('dro',$1))  ||
  341:                             (&Apache::lonnet::allowed('dro',$ccdomain))) &&
  342:                            ($role_code ne 'dc')) {
  343:                            $delallowed=1;
  344:                        }
  345:                    } else {
  346:                        if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
  347:                            $allowed=1;
  348:                        }
  349:                    }
  350:                }
  351:                if ($role_code eq 'ca') {
  352:                    $area=~/\/(\w+)\/(\w+)/;
  353: 		   if (&authorpriv($2,$1)) {
  354: 		       $allowed=1;
  355:                    } else {
  356:                        $allowed=0;
  357:                    }
  358:                }
  359:                my $row = '';
  360:                $row.='<tr bgcolor="#'.$bgcol.'"><td>';
  361:                my $active=1;
  362:                $active=0 if (($role_end_time) && ($now>$role_end_time));
  363:                if (($active) && ($allowed)) {
  364:                    $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
  365:                } else {
  366:                    if ($active) {
  367:                       $row.='&nbsp;';
  368: 		   } else {
  369:                       $row.='expired or revoked';
  370: 		   }
  371:                }
  372: 	       $row.='</td><td>';
  373:                if ($delallowed) {
  374:                    $row.= '<input type="checkbox" name="del:'.$thisrole.'">';
  375:                } else {
  376:                    $row.='&nbsp;';
  377:                }
  378: 	       my $plaintext='';
  379: 	       unless ($croletitle) {
  380: 		   $plaintext=&Apache::lonnet::plaintext($role_code);
  381: 	       } else {
  382: 	           $plaintext=
  383: 		"Customrole '$croletitle' defined by $croleuname\@$croleudom";
  384: 	       }
  385:                $row.= '</td><td>'.$plaintext.
  386:                       '</td><td>'.$area.
  387:                       '</td><td>'.($role_start_time?localtime($role_start_time)
  388:                                                    : '&nbsp;' ).
  389:                       '</td><td>'.($role_end_time  ?localtime($role_end_time)
  390:                                                    : '&nbsp;' )
  391:                       ."</td></tr>\n";
  392:                $r->print($row);
  393:            } # end of foreach        (table building loop)
  394: 	   $r->print('</table>');
  395:         }  # End of unless
  396: 	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
  397: 	if ($currentauth=~/^krb(4|5):/) {
  398: 	    $currentauth=~/^krb(4|5):(.*)/;
  399: 	    my $krbdefdom=$1;
  400:             my %param = ( formname => 'document.cu',
  401:                           kerb_def_dom => $krbdefdom 
  402:                           );
  403:             $loginscript  = &Apache::loncommon::authform_header(%param);
  404: 	}
  405: 	# Check for a bad authentication type
  406:         unless ($currentauth=~/^krb(4|5):/ or
  407: 		$currentauth=~/^unix:/ or
  408: 		$currentauth=~/^internal:/ or
  409: 		$currentauth=~/^localauth:/
  410: 		) { # bad authentication scheme
  411: 	    if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
  412: 		$r->print(<<ENDBADAUTH);
  413: <hr />
  414: <script type="text/javascript" language="Javascript">
  415: $loginscript
  416: </script>
  417: <font color='#ff0000'>ERROR:</font>
  418: This user has an unrecognized authentication scheme ($currentauth).
  419: Please specify login data below.
  420: <h3>Login Data</h3>
  421: <p>$generalrule</p>
  422: <p>$authformkrb</p>
  423: <p>$authformint</p>
  424: <p>$authformfsys</p>
  425: <p>$authformloc</p>
  426: ENDBADAUTH
  427:             } else { 
  428:                 # This user is not allowed to modify the users 
  429:                 # authentication scheme, so just notify them of the problem
  430: 		$r->print(<<ENDBADAUTH);
  431: <hr />
  432: <script type="text/javascript" language="Javascript">
  433: $loginscript
  434: </script>
  435: <font color="#ff0000"> ERROR: </font>
  436: This user has an unrecognized authentication scheme ($currentauth).
  437: Please alert a domain coordinator of this situation.
  438: <hr />
  439: ENDBADAUTH
  440:             }
  441:         } else { # Authentication type is valid
  442: 	    my $authformcurrent='';
  443: 	    my $authform_other='';
  444: 	    if ($currentauth=~/^krb(4|5):/) {
  445: 		$authformcurrent=$authformkrb;
  446: 		$authform_other="<p>$authformint</p>\n".
  447:                     "<p>$authformfsys</p><p>$authformloc</p>";
  448: 	    }
  449: 	    elsif ($currentauth=~/^internal:/) {
  450: 		$authformcurrent=$authformint;
  451: 		$authform_other="<p>$authformkrb</p>".
  452:                     "<p>$authformfsys</p><p>$authformloc</p>";
  453: 	    }
  454: 	    elsif ($currentauth=~/^unix:/) {
  455: 		$authformcurrent=$authformfsys;
  456: 		$authform_other="<p>$authformkrb</p>".
  457:                     "<p>$authformint</p><p>$authformloc;</p>";
  458: 	    }
  459: 	    elsif ($currentauth=~/^localauth:/) {
  460: 		$authformcurrent=$authformloc;
  461: 		$authform_other="<p>$authformkrb</p>".
  462:                     "<p>$authformint</p><p>$authformfsys</p>";
  463: 	    }
  464:             $authformcurrent.=' <i>(will override current values)</i><br />';
  465:             if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
  466: 		# Current user has login modification privileges
  467: 		$r->print(<<ENDOTHERAUTHS);
  468: <hr />
  469: <script type="text/javascript" language="Javascript">
  470: $loginscript
  471: </script>
  472: <h3>Change Current Login Data</h3>
  473: <p>$generalrule</p>
  474: <p>$authformnop</p>
  475: <p>$authformcurrent</p>
  476: <h3>Enter New Login Data</h3>
  477: $authform_other
  478: ENDOTHERAUTHS
  479:             }
  480:         }  ## End of "check for bad authentication type" logic
  481:     } ## End of new user/old user logic
  482:     $r->print('<hr /><h3>Add Roles</h3>');
  483: #
  484: # Co-Author
  485: # 
  486:     if (&authorpriv($ENV{'user.name'},$ENV{'request.role.domain'}) &&
  487:         ($ENV{'user.name'} ne $ccuname || $ENV{'user.domain'} ne $ccdomain)) {
  488:         # No sense in assigning co-author role to yourself
  489: 	my $cuname=$ENV{'user.name'};
  490:         my $cudom=$ENV{'request.role.domain'};
  491:        $r->print(<<ENDCOAUTH);
  492: <h4>Construction Space</h4>
  493: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
  494: <th>Start</th><th>End</th></tr>
  495: <tr>
  496: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
  497: <td>Co-Author</td>
  498: <td>$cudom\_$cuname</td>
  499: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
  500: <a href=
  501: "javascript:pjump('date_start','Start Date Co-Author',document.cu.start_$cudom\_$cuname\_ca.value,'start_$cudom\_$cuname\_ca','cu.pres','dateset')">Set Start Date</a></td>
  502: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
  503: <a href=
  504: "javascript:pjump('date_end','End Date Co-Author',document.cu.end_$cudom\_$cuname\_ca.value,'end_$cudom\_$cuname\_ca','cu.pres','dateset')">Set End Date</a></td>
  505: </tr>
  506: </table>
  507: ENDCOAUTH
  508:     }
  509: #
  510: # Domain level
  511: #
  512:     $r->print('<h4>Domain Level</h4>'.
  513:     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
  514:     '<th>Start</th><th>End</th></tr>');
  515:     foreach ( sort( keys(%incdomains))) {
  516: 	my $thisdomain=$_;
  517:         foreach ('dc','li','dg','au') {
  518:             if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
  519:                my $plrole=&Apache::lonnet::plaintext($_);
  520:                $r->print(<<ENDDROW);
  521: <tr>
  522: <td><input type=checkbox name="act_$thisdomain\_$_"></td>
  523: <td>$plrole</td>
  524: <td>$thisdomain</td>
  525: <td><input type=hidden name="start_$thisdomain\_$_" value=''>
  526: <a href=
  527: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>
  528: <td><input type=hidden name="end_$thisdomain\_$_" value=''>
  529: <a href=
  530: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>
  531: </tr>
  532: ENDDROW
  533:             }
  534:         } 
  535:     }
  536:     $r->print('</table>');
  537: #
  538: # Course level
  539: #
  540:     $r->print(&course_level_table(%inccourses));
  541:     $r->print("<hr /><input type=submit value=\"Modify User\">\n");
  542:     $r->print("</form></body></html>");
  543: }
  544: 
  545: # ================================================================= Phase Three
  546: sub update_user_data {
  547:     my $r=shift;
  548:     my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
  549:                                           $ENV{'form.ccdomain'});
  550:     # Error messages
  551:     my $error     = '<font color="#ff0000">Error:</font>';
  552:     my $end       = '</body></html>';
  553:     # Print header
  554:     $r->print(<<ENDTHREEHEAD);
  555: <html>
  556: <head>
  557: <title>The LearningOnline Network with CAPA</title>
  558: </head>
  559: ENDTHREEHEAD
  560:     my $title;
  561:     if (exists($ENV{'form.makeuser'})) {
  562: 	$title='Set Privileges for New User';
  563:     } else {
  564:         $title='Modify User Privileges';
  565:     }
  566:     $r->print(&Apache::loncommon::bodytag($title));
  567:     # Check Inputs
  568:     if (! $ENV{'form.ccuname'} ) {
  569: 	$r->print($error.'No login name specified.'.$end);
  570: 	return;
  571:     }
  572:     if (  $ENV{'form.ccuname'}  =~/\W/) {
  573: 	$r->print($error.'Invalid login name.  '.
  574: 		  'Only letters, numbers, and underscores are valid.'.
  575: 		  $end);
  576: 	return;
  577:     }
  578:     if (! $ENV{'form.ccdomain'}       ) {
  579: 	$r->print($error.'No domain specified.'.$end);
  580: 	return;
  581:     }
  582:     if (  $ENV{'form.ccdomain'} =~/\W/) {
  583: 	$r->print($error.'Invalid domain name.  '.
  584: 		  'Only letters, numbers, and underscores are valid.'.
  585: 		  $end);
  586: 	return;
  587:     }
  588:     if (! exists($ENV{'form.makeuser'})) {
  589:         # Modifying an existing user, so check the validity of the name
  590:         if ($uhome eq 'no_host') {
  591:             $r->print($error.'Unable to determine home server for '.
  592:                       $ENV{'form.ccuname'}.' in domain '.
  593:                       $ENV{'form.ccdomain'}.'.');
  594:             return;
  595:         }
  596:     }
  597:     # Determine authentication method and password for the user being modified
  598:     my $amode='';
  599:     my $genpwd='';
  600:     if ($ENV{'form.login'} eq 'krb') {
  601: 	$amode='krb';
  602: 	$amode.=$ENV{'form.krbver'};
  603: 	$genpwd=$ENV{'form.krbarg'};
  604:     } elsif ($ENV{'form.login'} eq 'int') {
  605: 	$amode='internal';
  606: 	$genpwd=$ENV{'form.intarg'};
  607:     } elsif ($ENV{'form.login'} eq 'fsys') {
  608: 	$amode='unix';
  609: 	$genpwd=$ENV{'form.fsysarg'};
  610:     } elsif ($ENV{'form.login'} eq 'loc') {
  611: 	$amode='localauth';
  612: 	$genpwd=$ENV{'form.locarg'};
  613: 	$genpwd=" " if (!$genpwd);
  614:     } elsif (($ENV{'form.login'} eq 'nochange') ||
  615:              ($ENV{'form.login'} eq ''        )) { 
  616:         # There is no need to tell the user we did not change what they
  617:         # did not ask us to change.
  618:         # If they are creating a new user but have not specified login
  619:         # information this will be caught below.
  620:     } else {
  621: 	    $r->print($error.'Invalid login mode or password'.$end);    
  622: 	    return;
  623:     }
  624:     if ($ENV{'form.makeuser'}) {
  625:         # Create a new user
  626: 	$r->print(<<ENDNEWUSERHEAD);
  627: <h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
  628: ENDNEWUSERHEAD
  629:         # Check for the authentication mode and password
  630:         if (! $amode || ! $genpwd) {
  631: 	    $r->print($error.'Invalid login mode or password'.$end);    
  632: 	    return;
  633: 	}
  634:         # Determine desired host
  635:         my $desiredhost = $ENV{'form.hserver'};
  636:         if (lc($desiredhost) eq 'default') {
  637:             $desiredhost = undef;
  638:         } else {
  639:             my %home_servers = &Apache::loncommon::get_library_servers
  640:                 ($ENV{'form.ccdomain'});  
  641:             if (! exists($home_servers{$desiredhost})) {
  642:                 $r->print($error.'Invalid home server specified');
  643:                 return;
  644:             }
  645:         }
  646: 	# Call modifyuser
  647: 	my $result = &Apache::lonnet::modifyuser
  648: 	    ($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'},
  649:              $amode,$genpwd,$ENV{'form.cfirst'},
  650:              $ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},
  651:              undef,$desiredhost
  652: 	     );
  653: 	$r->print('Generating user: '.$result);
  654:         my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
  655:                                                $ENV{'form.ccdomain'});
  656:         $r->print('<br>Home server: '.$home.' '.
  657:                   $Apache::lonnet::libserv{$home});
  658:     } elsif (($ENV{'form.login'} ne 'nochange') &&
  659:              ($ENV{'form.login'} ne ''        )) {
  660: 	# Modify user privileges
  661: 	$r->print(<<ENDMODIFYUSERHEAD);
  662: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
  663: ENDMODIFYUSERHEAD
  664:         if (! $amode || ! $genpwd) {
  665: 	    $r->print($error.'Invalid login mode or password'.$end);    
  666: 	    return;
  667: 	}
  668: 	# Only allow authentification modification if the person has authority
  669: 	if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'})) {
  670: 	    $r->print('Modifying authentication: '.
  671:                       &Apache::lonnet::modifyuserauth(
  672: 		       $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
  673:                        $amode,$genpwd));
  674:             $r->print('<br>Home server: '.&Apache::lonnet::homeserver
  675: 		  ($ENV{'form.ccuname'},$ENV{'form.ccdomain'}));
  676: 	} else {
  677: 	    # Okay, this is a non-fatal error.
  678: 	    $r->print($error.'You do not have the authority to modify '.
  679: 		      'this users authentification information.');    
  680: 	}
  681:     }
  682:     ##
  683:     if (! $ENV{'form.makeuser'} ) {
  684:         # Check for need to change
  685:         my %userenv = &Apache::lonnet::get
  686:             ('environment',['firstname','middlename','lastname','generation'],
  687:              $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
  688:         my ($tmp) = keys(%userenv);
  689:         if ($tmp =~ /^(con_lost|error)/i) { 
  690:             %userenv = ();
  691:         }
  692:         # Check to see if we need to change user information
  693:         foreach ('firstname','middlename','lastname','generation') {
  694:             # Strip leading and trailing whitespace
  695:             $ENV{'form.c'.$_} =~ s/(\s+$|^\s+)//g; 
  696:         }
  697:         if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'}) && 
  698:             ($ENV{'form.cfirstname'}  ne $userenv{'firstname'}  ||
  699:              $ENV{'form.cmiddlename'} ne $userenv{'middlename'} ||
  700:              $ENV{'form.clastname'}   ne $userenv{'lastname'}   ||
  701:              $ENV{'form.cgeneration'} ne $userenv{'generation'} )) {
  702:             # Make the change
  703:             my %changeHash;
  704:             $changeHash{'firstname'}  = $ENV{'form.cfirstname'};
  705:             $changeHash{'middlename'} = $ENV{'form.cmiddlename'};
  706:             $changeHash{'lastname'}   = $ENV{'form.clastname'};
  707:             $changeHash{'generation'} = $ENV{'form.cgeneration'};
  708:             my $putresult = &Apache::lonnet::put
  709:                 ('environment',\%changeHash,
  710:                  $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
  711:             if ($putresult eq 'ok') {
  712:             # Tell the user we changed the name
  713:                 $r->print(<<"END");
  714: <table border="2">
  715: <caption>User Information Changed</caption>
  716: <tr><th>&nbsp;</th>
  717:     <th>first</th>
  718:     <th>middle</th>
  719:     <th>last</th>
  720:     <th>generation</th></tr>
  721: <tr><td>Previous</td>
  722:     <td>$userenv{'firstname'}  </td>
  723:     <td>$userenv{'middlename'} </td>
  724:     <td>$userenv{'lastname'}   </td>
  725:     <td>$userenv{'generation'} </td></tr>
  726: <tr><td>Changed To</td>
  727:     <td>$ENV{'form.cfirstname'}  </td>
  728:     <td>$ENV{'form.cmiddlename'} </td>
  729:     <td>$ENV{'form.clastname'}   </td>
  730:     <td>$ENV{'form.cgeneration'} </td></tr>
  731: </table>
  732: END
  733:             } else { # error occurred
  734:                 $r->print("<h2>Unable to successfully change environment for ".
  735:                       $ENV{'form.ccuname'}." in domain ".
  736:                       $ENV{'form.ccdomain'}."</h2>");
  737:             }
  738:         }  else { # End of if ($ENV ... ) logic
  739:             # They did not want to change the users name but we can
  740:             # still tell them what the name is
  741:                 $r->print(<<"END");
  742: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
  743: <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
  744: <h4>Generation: $userenv{'generation'}</h4>
  745: END
  746:         }
  747:     }
  748:     ##
  749:     my $now=time;
  750:     $r->print('<h3>Modifying Roles</h3>');
  751:     foreach (keys (%ENV)) {
  752: 	next if (! $ENV{$_});
  753: 	# Revoke roles
  754: 	if ($_=~/^form\.rev/) {
  755: 	    if ($_=~/^form\.rev\:([^\_]+)\_([^\_\.]+)$/) {
  756: # Revoke standard role
  757: 	        $r->print('Revoking '.$2.' in '.$1.': <b>'.
  758:                      &Apache::lonnet::revokerole($ENV{'form.ccdomain'},
  759:                      $ENV{'form.ccuname'},$1,$2).'</b><br>');
  760: 		if ($2 eq 'st') {
  761: 		    $1=~/^\/(\w+)\/(\w+)/;
  762: 		    my $cid=$1.'_'.$2;
  763: 		    $r->print('Drop from classlist: <b>'.
  764: 			 &Apache::lonnet::critical('put:'.
  765:                              $ENV{'course.'.$cid.'.domain'}.':'.
  766: 	                     $ENV{'course.'.$cid.'.num'}.':classlist:'.
  767:                          &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
  768:                              $ENV{'form.ccdomain'}).'='.
  769:                          &Apache::lonnet::escape($now.':'),
  770: 	                     $ENV{'course.'.$cid.'.home'}).'</b><br>');
  771: 		}
  772: 	    } 
  773: 	    if ($_=~/^form\.rev\:([^\_]+)\_cr\.cr\/(\w+)\/(\w+)\/(\w+)$/) {
  774: # Revoke custom role
  775: 		$r->print(
  776:                 'Revoking custom role '.$4.' by '.$3.'@'.$2.' in '.$1.': <b>'.
  777: &Apache::lonnet::revokecustomrole($ENV{'form.ccdomain'},
  778: 				  $ENV{'form.ccuname'},$1,$2,$3,$4).
  779: 		'</b><br>');
  780: 	    }
  781: 	} elsif ($_=~/^form\.del/) {
  782: 	    if ($_=~/^form\.del\:([^\_]+)\_([^\_]+)$/) {
  783: 	        $r->print('Deleting '.$2.' in '.$1.': '.
  784:                      &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
  785:                      $ENV{'form.ccuname'},$1,$2,$now,0,1).'<br>');
  786: 		if ($2 eq 'st') {
  787: 		    $1=~/^\/(\w+)\/(\w+)/;
  788: 		    my $cid=$1.'_'.$2;
  789: 		    $r->print('Drop from classlist: <b>'.
  790: 			 &Apache::lonnet::critical('put:'.
  791:                              $ENV{'course.'.$cid.'.domain'}.':'.
  792: 	                     $ENV{'course.'.$cid.'.num'}.':classlist:'.
  793:                          &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
  794:                              $ENV{'form.ccdomain'}).'='.
  795:                          &Apache::lonnet::escape($now.':'),
  796: 	                     $ENV{'course.'.$cid.'.home'}).'</b><br>');
  797: 		}
  798: 	    } 
  799: 	} elsif ($_=~/^form\.act/) {
  800: 	    if 
  801: ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_cr_cr_([^\_]+)_(\w+)_([^\_]+)$/) {
  802:                 # Activate a custom role
  803: 		my $url='/'.$1.'/'.$2;
  804: 		my $full=$1.'_'.$2.'_cr_cr_'.$3.'_'.$4.'_'.$5;
  805: 		if ($ENV{'form.sec_'.$full}) {
  806: 		    $url.='/'.$ENV{'form.sec_'.$full};
  807: 		}
  808: 
  809: 		my $start = ( $ENV{'form.start_'.$full} ? 
  810: 			      $ENV{'form.start_'.$full} : 
  811: 			      $now );
  812: 		my $end   = ( $ENV{'form.end_'.$full} ? 
  813: 			      $ENV{'form.end_'.$full} :
  814: 			      0 );
  815: 
  816:     $r->print('Assigning custom role "'.$5.'" by '.$4.'@'.$3.' in '.$url.
  817:                          ($start?', starting '.localtime($start):'').
  818:                          ($end?', ending '.localtime($end):'').': <b>'.
  819: 	      &Apache::lonnet::assigncustomrole(
  820: 	$ENV{'form.ccdomain'},$ENV{'form.ccuname'},$url,$3,$4,$5,$end,$start).
  821: 	      '</b><br>');
  822: 	    } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {
  823: 		# Activate roles for sections with 3 id numbers
  824: 		# set start, end times, and the url for the class
  825: 
  826: 		my $start = ( $ENV{'form.start_'.$1.'_'.$2.'_'.$3} ? 
  827: 			      $ENV{'form.start_'.$1.'_'.$2.'_'.$3} : 
  828: 			      $now );
  829: 		my $end   = ( $ENV{'form.end_'.$1.'_'.$2.'_'.$3} ? 
  830: 			      $ENV{'form.end_'.$1.'_'.$2.'_'.$3} :
  831: 			      0 );
  832: 		my $url='/'.$1.'/'.$2;
  833: 		if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
  834: 		    $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
  835: 		}
  836: 		# Assign the role and report it
  837: 		$r->print('Assigning '.$3.' in '.$url.
  838:                          ($start?', starting '.localtime($start):'').
  839:                          ($end?', ending '.localtime($end):'').': <b>'.
  840:                           &Apache::lonnet::assignrole(
  841:                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
  842:                               $url,$3,$end,$start).
  843: 			  '</b><br>');
  844: 		# Handle students differently
  845: 		if ($3 eq 'st') {
  846: 		    $url=~/^\/(\w+)\/(\w+)/;
  847: 		    my $cid=$1.'_'.$2;
  848: 		    $r->print('Add to classlist: <b>'.
  849: 			      &Apache::lonnet::critical(
  850: 				  'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
  851: 	                           $ENV{'course.'.$cid.'.num'}.':classlist:'.
  852:                                    &Apache::lonnet::escape(
  853:                                        $ENV{'form.ccuname'}.':'.
  854:                                        $ENV{'form.ccdomain'} ).'='.
  855:                                    &Apache::lonnet::escape($end.':'.$start),
  856: 				       $ENV{'course.'.$cid.'.home'})
  857: 			      .'</b><br>');
  858: 		}
  859: 	    } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
  860: 		# Activate roles for sections with two id numbers
  861: 		# set start, end times, and the url for the class
  862: 		my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 
  863: 			      $ENV{'form.start_'.$1.'_'.$2} : 
  864: 			      $now );
  865: 		my $end   = ( $ENV{'form.end_'.$1.'_'.$2} ? 
  866: 			      $ENV{'form.end_'.$1.'_'.$2} :
  867: 			      0 );
  868: 		my $url='/'.$1.'/';
  869: 		# Assign the role and report it.
  870: 		$r->print('Assigning '.$2.' in '.$url.': '.
  871:                          ($start?', starting '.localtime($start):'').
  872:                          ($end?', ending '.localtime($end):'').': <b>'.
  873:                           &Apache::lonnet::assignrole(
  874:                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
  875:                               $url,$2,$end,$start)
  876: 			  .'</b><br>');
  877: 	    } else {
  878: 		$r->print('<p>ERROR: Unknown command <tt>'.$_.'</tt></p><br>');
  879:             }
  880: 	} 
  881:     } # End of foreach (keys(%ENV))
  882:     $r->print('</body></html>');
  883: }
  884: 
  885: # ========================================================== Custom Role Editor
  886: 
  887: sub custom_role_editor {
  888:     my $r=shift;
  889:     my $rolename=$ENV{'form.rolename'};
  890: 
  891:     if ($rolename eq 'make new role') {
  892: 	$rolename=$ENV{'form.newrolename'};
  893:     }
  894: 
  895:     $rolename=~s/[^A-Za-z0-9]//gs;
  896: 
  897:     unless ($rolename) {
  898: 	&print_username_entry_form($r);
  899:         return;
  900:     }
  901: 
  902:     $r->print(&Apache::loncommon::bodytag(
  903:                      'Create Users, Change User Privileges').'<h2>');
  904:     my $syspriv='';
  905:     my $dompriv='';
  906:     my $coursepriv='';
  907:     my ($rdummy,$roledef)=
  908: 			 &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
  909: # ------------------------------------------------------- Does this role exist?
  910:     if (($rdummy ne 'con_lost') && ($roledef ne '')) {
  911: 	$r->print('Existing Role "');
  912: # ------------------------------------------------- Get current role privileges
  913: 	($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
  914:     } else {
  915: 	$r->print('New Role "');
  916: 	$roledef='';
  917:     }
  918:     $r->print($rolename.'"</h2>');
  919: # ------------------------------------------------------- What can be assigned?
  920:     my %full=();
  921:     my %courselevel=();
  922:     my %courselevelcurrent=();
  923:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
  924: 	my ($priv,$restrict)=split(/\&/,$_);
  925:         unless ($restrict) { $restrict='F'; }
  926:         $courselevel{$priv}=$restrict;
  927:         if ($coursepriv=~/\:$priv/) {
  928: 	    $courselevelcurrent{$priv}=1;
  929: 	}
  930: 	$full{$priv}=1;
  931:     }
  932:     my %domainlevel=();
  933:     my %domainlevelcurrent=();
  934:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
  935: 	my ($priv,$restrict)=split(/\&/,$_);
  936:         unless ($restrict) { $restrict='F'; }
  937:         $domainlevel{$priv}=$restrict;
  938:         if ($dompriv=~/\:$priv/) {
  939: 	    $domainlevelcurrent{$priv}=1;
  940: 	}
  941: 	$full{$priv}=1;
  942:     }
  943:     my %systemlevel=();
  944:     my %systemlevelcurrent=();
  945:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
  946: 	my ($priv,$restrict)=split(/\&/,$_);
  947:         unless ($restrict) { $restrict='F'; }
  948:         $systemlevel{$priv}=$restrict;
  949:         if ($syspriv=~/\:$priv/) {
  950: 	    $systemlevelcurrent{$priv}=1;
  951: 	}
  952: 	$full{$priv}=1;
  953:     }
  954:     $r->print(<<ENDCCF);
  955: <form method="post">
  956: <input type="hidden" name="phase" value="set_custom_roles" />
  957: <input type="hidden" name="rolename" value="$rolename" />
  958: <table border="2">
  959: <tr><th>Privilege</th><th>Course Level</th><th>Domain Level</th>
  960: <th>System Level</th></tr>
  961: ENDCCF
  962:     foreach (sort keys %full) {
  963: 	$r->print('<tr><td>'.&Apache::lonnet::plaintext($_).'</td><td>'.
  964:     ($courselevel{$_}?'<input type="checkbox" name="'.$_.':c" '.
  965:     ($courselevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
  966:     '</td><td>'.
  967:     ($domainlevel{$_}?'<input type="checkbox" name="'.$_.':d" '.
  968:     ($domainlevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
  969:     '</td><td>'.
  970:     ($systemlevel{$_}?'<input type="checkbox" name="'.$_.':s" '.
  971:     ($systemlevelcurrent{$_}?'checked="1"':'').' />':'&nbsp;').
  972:     '</td></tr>');
  973:     }
  974:     $r->print(
  975:    '<table><input type="submit" value="Define Role" /></form></body></html>');
  976: }
  977: 
  978: # ---------------------------------------------------------- Call to definerole
  979: sub set_custom_role {
  980:     my $r=shift;
  981: 
  982:     my $rolename=$ENV{'form.rolename'};
  983: 
  984:     $rolename=~s/[^A-Za-z0-9]//gs;
  985: 
  986:     unless ($rolename) {
  987: 	&print_username_entry_form($r);
  988:         return;
  989:     }
  990: 
  991:     $r->print(&Apache::loncommon::bodytag(
  992:                      'Create Users, Change User Privileges').'<h2>');
  993:     my ($rdummy,$roledef)=
  994: 			 &Apache::lonnet::get('roles',["rolesdef_$rolename"]);
  995: # ------------------------------------------------------- Does this role exist?
  996:     if (($rdummy ne 'con_lost') && ($roledef ne '')) {
  997: 	$r->print('Existing Role "');
  998:     } else {
  999: 	$r->print('New Role "');
 1000: 	$roledef='';
 1001:     }
 1002:     $r->print($rolename.'"</h2>');
 1003: # ------------------------------------------------------- What can be assigned?
 1004:     my $sysrole='';
 1005:     my $domrole='';
 1006:     my $courole='';
 1007: 
 1008:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
 1009: 	my ($priv,$restrict)=split(/\&/,$_);
 1010:         unless ($restrict) { $restrict=''; }
 1011:         if ($ENV{'form.'.$priv.':c'}) {
 1012: 	    $courole.=':'.$_;
 1013: 	}
 1014:     }
 1015: 
 1016:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:d'})) {
 1017: 	my ($priv,$restrict)=split(/\&/,$_);
 1018:         unless ($restrict) { $restrict=''; }
 1019:         if ($ENV{'form.'.$priv.':d'}) {
 1020: 	    $domrole.=':'.$_;
 1021: 	}
 1022:     }
 1023: 
 1024:     foreach (split(/\:/,$Apache::lonnet::pr{'cr:s'})) {
 1025: 	my ($priv,$restrict)=split(/\&/,$_);
 1026:         unless ($restrict) { $restrict=''; }
 1027:         if ($ENV{'form.'.$priv.':s'}) {
 1028: 	    $sysrole.=':'.$_;
 1029: 	}
 1030:     }
 1031:     $r->print('<br />Defining Role: '.
 1032: 	   &Apache::lonnet::definerole($rolename,$sysrole,$domrole,$courole));
 1033:     if ($ENV{'request.course.id'}) {
 1034:         my $url='/'.$ENV{'request.course.id'};
 1035:         $url=~s/\_/\//g;
 1036: 	$r->print('<br />Assigning Role to Self: '.
 1037: 	      &Apache::lonnet::assigncustomrole($ENV{'user.domain'},
 1038: 						$ENV{'user.name'},
 1039: 						$url,
 1040: 						$ENV{'user.domain'},
 1041: 						$ENV{'user.name'},
 1042: 						$rolename));
 1043:     }
 1044:     $r->print('</body></html>');
 1045: }
 1046: 
 1047: # ================================================================ Main Handler
 1048: sub handler {
 1049:     my $r = shift;
 1050: 
 1051:     if ($r->header_only) {
 1052:        $r->content_type('text/html');
 1053:        $r->send_http_header;
 1054:        return OK;
 1055:     }
 1056: 
 1057:     if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
 1058:         (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 
 1059:         (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 
 1060:         (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
 1061:         (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) ||
 1062:         (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {
 1063:        $r->content_type('text/html');
 1064:        $r->send_http_header;
 1065:        unless ($ENV{'form.phase'}) {
 1066: 	   &print_username_entry_form($r);
 1067:        }
 1068:        if ($ENV{'form.phase'} eq 'get_user_info') {
 1069:            &print_user_modification_page($r);
 1070:        } elsif ($ENV{'form.phase'} eq 'update_user_data') {
 1071:            &update_user_data($r);
 1072:        } elsif ($ENV{'form.phase'} eq 'selected_custom_edit') {
 1073:            &custom_role_editor($r);
 1074:        } elsif ($ENV{'form.phase'} eq 'set_custom_roles') {
 1075: 	   &set_custom_role($r);
 1076:        }
 1077:    } else {
 1078:       $ENV{'user.error.msg'}=
 1079:         "/adm/createuser:mau:0:0:Cannot modify user data";
 1080:       return HTTP_NOT_ACCEPTABLE; 
 1081:    }
 1082:    return OK;
 1083: } 
 1084: 
 1085: #-------------------------------------------------- functions for &phase_two
 1086: sub course_level_table {
 1087:     my %inccourses = @_;
 1088:     my $table = '';
 1089: # Custom Roles?
 1090: 
 1091:     my %customroles=&my_custom_roles();
 1092: 
 1093:     foreach (sort( keys(%inccourses))) {
 1094: 	my $thiscourse=$_;
 1095: 	my $protectedcourse=$_;
 1096: 	$thiscourse=~s:_:/:g;
 1097: 	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
 1098: 	my $area=$coursedata{'description'};
 1099: 	if (!defined($area)) { $area='Unavailable course: '.$_; }
 1100: 	my $bgcol=$thiscourse;
 1101: 	$bgcol=~s/[^7-9a-e]//g;
 1102: 	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',2,6);
 1103: 	foreach  ('st','ta','ep','ad','in','cc') {
 1104: 	    if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
 1105: 		my $plrole=&Apache::lonnet::plaintext($_);
 1106: 		$table .= <<ENDEXTENT;
 1107: <tr bgcolor="#$bgcol">
 1108: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
 1109: <td>$plrole</td>
 1110: <td>$area</td>
 1111: ENDEXTENT
 1112: 	        if ($_ ne 'cc') {
 1113: 		    $table .= <<ENDSECTION;
 1114: <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td>
 1115: ENDSECTION
 1116:                 } else { 
 1117: 		    $table .= <<ENDSECTION;
 1118: <td>&nbsp</td> 
 1119: ENDSECTION
 1120:                 }
 1121: 		$table .= <<ENDTIMEENTRY;
 1122: <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
 1123: <a href=
 1124: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
 1125: <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
 1126: <a href=
 1127: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
 1128: ENDTIMEENTRY
 1129:                 $table.= "</tr>\n";
 1130:             }
 1131:         }
 1132:         foreach (sort keys %customroles) {
 1133: 	    if (&Apache::lonnet::allowed('ccr',$thiscourse)) {
 1134: 		my $plrole=$_;
 1135:                 my $customrole=$protectedcourse.'_cr_cr_'.$ENV{'user.domain'}.
 1136: 		    '_'.$ENV{'user.name'}.'_'.$plrole;
 1137: 		$table .= <<ENDENTRY;
 1138: <tr bgcolor="#$bgcol">
 1139: <td><input type="checkbox" name="act_$customrole"></td>
 1140: <td>$plrole</td>
 1141: <td>$area</td>
 1142: <td><input type="text" size="5" name="sec_$customrole"></td>
 1143: <td><input type=hidden name="start_$customrole" value=''>
 1144: <a href=
 1145: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$customrole.value,'start_$customrole','cu.pres','dateset')">Set Start Date</a></td>
 1146: <td><input type=hidden name="end_$customrole" value=''>
 1147: <a href=
 1148: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$customrole.value,'end_$customrole','cu.pres','dateset')">Set End Date</a></td></tr>
 1149: ENDENTRY
 1150:            }
 1151: 	}
 1152:     }
 1153:     return '' if ($table eq ''); # return nothing if there is nothing 
 1154:                                  # in the table
 1155:     my $result = <<ENDTABLE;
 1156: <h4>Course Level</h4>
 1157: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
 1158: <th>Group/Section</th><th>Start</th><th>End</th></tr>
 1159: $table
 1160: </table>
 1161: ENDTABLE
 1162:     return $result;
 1163: }
 1164: #---------------------------------------------- end functions for &phase_two
 1165: 
 1166: #--------------------------------- functions for &phase_two and &phase_three
 1167: 
 1168: #--------------------------end of functions for &phase_two and &phase_three
 1169: 
 1170: 1;
 1171: __END__
 1172: 
 1173: 

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