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

1.20      harris41    1: # The LearningOnline Network with CAPA
1.1       www         2: # Create a user
                      3: #
1.35    ! matthew     4: # $Id: loncreateuser.pm,v 1.34 2002/04/29 14:32:11 matthew 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.35    ! matthew    50: # $Id: loncreateuser.pm,v 1.34 2002/04/29 14:32:11 matthew 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.2       www        85: sub phase_one {
                     86:     my $r=shift;
                     87:     my $defdom=$ENV{'user.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.2       www        97: <form action=/adm/createuser method=post>
                     98: <input type=hidden name=phase value=two>
1.33      matthew    99: <p>
1.2       www       100: Username: <input type=text size=15 name=ccuname><br>
1.33      matthew   101: Domain: $domform 
                    102: </p>
1.2       www       103: <input type=submit value="Continue">
                    104: </form>
1.1       www       105: </body>
                    106: </html>
                    107: ENDDOCUMENT
1.2       www       108: }
                    109: 
                    110: # =================================================================== Phase two
                    111: sub phase_two {
                    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: 
                    124:     my $defdom=$ENV{'user.domain'};
                    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">
                    162: <input type="hidden" name="phase"       value="three">
                    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.26      matthew   253:            $r->print('<hr /><h3>Revoke Existing Roles</h3>'.
1.2       www       254:              '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.
1.26      matthew   255: 	     '<th>Start</th><th>End</th>');
1.28      matthew   256: 	   foreach my $area (keys(%rolesdump)) {
                    257:               if ($area!~/^rolesdef/) {
                    258:                  my $role = $rolesdump{$area};
                    259:                  my $thisrole=$area;
                    260:                  $area=~s/\_\w\w$//;
                    261:                  my ($role_code,$role_end_time,$role_start_time) =
                    262:                      split(/_/,$role);
                    263:                  my $bgcol='ffffff';
                    264:                  my $allows=0;
                    265:                  if ($area=~/^\/(\w+)\/(\d\w+)/) {
                    266:                     my %coursedata=
                    267:                         &Apache::lonnet::coursedescription($1.'_'.$2);
                    268:                     my $carea='Course: '.$coursedata{'description'};
                    269:                     $inccourses{$1.'_'.$2}=1;
                    270:                     if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {
                    271:                         $allows=1;
                    272:                     }
                    273:                     # Compute the background color based on $area
                    274:                     $bgcol=$1.'_'.$2;
                    275:                     $bgcol=~s/[^8-9b-e]//g;
                    276:                     $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
                    277:                     if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
                    278:                        $carea.='<br>Section/Group: '.$3;
                    279:                     }
                    280:                     $area=$carea;
                    281:                  } else {
                    282:                      # Determine if current user is able to revoke privileges
                    283:                      if ($area=~/^\/(\w+)\//) {
                    284:                         if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
                    285:                            $allows=1;
                    286:                         }
                    287:                      } else {
                    288:                         if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
                    289:                            $allows=1;
                    290:                         }
                    291:                      }
1.2       www       292:                  }
1.28      matthew   293:                  $r->print('<tr bgcolor=#"'.$bgcol.'"><td>');
                    294:                  my $active=1;
                    295:                  $active=0 if (($role_end_time) && ($now>$role_end_time));
                    296:                  if (($active) && ($allows)) {
                    297:                     $r->print('<input type="checkbox" name="rev:'
                    298:                               .$thisrole.'">');
1.7       www       299:                  } else {
1.28      matthew   300:                     $r->print('&nbsp;');
1.2       www       301:                  }
1.28      matthew   302:                  $r->print('</td><td>'.
                    303:                            &Apache::lonnet::plaintext($role_code).
                    304:                            '</td><td>'.$area.'</td><td>'.
                    305:                            ($role_start_time ? localtime($role_start_time)
                    306:                                              : '&nbsp;' )
                    307:                            .'</td><td>'.
                    308:                            ($role_end_time   ? localtime($role_end_time)
                    309:                                              : '&nbsp;' )
                    310:                            ."</td></tr>\n");
