Annotation of loncom/interface/loncreateuser.pm, revision 1.50

1.20      harris41    1: # The LearningOnline Network with CAPA
1.1       www         2: # Create a user
                      3: #
1.50    ! albertel    4: # $Id: loncreateuser.pm,v 1.49 2003/03/23 08:31:41 albertel Exp $
1.22      albertel    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: #
1.1       www        28: # (Create a course
                     29: # (My Desk
                     30: #
                     31: # (Internal Server Error Handler
                     32: #
                     33: # (Login Screen
                     34: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
                     35: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
                     36: #
1.20      harris41   37: # YEAR=2001
1.1       www        38: # 3/1/1 Gerd Kortemeyer)
                     39: #
                     40: # 3/1 Gerd Kortemeyer)
                     41: #
                     42: # 2/14 Gerd Kortemeyer)
                     43: #
1.12      www        44: # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer
1.17      www        45: # April Guy Albertelli
1.19      www        46: # 05/10,10/16 Gerd Kortemeyer 
1.25      matthew    47: # 02/11/02 Matthew Hall
1.1       www        48: #
1.50    ! albertel   49: # $Id: loncreateuser.pm,v 1.49 2003/03/23 08:31:41 albertel Exp $
1.20      harris41   50: ###
                     51: 
1.1       www        52: package Apache::loncreateuser;
                     53: 
                     54: use strict;
                     55: use Apache::Constants qw(:common :http);
                     56: use Apache::lonnet;
                     57: 
1.20      harris41   58: my $loginscript; # piece of javascript used in two separate instances
                     59: my $generalrule;
                     60: my $authformnop;
                     61: my $authformkrb;
                     62: my $authformint;
                     63: my $authformfsys;
                     64: my $authformloc;
                     65: 
1.23      harris41   66: BEGIN {
1.20      harris41   67:     $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                     68:     my $krbdefdom=$1;
                     69:     $krbdefdom=~tr/a-z/A-Z/;
1.31      matthew    70:     my %param = ( formname => 'document.cu',
                     71:                   kerb_def_dom => $krbdefdom 
                     72:                   );
1.48      albertel   73: # no longer static due to configurable kerberos defaults
                     74: #    $loginscript  = &Apache::loncommon::authform_header(%param);
1.31      matthew    75:     $generalrule  = &Apache::loncommon::authform_authorwarning(%param);
                     76:     $authformnop  = &Apache::loncommon::authform_nochange(%param);
1.48      albertel   77: # no longer static due to configurable kerberos defaults
                     78: #    $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
1.31      matthew    79:     $authformint  = &Apache::loncommon::authform_internal(%param);
                     80:     $authformfsys = &Apache::loncommon::authform_filesystem(%param);
                     81:     $authformloc  = &Apache::loncommon::authform_local(%param);
1.20      harris41   82: }
                     83: 
1.43      www        84: 
                     85: 
                     86: # ==================================================== Figure out author access
                     87: 
                     88: sub authorpriv {
                     89:     my ($auname,$audom)=@_;
                     90:     if (($auname ne $ENV{'user.name'}) ||
                     91:         (($audom ne $ENV{'user.domain'}) &&
                     92:          ($audom ne $ENV{'request.role.domain'}))) { return ''; }
                     93:     unless (&Apache::lonnet::allowed('cca',$audom)) { return ''; }
                     94:     return 1;
                     95: }
                     96: 
1.2       www        97: # =================================================================== Phase one
1.1       www        98: 
1.42      matthew    99: sub print_username_entry_form {
1.2       www       100:     my $r=shift;
1.42      matthew   101:     my $defdom=$ENV{'request.role.domain'};
1.33      matthew   102:     my @domains = &Apache::loncommon::get_domains();
                    103:     my $domform = &Apache::loncommon::select_dom_form($defdom,'ccdomain');
1.40      www       104:     my $bodytag =&Apache::loncommon::bodytag(
                    105:                                   'Create Users, Change User Privileges');
1.46      www       106:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
                    107:     my $sellink=&Apache::loncommon::selectstudent_link
                    108:                                         ('crtuser','ccuname','ccdomain');
1.33      matthew   109:     $r->print(<<"ENDDOCUMENT");
1.1       www       110: <html>
                    111: <head>
                    112: <title>The LearningOnline Network with CAPA</title>
1.46      www       113: $selscript
1.1       www       114: </head>
1.40      www       115: $bodytag
1.46      www       116: <form action="/adm/createuser" method="post" name="crtuser">
1.42      matthew   117: <input type="hidden" name="phase" value="get_user_info">
1.33      matthew   118: <p>
1.43      www       119: <table>
                    120: <tr><td>Username:</td><td><input type="text" size="15" name="ccuname">
1.46      www       121: </td><td rowspan="2">$sellink</td></tr><tr><td>
1.43      www       122: Domain:</td><td>$domform</td></tr>
                    123: </table> 
1.33      matthew   124: </p>
1.42      matthew   125: <input type="submit" value="Continue">
1.2       www       126: </form>
1.1       www       127: </body>
                    128: </html>
                    129: ENDDOCUMENT
1.2       www       130: }
                    131: 
                    132: # =================================================================== Phase two
