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

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

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