1.2       www       311:               }
1.28      matthew   312:            } # end of foreach        (table building loop)
1.2       www       313: 	   $r->print('</table>');
1.28      matthew   314:         }  # End of unless
1.20      harris41  315: 	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
                    316: 	if ($currentauth=~/^krb4:/) {
                    317: 	    $currentauth=~/^krb4:(.*)/;
                    318: 	    my $krbdefdom2=$1;
1.31      matthew   319:             my %param = ( formname => 'document.cu',
                    320:                           kerb_def_dom => $krbdefdom 
                    321:                           );
                    322:             $loginscript  = &Apache::loncommon::authform_header(%param);
1.20      harris41  323: 	}
1.26      matthew   324: 	# Check for a bad authentication type
1.20      harris41  325:         unless ($currentauth=~/^krb4:/ or
                    326: 		$currentauth=~/^unix:/ or
                    327: 		$currentauth=~/^internal:/ or
                    328: 		$currentauth=~/^localauth:/
1.26      matthew   329: 		) { # bad authentication scheme
                    330: 	    if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
                    331: 		$r->print(<<ENDBADAUTH);
1.21      harris41  332: <hr />
1.31      matthew   333: <script type="text/javascript" language="Javascript">
1.21      harris41  334: $loginscript
1.31      matthew   335: </script>
1.20      harris41  336: <font color='#ff0000'>ERROR:</font>
                    337: This user has an unrecognized authentication scheme ($currentauth).
                    338: Please specify login data below.
                    339: <h3>Login Data</h3>
1.31      matthew   340: <p>$generalrule</p>
                    341: <p>$authformkrb</p>
                    342: <p>$authformint</p>
                    343: <p>$authformfsys</p>
                    344: <p>$authformloc</p>
1.26      matthew   345: ENDBADAUTH
                    346:             } else { 
                    347:                 # This user is not allowed to modify the users 
                    348:                 # authentication scheme, so just notify them of the problem
                    349: 		$r->print(<<ENDBADAUTH);
                    350: <hr />
1.31      matthew   351: <script type="text/javascript" language="Javascript">
1.26      matthew   352: $loginscript
1.31      matthew   353: </script>
1.26      matthew   354: <font color="#ff0000"> ERROR: </font>
                    355: This user has an unrecognized authentication scheme ($currentauth).
                    356: Please alert a domain coordinator of this situation.
                    357: <hr />
                    358: ENDBADAUTH
                    359:             }
                    360:         } else { # Authentication type is valid
1.20      harris41  361: 	    my $authformcurrent='';
1.26      matthew   362: 	    my $authform_other='';
1.20      harris41  363: 	    if ($currentauth=~/^krb4:/) {
                    364: 		$authformcurrent=$authformkrb;
1.31      matthew   365: 		$authform_other="<p>$authformint</p>\n".
                    366:                     "<p>$authformfsys</p><p>$authformloc</p>";
1.20      harris41  367: 	    }
                    368: 	    elsif ($currentauth=~/^internal:/) {
                    369: 		$authformcurrent=$authformint;
1.31      matthew   370: 		$authform_other="<p>$authformkrb</p>".
                    371:                     "<p>$authformfsys</p><p>$authformloc</p>";
1.20      harris41  372: 	    }
                    373: 	    elsif ($currentauth=~/^unix:/) {
                    374: 		$authformcurrent=$authformfsys;
1.31      matthew   375: 		$authform_other="<p>$authformkrb</p>".
                    376:                     "<p>$authformint</p><p>$authformloc;</p>";
1.20      harris41  377: 	    }
                    378: 	    elsif ($currentauth=~/^localauth:/) {
                    379: 		$authformcurrent=$authformloc;
1.31      matthew   380: 		$authform_other="<p>$authformkrb</p>".
                    381:                     "<p>$authformint</p><p>$authformfsys</p>";
1.20      harris41  382: 	    }
1.26      matthew   383: 	    $authformcurrent=<<ENDCURRENTAUTH;
1.20      harris41  384: <table border='1'>
                    385: <tr>
                    386: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
                    387: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
                    388: </tr>
                    389: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td>
                    390: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
                    391: </table>
1.26      matthew   392: ENDCURRENTAUTH
                    393:             if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
                    394: 		# Current user has login modification privileges
                    395: 		$r->print(<<ENDOTHERAUTHS);
1.21      harris41  396: <hr />
1.31      matthew   397: <script type="text/javascript" language="Javascript">
1.21      harris41  398: $loginscript
1.31      matthew   399: </script>
1.20      harris41  400: <h3>Change Current Login Data</h3>
1.31      matthew   401: <p>$generalrule</p>
                    402: <p>$authformnop</p>
                    403: <p>$authformcurrent</p>
1.20      harris41  404: <h3>Enter New Login Data</h3>
1.26      matthew   405: $authform_other
                    406: ENDOTHERAUTHS
                    407:             }
                    408:         }  ## End of "check for bad authentication type" logic