1.42      matthew   133: sub print_user_modification_page {
1.2       www       134:     my $r=shift;
                    135:     my $ccuname=$ENV{'form.ccuname'};
                    136:     my $ccdomain=$ENV{'form.ccdomain'};
1.4       www       137: 
1.48      albertel  138:     my $defdom=$ENV{'request.role.domain'};
                    139: 
                    140:     my ($krbdef,$krbdefdom) =
                    141:        &Apache::loncommon::get_kerberos_defaults($defdom);
                    142: 
1.31      matthew   143:     my %param = ( formname => 'document.cu',
1.48      albertel  144:                   kerb_def_dom => $krbdefdom,
                    145:                   kerb_def_auth => $krbdef
1.31      matthew   146:                   );
                    147:     $loginscript  = &Apache::loncommon::authform_header(%param);
1.48      albertel  148:     $authformkrb  = &Apache::loncommon::authform_kerberos(%param);
1.4       www       149: 
1.2       www       150:     $ccuname=~s/\W//g;
                    151:     $ccdomain=~s/\W//g;
1.25      matthew   152:     my $dochead =<<"ENDDOCHEAD";
1.2       www       153: <html>
                    154: <head>
                    155: <title>The LearningOnline Network with CAPA</title>
1.31      matthew   156: <script type="text/javascript" language="Javascript">
1.3       www       157: 
                    158:     function pclose() {
                    159:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    160:                  "height=350,width=350,scrollbars=no,menubar=no");
                    161:         parmwin.close();
                    162:     }
                    163: 
                    164:     function pjump(type,dis,value,marker,ret,call) {
                    165:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
                    166:                  +"&value="+escape(value)+"&marker="+escape(marker)
                    167:                  +"&return="+escape(ret)
                    168:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
                    169:                  "height=350,width=350,scrollbars=no,menubar=no");
                    170: 
                    171:     }
                    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>
1.2       www       180: </head>
1.25      matthew   181: ENDDOCHEAD
1.40      www       182:     $r->print(&Apache::loncommon::bodytag(
                    183:                                      'Create Users, Change User Privileges'));
1.25      matthew   184:     my $forminfo =<<"ENDFORMINFO";
                    185: <form action="/adm/createuser" method="post" name="cu">
1.42      matthew   186: <input type="hidden" name="phase"       value="update_user_data">
1.25      matthew   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
1.2       www       193:     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
                    194:     my %incdomains; 
                    195:     my %inccourses;
1.49      albertel  196:     foreach (values(%Apache::lonnet::hostdom)) {
1.13      www       197:        $incdomains{$_}=1;
1.24      matthew   198:     }
                    199:     foreach (keys(%ENV)) {
1.2       www       200: 	if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
                    201: 	    $inccourses{$1.'_'.$2}=1;
                    202:         }
1.24      matthew   203:     }
1.2       www       204:     if ($uhome eq 'no_host') {
1.29      matthew   205:         my $home_server_list=
1.32      matthew   206:             '<option value="default" selected>default</option>'."\n".
                    207:                 &Apache::loncommon::home_server_option_list($ccdomain);
                    208:         
1.26      matthew   209: 	$r->print(<<ENDNEWUSER);
1.25      matthew   210: $dochead
                    211: <h1>Create New User</h1>
                    212: $forminfo
                    213: <h2>New user "$ccuname" in domain $ccdomain</h2>
1.31      matthew   214: <script type="text/javascript" language="Javascript">
1.20      harris41  215: $loginscript
1.31      matthew   216: </script>
1.20      harris41  217: <input type='hidden' name='makeuser' value='1' />
1.4       www       218: <h3>Personal Data</h3>
1.25      matthew   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>
1.29      matthew   231: Home Server: <select name="hserver" size="1"> $home_server_list </select>
1.25      matthew   232: <hr />
1.4       www       233: <h3>Login Data</h3>
1.31      matthew   234: <p>$generalrule </p>
                    235: <p>$authformkrb </p>
                    236: <p>$authformint </p>
                    237: <p>$authformfsys</p>
                    238: <p>$authformloc </p>
1.26      matthew   239: ENDNEWUSER
1.25      matthew   240:     } else { # user already exists
1.26      matthew   241: 	$r->print(<<ENDCHANGEUSER);
1.25      matthew   242: $dochead
                    243: <h1>Change User Privileges</h1>
                    244: $forminfo
                    245: <h2>User "$ccuname" in domain $ccdomain </h2>
1.26      matthew   246: ENDCHANGEUSER
1.28      matthew   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
1.25      matthew   273:         # Build up table of user roles to allow revocation of a role.
1.28      matthew   274:         my ($tmp) = keys(%rolesdump);
                    275:         unless ($tmp =~ /^(con_lost|error)/i) {
1.2       www       276:            my $now=time;
1.37      matthew   277:            $r->print(<<END);
                    278: <hr />
                    279: <h3>Revoke Existing Roles</h3>
                    280: <table border=2>
                    281: <tr><th>Revoke</th><th>Role</th><th>Extent</th><th>Start</th><th>End</th>
                    282: END
1.28      matthew   283: 	   foreach my $area (keys(%rolesdump)) {
1.37      matthew   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:                my $bgcol='ffffff';
                    291:                my $allowed=0;
                    292:                if ($area =~ /^\/(\w+)\/(\d\w+)/ ) {
                    293:                    my %coursedata=
                    294:                        &Apache::lonnet::coursedescription($1.'_'.$2);
                    295:                    my $carea='Course: '.$coursedata{'description'};
                    296:                    $inccourses{$1.'_'.$2}=1;
                    297:                    if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {
                    298:                        $allowed=1;
                    299:                    }
                    300:                    # Compute the background color based on $area
                    301:                    $bgcol=$1.'_'.$2;
                    302:                    $bgcol=~s/[^8-9b-e]//g;
                    303:                    $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
                    304:                    if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
1.28      matthew   305:                        $carea.='<br>Section/Group: '.$3;
1.37      matthew   306:                    }
                    307:                    $area=$carea;
                    308:                } else {
                    309:                    # Determine if current user is able to revoke privileges
                    310:                    if ($area=~ /^\/(\w+)\//) {
                    311:                        if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
                    312:                            $allowed=1;
                    313:                        }
                    314:                    } else {
                    315:                        if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
                    316:                            $allowed=1;
                    317:                        }
                    318:                    }
                    319:                }