1.25      matthew   409:     } ## End of new user/old user logic
1.20      harris41  410:     $r->print('<hr /><h3>Add Roles</h3>');
1.17      www       411: #
                    412: # Co-Author
                    413: # 
                    414: 
                    415:     if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {
                    416: 	my $cuname=$ENV{'user.name'};
                    417:         my $cudom=$ENV{'user.domain'};
                    418:        $r->print(<<ENDCOAUTH);
                    419: <h4>Construction Space</h4>
                    420: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
                    421: <th>Start</th><th>End</th></tr>
                    422: <tr>
                    423: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
                    424: <td>Co-Author</td>
                    425: <td>$cudom\_$cuname</td>
                    426: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
                    427: <a href=
                    428: "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>
                    429: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
                    430: <a href=
                    431: "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>
                    432: </tr>
                    433: </table>
                    434: ENDCOAUTH
                    435:     }
1.8       www       436: #
                    437: # Domain level
                    438: #
                    439:     $r->print('<h4>Domain Level</h4>'.
                    440:     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
                    441:     '<th>Start</th><th>End</th></tr>');
1.24      matthew   442:     foreach ( sort( keys(%incdomains))) {
1.2       www       443: 	my $thisdomain=$_;
1.24      matthew   444:         foreach ('dc','li','dg','au') {
1.2       www       445:             if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
1.8       www       446:                my $plrole=&Apache::lonnet::plaintext($_);
                    447:                $r->print(<<ENDDROW);
                    448: <tr>
                    449: <td><input type=checkbox name="act_$thisdomain\_$_"></td>
                    450: <td>$plrole</td>
                    451: <td>$thisdomain</td>
                    452: <td><input type=hidden name="start_$thisdomain\_$_" value=''>
                    453: <a href=
                    454: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>
                    455: <td><input type=hidden name="end_$thisdomain\_$_" value=''>
                    456: <a href=
                    457: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>
                    458: </tr>
                    459: ENDDROW
1.2       www       460:             }
1.24      matthew   461:         } 
                    462:     }
1.8       www       463:     $r->print('</table>');
                    464: #
                    465: # Course level
                    466: #
1.26      matthew   467:     $r->print(&course_level_table(%inccourses));
                    468:     $r->print("<hr /><input type=submit value=\"Modify User\">\n");
                    469:     $r->print("</form></body></html>");
1.2       www       470: }
1.1       www       471: 
1.4       www       472: # ================================================================= Phase Three
                    473: sub phase_three {
                    474:     my $r=shift;
1.29      matthew   475:     my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'},
                    476:                                           $ENV{'form.ccdomain'});
1.27      matthew   477:     # Error messages
                    478:     my $error     = '<font color="#ff0000">Error:</font>';
                    479:     my $end       = '</body></html>';
                    480:     # Print header
1.4       www       481:     $r->print(<<ENDTHREEHEAD);
                    482: <html>
                    483: <head>
                    484: <title>The LearningOnline Network with CAPA</title>
                    485: </head>
                    486: <body bgcolor="#FFFFFF">
1.27      matthew   487: <img align="right" src="/adm/lonIcons/lonlogos.gif">
1.4       www       488: ENDTHREEHEAD
1.27      matthew   489:     # Check Inputs
1.29      matthew   490:     if (! $ENV{'form.ccuname'} ) {
1.27      matthew   491: 	$r->print($error.'No login name specified.'.$end);
                    492: 	return;
                    493:     }
1.29      matthew   494:     if (  $ENV{'form.ccuname'}  =~/\W/) {
1.27      matthew   495: 	$r->print($error.'Invalid login name.  '.
                    496: 		  'Only letters, numbers, and underscores are valid.'.
                    497: 		  $end);
                    498: 	return;
                    499:     }
1.29      matthew   500:     if (! $ENV{'form.ccdomain'}       ) {
1.27      matthew   501: 	$r->print($error.'No domain specified.'.$end);
                    502: 	return;
                    503:     }
1.29      matthew   504:     if (  $ENV{'form.ccdomain'} =~/\W/) {
1.27      matthew   505: 	$r->print($error.'Invalid domain name.  '.
                    506: 		  'Only letters, numbers, and underscores are valid.'.
                    507: 		  $end);
                    508: 	return;
                    509:     }
1.29      matthew   510:     if (! exists($ENV{'form.makeuser'})) {
                    511:         # Modifying an existing user, so check the validity of the name
                    512:         if ($uhome eq 'no_host') {
                    513:             $r->print($error.'Unable to determine home server for '.
                    514:                       $ENV{'form.ccuname'}.' in domain '.
                    515:                       $ENV{'form.ccdomain'}.'.');
                    516:             return;
                    517:         }
                    518:     }
1.27      matthew   519:     # Determine authentication method and password for the user being modified
                    520:     my $amode='';
                    521:     my $genpwd='';
                    522:     if ($ENV{'form.login'} eq 'krb') {
                    523: 	$amode='krb4';
1.30      matthew   524: 	$genpwd=$ENV{'form.krbarg'};
1.27      matthew   525:     } elsif ($ENV{'form.login'} eq 'int') {
                    526: 	$amode='internal';
1.30      matthew   527: 	$genpwd=$ENV{'form.intarg'};
1.27      matthew   528:     } elsif ($ENV{'form.login'} eq 'fsys') {
                    529: 	$amode='unix';
1.30      matthew   530: 	$genpwd=$ENV{'form.fsysarg'};
1.27      matthew   531:     } elsif ($ENV{'form.login'} eq 'loc') {
                    532: 	$amode='localauth';
                    533: 	$genpwd=$ENV{'form.locarg'};
                    534: 	$genpwd=" " if (!$genpwd);
1.35    ! matthew   535:     } elsif (($ENV{'form.login'} eq 'nochange') ||
        !           536:              ($ENV{'form.login'} eq ''        )) { 
1.34      matthew   537:         # There is no need to tell the user we did not change what they
                    538:         # did not ask us to change.
1.35    ! matthew   539:         # If they are creating a new user but have not specified login
        !           540:         # information this will be caught below.
1.30      matthew   541:     } else {
                    542: 	    $r->print($error.'Invalid login mode or password'.$end);    
                    543: 	    return;
1.27      matthew   544:     }
                    545:     if ($ENV{'form.makeuser'}) {
                    546:         # Create a new user
                    547: 	$r->print(<<ENDNEWUSERHEAD);
                    548: <h1>Create User</h1>
1.29      matthew   549: <h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
1.27      matthew   550: ENDNEWUSERHEAD
                    551:         # Check for the authentication mode and password
                    552:         if (! $amode || ! $genpwd) {
                    553: 	    $r->print($error.'Invalid login mode or password'.$end);    
                    554: 	    return;
1.18      albertel  555: 	}
1.29      matthew   556:         # Determine desired host
                    557:         my $desiredhost = $ENV{'form.hserver'};
                    558:         if (lc($desiredhost) eq 'default') {
                    559:             $desiredhost = undef;
                    560:         } else {
1.32      matthew   561:             my %home_servers = &Apache::loncommon::get_home_servers
                    562:                 ($ENV{'form.ccdomain'});  
1.29      matthew   563:             if (! exists($home_servers{$desiredhost})) {
                    564:                 $r->print($error.'Invalid home server specified');
                    565:                 return;
                    566:             }
                    567:         }
1.27      matthew   568: 	# Call modifyuser
                    569: 	my $result = &Apache::lonnet::modifyuser
1.29      matthew   570: 	    ($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'},
                    571:              $amode,$genpwd,$ENV{'form.cfirst'},
                    572:              $ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'},
                    573:              undef,$desiredhost
1.27      matthew   574: 	     );
                    575: 	$r->print('Generating user: '.$result);
1.29      matthew   576:         my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'},
                    577:                                                $ENV{'form.ccdomain'});
                    578:         $r->print('<br>Home server: '.$home.' '.
                    579:                   $Apache::lonnet::libserv{$home});