1.43      www       320:                if ($role_code eq 'ca') {
                    321:                    $area=~/\/(\w+)\/(\w+)/;
                    322: 		   if (&authorpriv($2,$1)) {
                    323: 		       $allowed=1;
                    324:                    } else {
                    325:                        $allowed=0;
1.37      matthew   326:                    }
                    327:                }
                    328:                my $row = '';
                    329:                $row.='<tr bgcolor=#"'.$bgcol.'"><td>';
                    330:                my $active=1;
                    331:                $active=0 if (($role_end_time) && ($now>$role_end_time));
                    332:                if (($active) && ($allowed)) {
                    333:                    $row.= '<input type="checkbox" name="rev:'.$thisrole.'">';
                    334:                } else {
                    335:                    $row.='&nbsp;';
                    336:                }
                    337:                $row.= '</td><td>'.&Apache::lonnet::plaintext($role_code).
                    338:                       '</td><td>'.$area.
                    339:                       '</td><td>'.($role_start_time?localtime($role_start_time)
                    340:                                                    : '&nbsp;' ).
                    341:                       '</td><td>'.($role_end_time  ?localtime($role_end_time)
                    342:                                                    : '&nbsp;' )
                    343:                       ."</td></tr>\n";
                    344:                $r->print($row);
1.28      matthew   345:            } # end of foreach        (table building loop)
1.2       www       346: 	   $r->print('</table>');
1.28      matthew   347:         }  # End of unless
1.20      harris41  348: 	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
1.41      albertel  349: 	if ($currentauth=~/^krb(4|5):/) {
                    350: 	    $currentauth=~/^krb(4|5):(.*)/;
1.45      matthew   351: 	    my $krbdefdom=$1;
1.31      matthew   352:             my %param = ( formname => 'document.cu',
                    353:                           kerb_def_dom => $krbdefdom 
                    354:                           );
                    355:             $loginscript  = &Apache::loncommon::authform_header(%param);
1.20      harris41  356: 	}
1.26      matthew   357: 	# Check for a bad authentication type
1.41      albertel  358:         unless ($currentauth=~/^krb(4|5):/ or
1.20      harris41  359: 		$currentauth=~/^unix:/ or
                    360: 		$currentauth=~/^internal:/ or
                    361: 		$currentauth=~/^localauth:/
1.26      matthew   362: 		) { # bad authentication scheme
1.42      matthew   363: 	    if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
1.26      matthew   364: 		$r->print(<<ENDBADAUTH);
1.21      harris41  365: <hr />
1.31      matthew   366: <script type="text/javascript" language="Javascript">
1.21      harris41  367: $loginscript
1.31      matthew   368: </script>
1.20      harris41  369: <font color='#ff0000'>ERROR:</font>
                    370: This user has an unrecognized authentication scheme ($currentauth).
                    371: Please specify login data below.
                    372: <h3>Login Data</h3>
1.31      matthew   373: <p>$generalrule</p>
                    374: <p>$authformkrb</p>
                    375: <p>$authformint</p>
                    376: <p>$authformfsys</p>
                    377: <p>$authformloc</p>
1.26      matthew   378: ENDBADAUTH
                    379:             } else { 
                    380:                 # This user is not allowed to modify the users 
                    381:                 # authentication scheme, so just notify them of the problem
                    382: 		$r->print(<<ENDBADAUTH);
                    383: <hr />
1.31      matthew   384: <script type="text/javascript" language="Javascript">
1.26      matthew   385: $loginscript
1.31      matthew   386: </script>
1.26      matthew   387: <font color="#ff0000"> ERROR: </font>
                    388: This user has an unrecognized authentication scheme ($currentauth).
                    389: Please alert a domain coordinator of this situation.
                    390: <hr />
                    391: ENDBADAUTH
                    392:             }
                    393:         } else { # Authentication type is valid
1.20      harris41  394: 	    my $authformcurrent='';
1.26      matthew   395: 	    my $authform_other='';
1.41      albertel  396: 	    if ($currentauth=~/^krb(4|5):/) {
1.20      harris41  397: 		$authformcurrent=$authformkrb;
1.31      matthew   398: 		$authform_other="<p>$authformint</p>\n".
                    399:                     "<p>$authformfsys</p><p>$authformloc</p>";
1.20      harris41  400: 	    }
                    401: 	    elsif ($currentauth=~/^internal:/) {
                    402: 		$authformcurrent=$authformint;
1.31      matthew   403: 		$authform_other="<p>$authformkrb</p>".
                    404:                     "<p>$authformfsys</p><p>$authformloc</p>";
1.20      harris41  405: 	    }
                    406: 	    elsif ($currentauth=~/^unix:/) {
                    407: 		$authformcurrent=$authformfsys;
1.31      matthew   408: 		$authform_other="<p>$authformkrb</p>".
                    409:                     "<p>$authformint</p><p>$authformloc;</p>";
1.20      harris41  410: 	    }
                    411: 	    elsif ($currentauth=~/^localauth:/) {
                    412: 		$authformcurrent=$authformloc;
1.31      matthew   413: 		$authform_other="<p>$authformkrb</p>".
                    414:                     "<p>$authformint</p><p>$authformfsys</p>";
1.20      harris41  415: 	    }
1.26      matthew   416: 	    $authformcurrent=<<ENDCURRENTAUTH;
1.20      harris41  417: <table border='1'>
                    418: <tr>
                    419: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
                    420: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
                    421: </tr>
                    422: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td>
                    423: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
                    424: </table>
1.26      matthew   425: ENDCURRENTAUTH
1.42      matthew   426:             if (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'})) {
1.26      matthew   427: 		# Current user has login modification privileges
                    428: 		$r->print(<<ENDOTHERAUTHS);
1.21      harris41  429: <hr />
1.31      matthew   430: <script type="text/javascript" language="Javascript">
1.21      harris41  431: $loginscript
1.31      matthew   432: </script>
1.20      harris41  433: <h3>Change Current Login Data</h3>
1.31      matthew   434: <p>$generalrule</p>
                    435: <p>$authformnop</p>
                    436: <p>$authformcurrent</p>
1.20      harris41  437: <h3>Enter New Login Data</h3>
1.26      matthew   438: $authform_other
                    439: ENDOTHERAUTHS
                    440:             }
                    441:         }  ## End of "check for bad authentication type" logic