1.35    ! matthew   580:     } elsif (($ENV{'form.login'} ne 'nochange') &&
        !           581:              ($ENV{'form.login'} ne ''        )) {
1.27      matthew   582: 	# Modify user privileges
                    583: 	$r->print(<<ENDMODIFYUSERHEAD);
                    584: <h1>Change User Privileges</h1>
1.29      matthew   585: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
1.27      matthew   586: ENDMODIFYUSERHEAD
                    587:         if (! $amode || ! $genpwd) {
                    588: 	    $r->print($error.'Invalid login mode or password'.$end);    
                    589: 	    return;
1.20      harris41  590: 	}
1.27      matthew   591: 	# Only allow authentification modification if the person has authority
                    592: 	if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
1.20      harris41  593: 	    $r->print('Modifying authentication: '.
1.31      matthew   594:                       &Apache::lonnet::modifyuserauth(
1.29      matthew   595: 		       $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
1.21      harris41  596:                        $amode,$genpwd));
1.20      harris41  597:             $r->print('<br>Home server: '.&Apache::lonnet::homeserver
1.29      matthew   598: 		  ($ENV{'form.ccuname'},$ENV{'form.ccdomain'}));
1.4       www       599: 	} else {
1.27      matthew   600: 	    # Okay, this is a non-fatal error.
                    601: 	    $r->print($error.'You do not have the authority to modify '.
                    602: 		      'this users authentification information.');    
                    603: 	}
1.28      matthew   604:     }
                    605:     ##
                    606:     if (! $ENV{'form.makeuser'} ) {
                    607:         # Check for need to change
                    608:         my %userenv = &Apache::lonnet::get
                    609:             ('environment',['firstname','middlename','lastname','generation'],
1.29      matthew   610:              $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
1.28      matthew   611:         my ($tmp) = keys(%userenv);
                    612:         if ($tmp =~ /^(con_lost|error)/i) { 
                    613:             %userenv = ();
                    614:         }
                    615:         # Check to see if we need to change user information
                    616:         foreach ('firstname','middlename','lastname','generation') {
                    617:             # Strip leading and trailing whitespace
                    618:             $ENV{'form.c'.$_} =~ s/(\s+$|^\s+)//g; 
                    619:         }
1.29      matthew   620:         if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'}) && 
1.28      matthew   621:             ($ENV{'form.cfirstname'}  ne $userenv{'firstname'}  ||
                    622:              $ENV{'form.cmiddlename'} ne $userenv{'middlename'} ||
                    623:              $ENV{'form.clastname'}   ne $userenv{'lastname'}   ||
                    624:              $ENV{'form.cgeneration'} ne $userenv{'generation'} )) {
                    625:             # Make the change
                    626:             my %changeHash;
                    627:             $changeHash{'firstname'}  = $ENV{'form.cfirstname'};
                    628:             $changeHash{'middlename'} = $ENV{'form.cmiddlename'};
                    629:             $changeHash{'lastname'}   = $ENV{'form.clastname'};
                    630:             $changeHash{'generation'} = $ENV{'form.cgeneration'};
                    631:             my $putresult = &Apache::lonnet::put
                    632:                 ('environment',\%changeHash,
1.29      matthew   633:                  $ENV{'form.ccdomain'},$ENV{'form.ccuname'});
1.28      matthew   634:             if ($putresult eq 'ok') {
                    635:             # Tell the user we changed the name
                    636:                 $r->print(<<"END");
                    637: <table border="2">
                    638: <caption>User Information Changed</caption>
                    639: <tr><th>&nbsp;</th>
                    640:     <th>first</th>
                    641:     <th>middle</th>
                    642:     <th>last</th>
                    643:     <th>generation</th></tr>
                    644: <tr><td>Previous</td>
                    645:     <td>$userenv{'firstname'}  </td>
                    646:     <td>$userenv{'middlename'} </td>
                    647:     <td>$userenv{'lastname'}   </td>
                    648:     <td>$userenv{'generation'} </td></tr>
                    649: <tr><td>Changed To</td>
                    650:     <td>$ENV{'form.cfirstname'}  </td>
                    651:     <td>$ENV{'form.cmiddlename'} </td>
                    652:     <td>$ENV{'form.clastname'}   </td>
                    653:     <td>$ENV{'form.cgeneration'} </td></tr>
                    654: </table>
                    655: END
                    656:             } else { # error occurred
                    657:                 $r->print("<h2>Unable to successfully change environment for ".
1.29      matthew   658:                       $ENV{'form.ccuname'}." in domain ".
                    659:                       $ENV{'form.ccdomain'}."</h2>");
1.28      matthew   660:             }
                    661:         }  else { # End of if ($ENV ... ) logic
                    662:             # They did not want to change the users name but we can
                    663:             # still tell them what the name is
                    664:                 $r->print(<<"END");
1.29      matthew   665: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2>
1.28      matthew   666: <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4>
                    667: <h4>Generation: $userenv{'generation'}</h4>
                    668: END
                    669:         }
1.4       www       670:     }
1.27      matthew   671:     ##
1.4       www       672:     my $now=time;
1.6       www       673:     $r->print('<h3>Modifying Roles</h3>');
1.24      matthew   674:     foreach (keys (%ENV)) {
1.27      matthew   675: 	next if (! $ENV{$_});
                    676: 	# Revoke roles
                    677: 	if ($_=~/^form\.rev/) {
                    678: 	    if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) {
                    679: 	        $r->print('Revoking '.$2.' in '.$1.': '.
1.29      matthew   680:                      &Apache::lonnet::assignrole($ENV{'form.ccdomain'},
                    681:                      $ENV{'form.ccuname'},$1,$2,$now).'<br>');
1.27      matthew   682: 		if ($2 eq 'st') {
                    683: 		    $1=~/^\/(\w+)\/(\w+)/;
                    684: 		    my $cid=$1.'_'.$2;
                    685: 		    $r->print('Drop from classlist: '.
                    686: 			 &Apache::lonnet::critical('put:'.
                    687:                              $ENV{'course.'.$cid.'.domain'}.':'.
                    688: 	                     $ENV{'course.'.$cid.'.num'}.':classlist:'.
1.29      matthew   689:                          &Apache::lonnet::escape($ENV{'form.ccuname'}.':'.
                    690:                              $ENV{'form.ccdomain'}).'='.
1.27      matthew   691:                          &Apache::lonnet::escape($now.':'),
                    692: 	                     $ENV{'course.'.$cid.'.home'}).'<br>');
                    693: 		}
                    694: 	    } 
                    695: 	} elsif ($_=~/^form\.act/) {
                    696: 	    if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) {
                    697: 		# Activate roles for sections with 3 id numbers
                    698: 		# set start, end times, and the url for the class
                    699: 		my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 
                    700: 			      $ENV{'form.start_'.$1.'_'.$2} : 
                    701: 			      $now );
                    702: 		my $end   = ( $ENV{'form.end_'.$1.'_'.$2} ? 
                    703: 			      $ENV{'form.end_'.$1.'_'.$2} :
                    704: 			      0 );
                    705: 		my $url='/'.$1.'/'.$2;
                    706: 		if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
                    707: 		    $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
                    708: 		}
                    709: 		# Assign the role and report it
                    710: 		$r->print('Assigning: '.$3.' in '.$url.': '.
                    711:                           &Apache::lonnet::assignrole(
1.29      matthew   712:                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
1.27      matthew   713:                               $url,$3,$end,$start).
                    714: 			  '<br>');
                    715: 		# Handle students differently
                    716: 		if ($3 eq 'st') {
                    717: 		    $url=~/^\/(\w+)\/(\w+)/;
                    718: 		    my $cid=$1.'_'.$2;
                    719: 		    $r->print('Add to classlist: '.
                    720: 			      &Apache::lonnet::critical(
                    721: 				  'put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                    722: 	                           $ENV{'course.'.$cid.'.num'}.':classlist:'.
                    723:                                    &Apache::lonnet::escape(
1.29      matthew   724:                                        $ENV{'form.ccuname'}.':'.
                    725:                                        $ENV{'form.ccdomain'} ).'='.
1.27      matthew   726:                                    &Apache::lonnet::escape($end.':'.$start),
                    727: 				       $ENV{'course.'.$cid.'.home'})
                    728: 			      .'<br>');
                    729: 		}
                    730: 	    } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) {
                    731: 		# Activate roles for sections with two id numbers
                    732: 		# set start, end times, and the url for the class
                    733: 		my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 
                    734: 			      $ENV{'form.start_'.$1.'_'.$2} : 
                    735: 			      $now );
                    736: 		my $end   = ( $ENV{'form.end_'.$1.'_'.$2} ? 
                    737: 			      $ENV{'form.end_'.$1.'_'.$2} :
                    738: 			      0 );
                    739: 		my $url='/'.$1.'/';
                    740: 		# Assign the role and report it.
                    741: 		$r->print('Assigning: '.$2.' in '.$url.': '.
                    742:                           &Apache::lonnet::assignrole(
1.29      matthew   743:                               $ENV{'form.ccdomain'},$ENV{'form.ccuname'},
1.27      matthew   744:                               $url,$2,$end,$start)
                    745: 			  .'<br>');