1.25      matthew   442:     } ## End of new user/old user logic
1.20      harris41  443:     $r->print('<hr /><h3>Add Roles</h3>');
1.17      www       444: #
                    445: # Co-Author
                    446: # 
1.44      matthew   447:     if (&authorpriv($ENV{'user.name'},$ENV{'request.role.domain'}) &&
                    448:         ($ENV{'user.name'} ne $ccuname || $ENV{'user.domain'} ne $ccdomain)) {
                    449:         # No sense in assigning co-author role to yourself
1.17      www       450: 	my $cuname=$ENV{'user.name'};
1.42      matthew   451:         my $cudom=$ENV{'request.role.domain'};
1.17      www       452:        $r->print(<<ENDCOAUTH);
                    453: <h4>Construction Space</h4>
                    454: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
                    455: <th>Start</th><th>End</th></tr>
                    456: <tr>
                    457: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
                    458: <td>Co-Author</td>
                    459: <td>$cudom\_$cuname</td>
                    460: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
                    461: <a href=
                    462: "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>
                    463: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
                    464: <a href=
                    465: "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>
                    466: </tr>
                    467: </table>
                    468: ENDCOAUTH
                    469:     }
1.8       www       470: #
                    471: # Domain level
                    472: #
                    473:     $r->print('<h4>Domain Level</h4>'.
                    474:     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
                    475:     '<th>Start</th><th>End</th></tr>');
1.24      matthew   476:     foreach ( sort( keys(%incdomains))) {
1.2       www       477: 	my $thisdomain=$_;
1.24      matthew   478:         foreach ('dc','li','dg','au') {
1.2       www       479:             if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
1.8       www       480:                my $plrole=&Apache::lonnet::plaintext($_);
                    481:                $r->print(<<ENDDROW);
                    482: <tr>
                    483: <td><input type=checkbox name="act_$thisdomain\_$_"></td>
                    484: <td>$plrole</td>
                    485: <td>$thisdomain</td>
                    486: <td><input type=hidden name="start_$thisdomain\_$_" value=''>
                    487: <a href=
                    488: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>
                    489: <td><input type=hidden name="end_$thisdomain\_$_" value=''>
                    490: <a href=
                    491: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>
                    492: </tr>
                    493: ENDDROW
1.2       www       494:             }
1.24      matthew   495:         } 
                    496:     }