1.10      www       746: 	    }
1.27      matthew   747: 	} 
                    748:     } # End of foreach (keys(%ENV))
1.5       www       749:     $r->print('</body></html>');
1.4       www       750: }
                    751: 
1.2       www       752: # ================================================================ Main Handler
                    753: sub handler {
                    754:     my $r = shift;
                    755: 
                    756:     if ($r->header_only) {
                    757:        $r->content_type('text/html');
                    758:        $r->send_http_header;
                    759:        return OK;
                    760:     }
                    761: 
                    762:     if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
                    763:         (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 
                    764:         (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 
                    765:         (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
1.19      www       766:         (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) ||
1.2       www       767:         (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {
                    768:        $r->content_type('text/html');
                    769:        $r->send_http_header;
                    770:        unless ($ENV{'form.phase'}) {
                    771: 	   &phase_one($r);
                    772:        }
                    773:        if ($ENV{'form.phase'} eq 'two') {
                    774:            &phase_two($r);
1.4       www       775:        } elsif ($ENV{'form.phase'} eq 'three') {
                    776:            &phase_three($r);
1.2       www       777:        }
1.1       www       778:    } else {
                    779:       $ENV{'user.error.msg'}=
1.9       albertel  780:         "/adm/createuser:mau:0:0:Cannot modify user data";
1.1       www       781:       return HTTP_NOT_ACCEPTABLE; 
                    782:    }
                    783:    return OK;
                    784: } 
1.26      matthew   785: 
1.27      matthew   786: #-------------------------------------------------- functions for &phase_two
1.26      matthew   787: sub course_level_table {
                    788:     my %inccourses = @_;
                    789:     my $table = '';
                    790:     foreach (sort( keys(%inccourses))) {
                    791: 	my $thiscourse=$_;
                    792: 	my $protectedcourse=$_;
                    793: 	$thiscourse=~s:_:/:g;
                    794: 	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
                    795: 	my $area=$coursedata{'description'};
                    796: 	my $bgcol=$thiscourse;
                    797: 	$bgcol=~s/[^8-9b-e]//g;
                    798: 	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
                    799: 	foreach  ('st','ta','ep','ad','in','cc') {
                    800: 	    if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
                    801: 		my $plrole=&Apache::lonnet::plaintext($_);
                    802: 		$table .= <<ENDEXTENT;
                    803: <tr bgcolor="#$bgcol">
                    804: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
                    805: <td>$plrole</td>
                    806: <td>$area</td>
                    807: ENDEXTENT
                    808: 	        if ($_ ne 'cc') {
                    809: 		    $table .= <<ENDSECTION;
                    810: <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td>
                    811: ENDSECTION
                    812:                 } else { 
                    813: 		    $table .= <<ENDSECTION;
                    814: <td>&nbsp</td> 
                    815: ENDSECTION
                    816:                 }
                    817: 		$table .= <<ENDTIMEENTRY;
                    818: <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
                    819: <a href=
                    820: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
                    821: <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
                    822: <a href=
                    823: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
                    824: ENDTIMEENTRY
                    825:                 $table.= "</tr>\n";
                    826:             }
                    827:         }
                    828:     }
                    829:     return '' if ($table eq ''); # return nothing if there is nothing 
                    830:                                  # in the table
                    831:     my $result = <<ENDTABLE;
                    832: <h4>Course Level</h4>
                    833: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
                    834: <th>Group/Section</th><th>Start</th><th>End</th></tr>
                    835: $table
                    836: </table>
                    837: ENDTABLE
                    838:     return $result;
                    839: }
1.27      matthew   840: #---------------------------------------------- end functions for &phase_two
1.29      matthew   841: 
                    842: #--------------------------------- functions for &phase_two and &phase_three
                    843: 
                    844: #--------------------------end of functions for &phase_two and &phase_three
1.1       www       845: 
                    846: 1;
                    847: __END__
1.2       www       848: 
                    849: 

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