1.8       www       497:     $r->print('</table>');
                    498: #
                    499: # Course level
                    500: #
1.26      matthew   501:     $r->print(&course_level_table(%inccourses));
                    502:     $r->print("<hr /><input type=submit value=\"Modify User\">\n");
                    503:     $r->print("</form></body></html>");
1.2       www       504: }
1.1       www       505: 
1.4       www       506: # ================================================================= Phase Three
1.42      matthew   507: sub update_user_data {
1.4       www       508:     my $r=shift;
1.29      matthew   509:     my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
                    510:                                           $ENV{'form.ccdomain'});
1.27      matthew   511:     # Error messages
                    512:     my $error     = '<font color="#ff0000">Error:</font>';
                    513:     my $end       = '</body></html>';
                    514:     # Print header
1.4       www       515:     $r->print(<<ENDTHREEHEAD);
                    516: <html>
                    517: <head>
                    518: <title>The LearningOnline Network with CAPA</title>
                    519: </head>
                    520: ENDTHREEHEAD
1.40      www       521:     my $title;
                    522:     if (exists($ENV{'form.makeuser'})) {
                    523: 	$title='Set Privileges for New User';
                    524:     } else {
                    525:         $title='Modify User Privileges';
                    526:     }
                    527:     $r->print(&Apache::loncommon::bodytag($title));
1.27      matthew   528:     # Check Inputs
1.29      matthew   529:     if (! $ENV{'form.ccuname'} ) {
1.27      matthew   530: 	$r->print($error.'No login name specified.'.$end);
                    531: 	return;
                    532:     }
1.29      matthew   533:     if (  $ENV{'form.ccuname'}  =~/\W/) {
1.27      matthew   534: 	$r->print($error.'Invalid login name.  '.
                    535: 		  'Only letters, numbers, and underscores are valid.'.
                    536: 		  $end);
                    537: 	return;
                    538:     }
1.29      matthew   539:     if (! $ENV{'form.ccdomain'}       ) {
1.27      matthew   540: 	$r->print($error.'No domain specified.'.$end);
                    541: 	return;
                    542:     }
1.29      matthew   543:     if (  $ENV{'form.ccdomain'} =~/\W/) {
1.27      matthew   544: 	$r->print($error.'Invalid domain name.  '.
                    545: 		  'Only letters, numbers, and underscores are valid.'.
                    546: 		  $end);
                    547: 	return;
                    548:     }
1.29      matthew   549:     if (! exists($ENV{'form.makeuser'})) {
                    550:         # Modifying an existing user, so check the validity of the name
                    551:         if ($uhome eq 'no_host') {
                    552:             $r->print($error.'Unable to determine home server for '.
                    553:                       $ENV{'form.ccuname'}.' in domain '.
                    554:                       $ENV{'form.ccdomain'}.'.');
                    555:             return;
                    556:         }
                    557:     }
1.27      matthew   558:     # Determine authentication method and password for the user being modified
                    559:     my $amode='';
                    560:     my $genpwd='';
                    561:     if ($ENV{'form.login'} eq 'krb') {
1.41      albertel  562: 	$amode='krb';
                    563: 	$amode.=$ENV{'form.krbver'};
1.30      matthew   564: 	$genpwd=$ENV{'form.krbarg'};
1.27      matthew   565:     } elsif ($ENV{'form.login'} eq 'int') {
                    566: 	$amode='internal';
1.30      matthew   567: 	$genpwd=$ENV{'form.intarg'};
1.27      matthew   568:     } elsif ($ENV{'form.login'} eq 'fsys') {
                    569: 	$amode='unix';
1.30      matthew   570: 	$genpwd=$ENV{'form.fsysarg'};
1.27      matthew   571:     } elsif ($ENV{'form.login'} eq 'loc') {
                    572: 	$amode='localauth';
                    573: 	$genpwd=$ENV{'form.locarg'};
                    574: 	$genpwd=" " if (!$genpwd);
1.35      matthew   575:     } elsif (($ENV{'form.login'} eq 'nochange') ||
                    576:              ($ENV{'form.login'} eq ''        )) { 
1.34      matthew   577:         # There is no need to tell the user we did not change what they
                    578:         # did not ask us to change.
1.35      matthew   579:         # If they are creating a new user but have not specified login
                    580:         # information this will be caught below.
1.30      matthew   581:     } else {
                    582: 	    $r->print($error.'Invalid login mode or password'.$end);    
                    583: 	    return;
1.27      matthew   584:     }
                    585:     if ($ENV{'form.makeuser'}) {
                    586:         # Create a new user
                    587: 	$r->print(<<ENDNEWUSERHEAD);
1.29      matthew   588: <h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
1.27      matthew   589: ENDNEWUSERHEAD
                    590:         # Check for the authentication mode and password
                    591:         if (! $amode || ! $genpwd) {
                    592: 	    $r->print($error.'Invalid login mode or password'.$end);    
                    593: 	    return;
1.18      albertel  594: 	}
1.29      matthew   595:         # Determine desired host
                    596:         my $desiredhost = $ENV{'form.hserver'};
                    597:         if (lc($desiredhost) eq 'default') {
                    598:             $desiredhost = undef;
                    599:         } else {
1.39      matthew   600:             my %home_servers = &Apache::loncommon::get_library_servers
1.32      matthew   601:                 ($ENV{'form.ccdomain'});  
1.29      matthew   602:             if (! exists($home_servers{$desiredhost})) {
                    603:                 $r->print($error.'Invalid home server specified');
                    604:                 return;
                    605:             }
                    606:         }
1.27      matthew   607: 	# Call modifyuser
                    608: 	my $result = &Apache::lonnet::modifyuser
1.29      matthew   609: 	    ($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'},
                    610:              $amode,$genpwd,$ENV{'form.cfirst'},
                    611:              $ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},
                    612:              undef,$desiredhost
1.27      matthew   613: 	     );
                    614: 	$r->print('Generating user: '.$result);
1.29      matthew   615:         my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
                    616:                                                $ENV{'form.ccdomain'});
                    617:         $r->print('<br>Home server: '.$home.' '.
                    618:                   $Apache::lonnet::libserv{$home});
1.35      matthew   619:     } elsif (($ENV{'form.login'} ne 'nochange') &&
                    620:              ($ENV{'form.login'} ne ''        )) {
1.27      matthew   621: 	# Modify user privileges
                    622: 	$r->print(<<ENDMODIFYUSERHEAD);
1.29      matthew   623: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
1.27      matthew   624: ENDMODIFYUSERHEAD
                    625:         if (! $amode || ! $genpwd) {
                    626: 	    $r->print($error.'Invalid login mode or password'.$end);    
                    627: 	    return;
1.20      harris41  628: 	}
1.27      matthew   629: 	# Only allow authentification modification if the person has authority
1.36      matthew   630: 	if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'})) {
1.20      harris41  631: 	    $r->print('Modifying authentication: '.
1.31      matthew   632:                       &Apache::lonnet::modifyuserauth(
1.29      matthew   633: 		       $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
1.21      harris41  634:                        $amode,$genpwd));
1.20      harris41  635:             $r->print('<br>Home server: '.&Apache::lonnet::homeserver
1.29      matthew   636: 		  ($ENV{'form.ccuname'},$ENV{'form.ccdomain'}));
1.4       www       637: 	} else {
1.27      matthew   638: 	    # Okay, this is a non-fatal error.
                    639: 	    $r->print($error.'You do not have the authority to modify '.
                    640: 		      'this users authentification information.');    
                    641: 	}
1.28      matthew   642:     }
                    643:     ##
                    644:     if (! $ENV{'form.makeuser'} ) {
                    645:         # Check for need to change
                    646:         my %userenv = &Apache::lonnet::get
                    647:             ('environment',['firstname','middlename','lastname','generation'],
1.29      matthew   648:              $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
1.28      matthew   649:         my ($tmp) = keys(%userenv);
                    650:         if ($tmp =~ /^(con_lost|error)/i) { 
                    651:             %userenv = ();
                    652:         }
                    653:         # Check to see if we need to change user information
                    654:         foreach ('firstname','middlename','lastname','generation') {
                    655:             # Strip leading and trailing whitespace
                    656:             $ENV{'form.c'.$_} =~ s/(\s+$|^\s+)//g; 
                    657:         }
1.29      matthew   658:         if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'}) && 
1.28      matthew   659:             ($ENV{'form.cfirstname'}  ne $userenv{'firstname'}  ||
                    660:              $ENV{'form.cmiddlename'} ne $userenv{'middlename'} ||
                    661:              $ENV{'form.clastname'}   ne $userenv{'lastname'}   ||
                    662:              $ENV{'form.cgeneration'} ne $userenv{'generation'} )) {
                    663:             # Make the change
                    664:             my %changeHash;
                    665:             $changeHash{'firstname'}  = $ENV{'form.cfirstname'};
                    666:             $changeHash{'middlename'} = $ENV{'form.cmiddlename'};
                    667:             $changeHash{'lastname'}   = $ENV{'form.clastname'};
                    668:             $changeHash{'generation'} = $ENV{'form.cgeneration'};
                    669:             my $putresult = &Apache::lonnet::put
                    670:                 ('environment',\%changeHash,
1.29      matthew   671:                  $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
1.28      matthew   672:             if ($putresult eq 'ok') {
                    673:             # Tell the user we changed the name
                    674:                 $r->print(<<"END");
                    675: <table border="2">
                    676: <caption>User Information Changed</caption>
                    677: <tr><th>&nbsp;</th>
                    678:     <th>first</th>
                    679:     <th>middle</th>
                    680:     <th>last</th>
                    681:     <th>generation</th></tr>
                    682: <tr><td>Previous</td>
                    683:     <td>$userenv{'firstname'}  </td>
                    684:     <td>$userenv{'middlename'} </td>
                    685:     <td>$userenv{'lastname'}   </td>
                    686:     <td>$userenv{'generation'} </td></tr>
                    687: <tr><td>Changed To</td>
                    688:     <td>$ENV{'form.cfirstname'}  </td>
                    689:     <td>$ENV{'form.cmiddlename'} </td>
                    690:     <td>$ENV{'form.clastname'}   </td>
                    691:     <td>$ENV{'form.cgeneration'} </td></tr>
                    692: </table>
                    693: END
                    694:             } else { # error occurred
                    695:                 $r->print("<h2>Unable to successfully change environment for ".
1.29      matthew   696:                       $ENV{'form.ccuname'}." in domain ".
                    697:                       $ENV{'form.ccdomain'}."</h2>");
1.28      matthew   698:             }
                    699:         }  else { # End of if ($ENV ... ) logic
                    700:             # They did not want to change the users name but we can
                    701:             # still tell them what the name is
                    702:                 $r->print(<<"END");
1.29      matthew   703: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
1.28      matthew   704: <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
                    705: <h4>Generation: $userenv{'generation'}</h4>
                    706: END
                    707:         }
1.4       www       708:     }
1.27      matthew   709:     ##
1.4       www       710:     my $now=time;
1.6       www       711:     $r->print('<h3>Modifying Roles</h3>');
1.24      matthew   712:     foreach (keys (%ENV)) {
1.27      matthew   713: 	next if (! $ENV{$_});
                    714: 	# Revoke roles
                    715: 	if ($_=~/^form\.rev/) {
                    716: 	    if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {
                    717: 	        $r->print('Revoking '.$2.' in '.$1.': '.
1.29      matthew   718:                      &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
                    719:                      $ENV{'form.ccuname'},$1,$2,$now).'<br>');
1.27      matthew   720: 		if ($2 eq 'st') {
                    721: 		    $1=~/^\/(\w+)\/(\w+)/;
                    722: 		    my $cid=$1.'_'.$2;
                    723: 		    $r->print('Drop from classlist: '.
                    724: 			 &Apache::lonnet::critical('put:'.
                    725:                              $ENV{'course.'.$cid.'.domain'}.':'.
                    726: 	                     $ENV{'course.'.$cid.'.num'}.':classlist:'.
1.29      matthew   727:                          &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
                    728:                              $ENV{'form.ccdomain'}).'='.
1.27      matthew   729:                          &Apache::lonnet::escape($now.':'),
                    730: 	                     $ENV{'course.'.$cid.'.home'}).'<br>');
                    731: 		}
                    732: 	    } 
                    733: 	} elsif ($_=~/^form\.act/) {
                    734: 	    if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {
                    735: 		# Activate roles for sections with 3 id numbers
                    736: 		# set start, end times, and the url for the class
                    737: 		my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 
                    738: 			      $ENV{'form.start_'.$1.'_'.$2} : 
                    739: 			      $now );
                    740: 		my $end   = ( $ENV{'form.end_'.$1.'_'.$2} ? 
                    741: 			      $ENV{'form.end_'.$1.'_'.$2} :
                    742: 			      0 );
                    743: 		my $url='/'.$1.'/'.$2;
                    744: 		if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
                    745: 		    $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
                    746: 		}
                    747: 		# Assign the role and report it
                    748: 		$r->print('Assigning: '.$3.' in '.$url.': '.
                    749:                           &Apache::lonnet::assignrole(
1.29      matthew   750:                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
1.27      matthew   751:                               $url,$3,$end,$start).
                    752: 			  '<br>');
                    753: 		# Handle students differently
                    754: 		if ($3 eq 'st') {
                    755: 		    $url=~/^\/(\w+)\/(\w+)/;
                    756: 		    my $cid=$1.'_'.$2;
                    757: 		    $r->print('Add to classlist: '.
                    758: 			      &Apache::lonnet::critical(
                    759: 				  'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                    760: 	                           $ENV{'course.'.$cid.'.num'}.':classlist:'.
                    761:                                    &Apache::lonnet::escape(
1.29      matthew   762:                                        $ENV{'form.ccuname'}.':'.
                    763:                                        $ENV{'form.ccdomain'} ).'='.
1.27      matthew   764:                                    &Apache::lonnet::escape($end.':'.$start),
                    765: 				       $ENV{'course.'.$cid.'.home'})
                    766: 			      .'<br>');
                    767: 		}
                    768: 	    } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
                    769: 		# Activate roles for sections with two id numbers
                    770: 		# set start, end times, and the url for the class
                    771: 		my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 
                    772: 			      $ENV{'form.start_'.$1.'_'.$2} : 
                    773: 			      $now );
                    774: 		my $end   = ( $ENV{'form.end_'.$1.'_'.$2} ? 
                    775: 			      $ENV{'form.end_'.$1.'_'.$2} :
                    776: 			      0 );
                    777: 		my $url='/'.$1.'/';
                    778: 		# Assign the role and report it.
                    779: 		$r->print('Assigning: '.$2.' in '.$url.': '.
                    780:                           &Apache::lonnet::assignrole(
1.29      matthew   781:                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
1.27      matthew   782:                               $url,$2,$end,$start)
                    783: 			  .'<br>');
1.10      www       784: 	    }
1.27      matthew   785: 	} 
                    786:     } # End of foreach (keys(%ENV))
1.5       www       787:     $r->print('</body></html>');
1.4       www       788: }
                    789: 
1.2       www       790: # ================================================================ Main Handler
                    791: sub handler {
                    792:     my $r = shift;
                    793: 
                    794:     if ($r->header_only) {
                    795:        $r->content_type('text/html');
                    796:        $r->send_http_header;
                    797:        return OK;
                    798:     }
                    799: 
                    800:     if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
                    801:         (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 
                    802:         (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 
                    803:         (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
1.42      matthew   804:         (&Apache::lonnet::allowed('cca',$ENV{'request.role.domain'})) ||
                    805:         (&Apache::lonnet::allowed('mau',$ENV{'request.role.domain'}))) {
1.2       www       806:        $r->content_type('text/html');
                    807:        $r->send_http_header;
                    808:        unless ($ENV{'form.phase'}) {
1.42      matthew   809: 	   &print_username_entry_form($r);
1.2       www       810:        }
1.42      matthew   811:        if ($ENV{'form.phase'} eq 'get_user_info') {
                    812:            &print_user_modification_page($r);
                    813:        } elsif ($ENV{'form.phase'} eq 'update_user_data') {
                    814:            &update_user_data($r);
1.2       www       815:        }
1.1       www       816:    } else {
                    817:       $ENV{'user.error.msg'}=
1.9       albertel  818:         "/adm/createuser:mau:0:0:Cannot modify user data";
1.1       www       819:       return HTTP_NOT_ACCEPTABLE; 
                    820:    }
                    821:    return OK;
                    822: } 
1.26      matthew   823: 
1.27      matthew   824: #-------------------------------------------------- functions for &phase_two
1.26      matthew   825: sub course_level_table {
                    826:     my %inccourses = @_;
                    827:     my $table = '';
                    828:     foreach (sort( keys(%inccourses))) {
                    829: 	my $thiscourse=$_;
                    830: 	my $protectedcourse=$_;
                    831: 	$thiscourse=~s:_:/:g;
                    832: 	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
                    833: 	my $area=$coursedata{'description'};
1.50    ! albertel  834: 	if (!defined($area)) { $area='Unavailable course: '.$_; }
1.26      matthew   835: 	my $bgcol=$thiscourse;
                    836: 	$bgcol=~s/[^8-9b-e]//g;
                    837: 	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
                    838: 	foreach  ('st','ta','ep','ad','in','cc') {
                    839: 	    if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
                    840: 		my $plrole=&Apache::lonnet::plaintext($_);
                    841: 		$table .= <<ENDEXTENT;
                    842: <tr bgcolor="#$bgcol">
                    843: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
                    844: <td>$plrole</td>
                    845: <td>$area</td>
                    846: ENDEXTENT
                    847: 	        if ($_ ne 'cc') {
                    848: 		    $table .= <<ENDSECTION;
                    849: <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td>
                    850: ENDSECTION
                    851:                 } else { 
                    852: 		    $table .= <<ENDSECTION;
                    853: <td>&nbsp</td> 
                    854: ENDSECTION
                    855:                 }
                    856: 		$table .= <<ENDTIMEENTRY;
                    857: <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
                    858: <a href=
                    859: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
                    860: <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
                    861: <a href=
                    862: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
                    863: ENDTIMEENTRY
                    864:                 $table.= "</tr>\n";
                    865:             }
                    866:         }
                    867:     }
                    868:     return '' if ($table eq ''); # return nothing if there is nothing 
                    869:                                  # in the table
                    870:     my $result = <<ENDTABLE;
                    871: <h4>Course Level</h4>
                    872: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
                    873: <th>Group/Section</th><th>Start</th><th>End</th></tr>
                    874: $table
                    875: </table>
                    876: ENDTABLE
                    877:     return $result;
                    878: }
1.27      matthew   879: #---------------------------------------------- end functions for &phase_two
1.29      matthew   880: 
                    881: #--------------------------------- functions for &phase_two and &phase_three
                    882: 
                    883: #--------------------------end of functions for &phase_two and &phase_three
1.1       www       884: 
                    885: 1;
                    886: __END__
1.2       www       887: 
                    888: 

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