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

1.20      harris41    1: # The LearningOnline Network with CAPA
1.1       www         2: # Create a user
                      3: #
1.26    ! matthew     4: # $Id: loncreateuser.pm,v 1.25 2002/02/11 15:37:58 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.26    ! matthew    50: # $Id: loncreateuser.pm,v 1.25 2002/02/11 15:37:58 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/;
                     71:     $authformnop=(<<END);
                     72: <p>
                     73: <input type=radio name=login value=nop checked='checked'
                     74: onClick="clicknop(this.form);">
                     75: Do not change login data
                     76: </p>
                     77: END
                     78:     $authformkrb=(<<END);
                     79: <p>
                     80: <input type=radio name=login value=krb onClick="clickkrb(this.form);">
                     81: Kerberos authenticated with domain
                     82: <input type=text size=10 name=krbdom onChange="setkrb(this.form);">
                     83: </p>
                     84: END
                     85:     $authformint=(<<END);
                     86: <p>
                     87: <input type=radio name=login value=int onClick="clickint(this.form);"> 
                     88: Internally authenticated (with initial password 
                     89: <input type=text size=10 name=intpwd onChange="setint(this.form);">)
                     90: </p>
                     91: END
                     92:     $authformfsys=(<<END);
                     93: <p>
                     94: <input type=radio name=login value=fsys onClick="clickfsys(this.form);"> 
                     95: Filesystem authenticated (with initial password 
                     96: <input type=text size=10 name=fsyspwd onChange="setfsys(this.form);">)
                     97: </p>
                     98: END
                     99:     $authformloc=(<<END);
                    100: <p>
                    101: <input type=radio name=login value=loc onClick="clickloc(this.form);" />
                    102: Local Authentication with argument
                    103: <input type=text size=10 name=locarg onChange="setloc(this.form);" />
                    104: </p>
                    105: END
                    106:     $loginscript=(<<ENDLOGINSCRIPT);
                    107: <script>
                    108: function setkrb(vf) {
                    109:     if (vf.krbdom.value!='') {
                    110:        vf.login[0].checked=true;
                    111:        vf.krbdom.value=vf.krbdom.value.toUpperCase();
                    112:        vf.intpwd.value='';
                    113:        vf.fsyspwd.value='';
                    114:        vf.locarg.value='';
                    115:    }
                    116: }
                    117: 
                    118: function setint(vf) {
                    119:     if (vf.intpwd.value!='') {
                    120:        vf.login[1].checked=true;
                    121:        vf.krbdom.value='';
                    122:        vf.fsyspwd.value='';
                    123:        vf.locarg.value='';
                    124:    }
                    125: }
                    126: 
                    127: function setfsys(vf) {
                    128:     if (vf.fsyspwd.value!='') {
                    129:        vf.login[2].checked=true;
                    130:        vf.krbdom.value='';
                    131:        vf.intpwd.value='';
                    132:        vf.locarg.value='';
                    133:    }
                    134: }
                    135: 
                    136: function setloc(vf) {
                    137:     if (vf.locarg.value!='') {
                    138:        vf.login[3].checked=true;
                    139:        vf.krbdom.value='';
                    140:        vf.intpwd.value='';
                    141:        vf.fsyspwd.value='';
                    142:    }
                    143: }
                    144: 
                    145: function clicknop(vf) {
                    146:     vf.krbdom.value='';
                    147:     vf.intpwd.value='';
                    148:     vf.fsyspwd.value='';
                    149:     vf.locarg.value='';
                    150: }
                    151: 
                    152: function clickkrb(vf) {
                    153:     vf.krbdom.value='$krbdefdom';
                    154:     vf.intpwd.value='';
                    155:     vf.fsyspwd.value='';
                    156:     vf.locarg.value='';
                    157: }
                    158: 
                    159: function clickint(vf) {
                    160:     vf.krbdom.value='';
                    161:     vf.fsyspwd.value='';
                    162:     vf.locarg.value='';
                    163: }
                    164: 
                    165: function clickfsys(vf) {
                    166:     vf.krbdom.value='';
                    167:     vf.intpwd.value='';
                    168:     vf.locarg.value='';
                    169: }
                    170: 
                    171: function clickloc(vf) {
                    172:     vf.krbdom.value='';
                    173:     vf.intpwd.value='';
                    174:     vf.fsyspwd.value='';
                    175: }
                    176: </script>
                    177: ENDLOGINSCRIPT
                    178:     $generalrule=<<END;
                    179: <p>
                    180: <i>As a general rule, only authors or co-authors should be filesystem
                    181: authenticated (which allows access to the server filesystem).</i>
                    182: </p>
                    183: END
                    184: }
                    185: 
1.2       www       186: # =================================================================== Phase one
1.1       www       187: 
1.2       www       188: sub phase_one {
                    189:     my $r=shift;
                    190:     my $defdom=$ENV{'user.domain'};
1.1       www       191:     $r->print(<<ENDDOCUMENT);
                    192: <html>
                    193: <head>
                    194: <title>The LearningOnline Network with CAPA</title>
                    195: </head>
                    196: <body bgcolor="#FFFFFF">
                    197: <h1>Create User, Change User Privileges</h1>
1.2       www       198: <form action=/adm/createuser method=post>
                    199: <input type=hidden name=phase value=two>
                    200: Username: <input type=text size=15 name=ccuname><br>
                    201: Domain: <input type=text size=15 name=ccdomain value=$defdom><p>
                    202: <input type=submit value="Continue">
                    203: </form>
1.1       www       204: </body>
                    205: </html>
                    206: ENDDOCUMENT
1.2       www       207: }
                    208: 
                    209: # =================================================================== Phase two
                    210: sub phase_two {
                    211:     my $r=shift;
                    212:     my $ccuname=$ENV{'form.ccuname'};
                    213:     my $ccdomain=$ENV{'form.ccdomain'};
1.4       www       214: 
                    215:     $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                    216:     my $krbdefdom=$1;
                    217:     $krbdefdom=~tr/a-z/A-Z/;
                    218: 
                    219:     my $defdom=$ENV{'user.domain'};
                    220: 
1.2       www       221:     $ccuname=~s/\W//g;
                    222:     $ccdomain=~s/\W//g;
1.25      matthew   223:     my $dochead =<<"ENDDOCHEAD";
1.2       www       224: <html>
                    225: <head>
                    226: <title>The LearningOnline Network with CAPA</title>
1.3       www       227: <script>
                    228: 
                    229:     function pclose() {
                    230:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    231:                  "height=350,width=350,scrollbars=no,menubar=no");
                    232:         parmwin.close();
                    233:     }
                    234: 
                    235:     function pjump(type,dis,value,marker,ret,call) {
                    236:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
                    237:                  +"&value="+escape(value)+"&marker="+escape(marker)
                    238:                  +"&return="+escape(ret)
                    239:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
                    240:                  "height=350,width=350,scrollbars=no,menubar=no");
                    241: 
                    242:     }
                    243: 
                    244:     function dateset() {
                    245:         eval("document.cu."+document.cu.pres_marker.value+
                    246:             ".value=document.cu.pres_value.value");
                    247:         pclose();
                    248:     }
                    249: 
                    250: </script>
1.2       www       251: </head>
                    252: <body bgcolor="#FFFFFF">
1.25      matthew   253: <img align="right" src="/adm/lonIcons/lonlogos.gif">
                    254: ENDDOCHEAD
                    255:     my $forminfo =<<"ENDFORMINFO";
                    256: <form action="/adm/createuser" method="post" name="cu">
                    257: <input type="hidden" name="phase"       value="three">
                    258: <input type="hidden" name="ccuname"     value="$ccuname">
                    259: <input type="hidden" name="ccdomain"    value="$ccdomain">
                    260: <input type="hidden" name="pres_value"  value="" >
                    261: <input type="hidden" name="pres_type"   value="" >
                    262: <input type="hidden" name="pres_marker" value="" >
                    263: <input type="hidden" name="cuname"      value="$ccuname">
                    264: <input type="hidden" name="cdomain"     value="$ccdomain">
                    265: ENDFORMINFO
1.2       www       266:     my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
                    267:     my %incdomains; 
                    268:     my %inccourses;
1.24      matthew   269:     foreach (%Apache::lonnet::hostdom) {
1.13      www       270:        $incdomains{$_}=1;
1.24      matthew   271:     }
                    272:     foreach (keys(%ENV)) {
1.2       www       273: 	if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) {
                    274: 	    $inccourses{$1.'_'.$2}=1;
                    275:         }
1.24      matthew   276:     }
1.2       www       277:     if ($uhome eq 'no_host') {
1.26    ! matthew   278: 	$r->print(<<ENDNEWUSER);
1.25      matthew   279: $dochead
                    280: <h1>Create New User</h1>
                    281: $forminfo
                    282: <h2>New user "$ccuname" in domain $ccdomain</h2>
1.20      harris41  283: $loginscript
                    284: <input type='hidden' name='makeuser' value='1' />
1.4       www       285: <h3>Personal Data</h3>
1.25      matthew   286: <p>
                    287: <table>
                    288: <tr><td>First Name  </td>
                    289:     <td><input type='text' name='cfirst'  size='15' /></td></tr>
                    290: <tr><td>Middle Name </td> 
                    291:     <td><input type='text' name='cmiddle' size='15' /></td></tr>
                    292: <tr><td>Last Name   </td>
                    293:     <td><input type='text' name='clast'   size='15' /></td></tr>
                    294: <tr><td>Generation  </td>
                    295:     <td><input type='text' name='cgen'    size='5'  /></td></tr>
                    296: </table>
                    297: ID/Student Number <input type='text' name='cstid'   size='15' /></p>
1.4       www       298: 
1.25      matthew   299: <hr />
1.4       www       300: 
                    301: <h3>Login Data</h3>
1.20      harris41  302: $generalrule
                    303: $authformkrb
                    304: $authformint
                    305: $authformfsys
                    306: $authformloc
1.26    ! matthew   307: ENDNEWUSER
1.25      matthew   308:     } else { # user already exists
1.26    ! matthew   309: 	$r->print(<<ENDCHANGEUSER);
1.25      matthew   310: $dochead
                    311: <h1>Change User Privileges</h1>
                    312: $forminfo
                    313: <h2>User "$ccuname" in domain $ccdomain </h2>
1.26    ! matthew   314: ENDCHANGEUSER
1.2       www       315:         my $rolesdump=&Apache::lonnet::reply(
                    316:                                   "dump:$ccdomain:$ccuname:roles",$uhome);
1.25      matthew   317:         # Build up table of user roles to allow revocation of a role.
1.26    ! matthew   318:         unless ($rolesdump eq 'con_lost' || $rolesdump =~ m/^error/i) { 
1.2       www       319:            my $now=time;
1.26    ! matthew   320:            $r->print('<hr /><h3>Revoke Existing Roles</h3>'.
1.2       www       321:              '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'.
1.26    ! matthew   322: 	     '<th>Start</th><th>End</th>');
1.24      matthew   323: 	   foreach (split(/&/,$rolesdump)) {
1.2       www       324:              if ($_!~/^rolesdef\&/) {
                    325:               my ($area,$role)=split(/=/,$_);
                    326:               my $thisrole=$area;
                    327:               $area=~s/\_\w\w$//;
1.25      matthew   328:               my ($role_code,$role_end_time,$role_start_time)=split(/_/,$role);
1.3       www       329:               my $bgcol='ffffff';
1.2       www       330:               my $allows=0;
1.5       www       331:               if ($area=~/^\/(\w+)\/(\d\w+)/) {
1.2       www       332:                  my %coursedata=&Apache::lonnet::coursedescription($1.'_'.$2);
1.5       www       333:                  my $carea='Course: '.$coursedata{'description'};
1.2       www       334:                  $inccourses{$1.'_'.$2}=1;
1.25      matthew   335:                  if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) {
1.2       www       336: 		     $allows=1;
                    337:                  }
1.26    ! matthew   338: 		 # Compute the background color based on $area
1.3       www       339:                  $bgcol=$1.'_'.$2;
                    340:                  $bgcol=~s/[^8-9b-e]//g;
                    341:                  $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
1.5       www       342:                  if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) {
                    343:                      $carea.='<br>Section/Group: '.$3;
                    344: 		 }
                    345:                  $area=$carea;
1.2       www       346: 	      } else {
1.7       www       347:                  if ($area=~/^\/(\w+)\//) {
1.25      matthew   348:                      if (&Apache::lonnet::allowed('c'.$role_code,$1)) {
1.7       www       349: 			 $allows=1;
                    350:                      }
                    351:                  } else {
1.25      matthew   352:                      if (&Apache::lonnet::allowed('c'.$role_code,'/')) {
1.2       www       353: 			 $allows=1;
                    354:                      }
                    355:                  }
                    356: 	      }
                    357: 
1.26    ! matthew   358:               $r->print('<tr bgcolor=#"'.$bgcol.'"><td>');
1.2       www       359:               my $active=1;
1.25      matthew   360:               if (($role_end_time) && ($now>$role_end_time)) { $active=0; }
                    361:               if (!($active) && ($allows)) {
                    362: 		  $r->print('<input type=checkbox name="rev:'.$thisrole.'">');
1.2       www       363:               } else {
                    364:                   $r->print('&nbsp;');
                    365:               }
1.25      matthew   366:               $r->print('</td><td>'.&Apache::lonnet::plaintext($role_code).
1.2       www       367:                         '</td><td>'.$area.'</td><td>'.
1.25      matthew   368:                         ($role_start_time ? localtime($role_start_time)
                    369:                                           : '&nbsp;' )
                    370: 			.'</td><td>'.
                    371:                         ($role_end_time   ? localtime($role_end_time)
                    372:                                           : '&nbsp;' )
                    373: 			."</td></tr>\n");
1.2       www       374: 	     }
1.24      matthew   375: 	   } 
1.2       www       376: 	   $r->print('</table>');
                    377:          }   
1.20      harris41  378: 	my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain);
                    379: 	if ($currentauth=~/^krb4:/) {
                    380: 	    $currentauth=~/^krb4:(.*)/;
                    381: 	    my $krbdefdom2=$1;
                    382: 	    $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/;
                    383: 	}
1.26    ! matthew   384: 	# Check for a bad authentication type
1.20      harris41  385:         unless ($currentauth=~/^krb4:/ or
                    386: 		$currentauth=~/^unix:/ or
                    387: 		$currentauth=~/^internal:/ or
                    388: 		$currentauth=~/^localauth:/
1.26    ! matthew   389: 		) { # bad authentication scheme
        !           390: 	    if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
        !           391: 		$r->print(<<ENDBADAUTH);
1.21      harris41  392: <hr />
                    393: $loginscript
1.20      harris41  394: <font color='#ff0000'>ERROR:</font>
                    395: This user has an unrecognized authentication scheme ($currentauth).
                    396: Please specify login data below.
                    397: <h3>Login Data</h3>
                    398: $generalrule
                    399: $authformkrb
                    400: $authformint
                    401: $authformfsys
                    402: $authformloc
1.26    ! matthew   403: ENDBADAUTH
        !           404:             } else { 
        !           405:                 # This user is not allowed to modify the users 
        !           406:                 # authentication scheme, so just notify them of the problem
        !           407: 		$r->print(<<ENDBADAUTH);
        !           408: <hr />
        !           409: $loginscript
        !           410: <font color="#ff0000"> ERROR: </font>
        !           411: This user has an unrecognized authentication scheme ($currentauth).
        !           412: Please alert a domain coordinator of this situation.
        !           413: <hr />
        !           414: ENDBADAUTH
        !           415:             }
        !           416:         } else { # Authentication type is valid
1.20      harris41  417: 	    my $authformcurrent='';
1.26    ! matthew   418: 	    my $authform_other='';
1.20      harris41  419: 	    if ($currentauth=~/^krb4:/) {
                    420: 		$authformcurrent=$authformkrb;
1.26    ! matthew   421: 		$authform_other=$authformint.$authformfsys.$authformloc;
1.21      harris41  422: 		# embarrassing script hack here
                    423: 		$loginscript=~s/login\[3\]/login\[4\]/; # loc
                    424: 		$loginscript=~s/login\[2\]/login\[3\]/; # fsys
                    425: 		$loginscript=~s/login\[1\]/login\[2\]/; # int
                    426: 		$loginscript=~s/login\[0\]/login\[1\]/; # krb4
1.20      harris41  427: 	    }
                    428: 	    elsif ($currentauth=~/^internal:/) {
                    429: 		$authformcurrent=$authformint;
1.26    ! matthew   430: 		$authform_other=$authformkrb.$authformfsys.$authformloc;
1.21      harris41  431: 		# embarrassing script hack here
                    432: 		$loginscript=~s/login\[3\]/login\[4\]/; # loc
                    433: 		$loginscript=~s/login\[2\]/login\[3\]/; # fsys
                    434: 		$loginscript=~s/login\[1\]/login\[1\]/; # int
                    435: 		$loginscript=~s/login\[0\]/login\[2\]/; # krb4
1.20      harris41  436: 	    }
                    437: 	    elsif ($currentauth=~/^unix:/) {
                    438: 		$authformcurrent=$authformfsys;
1.26    ! matthew   439: 		$authform_other=$authformkrb.$authformint.$authformloc;
1.21      harris41  440: 		# embarrassing script hack here
                    441: 		$loginscript=~s/login\[3\]/login\[4\]/; # loc
                    442: 		$loginscript=~s/login\[1\]/login\[3\]/; # int
                    443: 		$loginscript=~s/login\[2\]/login\[1\]/; # fsys
                    444: 		$loginscript=~s/login\[0\]/login\[2\]/; # krb4
1.20      harris41  445: 	    }
                    446: 	    elsif ($currentauth=~/^localauth:/) {
                    447: 		$authformcurrent=$authformloc;
1.26    ! matthew   448: 		$authform_other=$authformkrb.$authformint.$authformfsys;
1.21      harris41  449: 		# embarrassing script hack here
                    450: 		$loginscript=~s/login\[3\]/login\[loc\]/; # loc
                    451: 		$loginscript=~s/login\[2\]/login\[4\]/; # fsys
                    452: 		$loginscript=~s/login\[1\]/login\[3\]/; # int
                    453: 		$loginscript=~s/login\[0\]/login\[2\]/; # krb4
                    454: 		$loginscript=~s/login\[loc\]/login\[1\]/; # loc
1.20      harris41  455: 	    }
1.26    ! matthew   456: 	    $authformcurrent=<<ENDCURRENTAUTH;
1.20      harris41  457: <table border='1'>
                    458: <tr>
                    459: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
                    460: <td><font color='#ff0000'>* * * WARNING * * *</font></td>
                    461: </tr>
                    462: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td>
                    463: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr>
                    464: </table>
1.26    ! matthew   465: ENDCURRENTAUTH
        !           466:             if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) {
        !           467: 		# Current user has login modification privileges
        !           468: 		$r->print(<<ENDOTHERAUTHS);
1.21      harris41  469: <hr />
                    470: $loginscript
1.20      harris41  471: <h3>Change Current Login Data</h3>
                    472: $generalrule
                    473: $authformnop
                    474: $authformcurrent
                    475: <h3>Enter New Login Data</h3>
1.26    ! matthew   476: $authform_other
        !           477: ENDOTHERAUTHS
        !           478:             }
        !           479:         }  ## End of "check for bad authentication type" logic
1.25      matthew   480:     } ## End of new user/old user logic
1.20      harris41  481:     $r->print('<hr /><h3>Add Roles</h3>');
1.17      www       482: #
                    483: # Co-Author
                    484: # 
                    485: 
                    486:     if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) {
                    487: 	my $cuname=$ENV{'user.name'};
                    488:         my $cudom=$ENV{'user.domain'};
                    489:        $r->print(<<ENDCOAUTH);
                    490: <h4>Construction Space</h4>
                    491: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
                    492: <th>Start</th><th>End</th></tr>
                    493: <tr>
                    494: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td>
                    495: <td>Co-Author</td>
                    496: <td>$cudom\_$cuname</td>
                    497: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''>
                    498: <a href=
                    499: "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>
                    500: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''>
                    501: <a href=
                    502: "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>
                    503: </tr>
                    504: </table>
                    505: ENDCOAUTH
                    506:     }
1.8       www       507: #
                    508: # Domain level
                    509: #
                    510:     $r->print('<h4>Domain Level</h4>'.
                    511:     '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'.
                    512:     '<th>Start</th><th>End</th></tr>');
1.24      matthew   513:     foreach ( sort( keys(%incdomains))) {
1.2       www       514: 	my $thisdomain=$_;
1.24      matthew   515:         foreach ('dc','li','dg','au') {
1.2       www       516:             if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) {
1.8       www       517:                my $plrole=&Apache::lonnet::plaintext($_);
                    518:                $r->print(<<ENDDROW);
                    519: <tr>
                    520: <td><input type=checkbox name="act_$thisdomain\_$_"></td>
                    521: <td>$plrole</td>
                    522: <td>$thisdomain</td>
                    523: <td><input type=hidden name="start_$thisdomain\_$_" value=''>
                    524: <a href=
                    525: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td>
                    526: <td><input type=hidden name="end_$thisdomain\_$_" value=''>
                    527: <a href=
                    528: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td>
                    529: </tr>
                    530: ENDDROW
1.2       www       531:             }
1.24      matthew   532:         } 
                    533:     }
1.8       www       534:     $r->print('</table>');
                    535: #
                    536: # Course level
                    537: #
1.26    ! matthew   538:     $r->print(&course_level_table(%inccourses));
        !           539:     $r->print("<hr /><input type=submit value=\"Modify User\">\n");
        !           540:     $r->print("</form></body></html>");
1.2       www       541: }
1.1       www       542: 
1.4       www       543: # ================================================================= Phase Three
                    544: sub phase_three {
                    545:     my $r=shift;
                    546:     $r->print(<<ENDTHREEHEAD);
                    547: <html>
                    548: <head>
                    549: <title>The LearningOnline Network with CAPA</title>
                    550: </head>
                    551: <body bgcolor="#FFFFFF">
                    552: <img align=right src=/adm/lonIcons/lonlogos.gif>
                    553: <h1>Create User, Change User Privileges</h1>
                    554: ENDTHREEHEAD
1.6       www       555:    $r->print('<h2>'.$ENV{'form.cuname'}.' at '.$ENV{'form.cdomain'}.'</h2>');
1.4       www       556:    if ($ENV{'form.makeuser'}) {
                    557:     $r->print('<h3>Creating User</h3>');
                    558:     if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&
                    559:         ($ENV{'form.cdomain'})&&($ENV{'form.cdomain'}!~/\W/)) {
                    560: 	my $amode='';
                    561:         my $genpwd='';
                    562:         if ($ENV{'form.login'} eq 'krb') {
                    563:            $amode='krb4';
                    564:            $genpwd=$ENV{'form.krbdom'};
                    565:         } elsif ($ENV{'form.login'} eq 'int') {
                    566:            $amode='internal';
                    567:            $genpwd=$ENV{'form.intpwd'};
1.20      harris41  568:         } elsif ($ENV{'form.login'} eq 'fsys') {
                    569:            $amode='unix';
                    570:            $genpwd=$ENV{'form.fsyspwd'};
1.18      albertel  571:         } elsif ($ENV{'form.login'} eq 'loc') {
                    572: 	    $amode='localauth';
                    573: 	    $genpwd=$ENV{'form.locarg'};
                    574: 	    if (!$genpwd) { $genpwd=" "; }
                    575: 	}
1.4       www       576:         if (($amode) && ($genpwd)) {
1.6       www       577:           $r->print('Generating user: '.&Apache::lonnet::modifyuser(
1.4       www       578:                       $ENV{'form.cdomain'},$ENV{'form.cuname'},
                    579:                       $ENV{'form.cstid'},$amode,$genpwd,
                    580:  	              $ENV{'form.cfirst'},$ENV{'form.cmiddle'},
1.6       www       581:                       $ENV{'form.clast'},$ENV{'form.cgen'}));
                    582:           $r->print('<br>Home server: '.&Apache::lonnet::homeserver
1.20      harris41  583:                       ($ENV{'form.cuname'},$ENV{'form.cdomain'}));
                    584: 
                    585: 	} else {
                    586:            $r->print('Invalid login mode or password');    
                    587:         }          
                    588:     } else {
                    589:         $r->print('Invalid username or domain');
                    590:     }
                    591:    }
                    592:    if (!$ENV{'form.makeuser'} and $ENV{'form.login'} ne 'nop') {
                    593:     $r->print('<h3>Changing User Login Data</h3>');
                    594:     if (($ENV{'form.cuname'})&&($ENV{'form.cuname'}!~/\W/)&&
                    595:         ($ENV{'form.cdomain'})&&($ENV{'form.cdomain'}!~/\W/)) {
                    596: 	my $amode='';
                    597:         my $genpwd='';
                    598:         if ($ENV{'form.login'} eq 'krb') {
                    599:            $amode='krb4';
                    600:            $genpwd=$ENV{'form.krbdom'};
                    601:         } elsif ($ENV{'form.login'} eq 'int') {
                    602:            $amode='internal';
                    603:            $genpwd=$ENV{'form.intpwd'};
                    604:         } elsif ($ENV{'form.login'} eq 'fsys') {
                    605:            $amode='unix';
                    606:            $genpwd=$ENV{'form.fsyspwd'};
                    607:         } elsif ($ENV{'form.login'} eq 'loc') {
                    608: 	    $amode='localauth';
                    609: 	    $genpwd=$ENV{'form.locarg'};
                    610: 	    if (!$genpwd) { $genpwd=" "; }
                    611: 	}
                    612:         if (($amode) && ($genpwd)) {
                    613: 	    $r->print('Modifying authentication: '.
                    614: 		 &Apache::lonnet::modifyuserauth(
                    615: 		       $ENV{'form.cdomain'},$ENV{'form.cuname'},
1.21      harris41  616:                        $amode,$genpwd));
1.20      harris41  617:             $r->print('<br>Home server: '.&Apache::lonnet::homeserver
1.6       www       618:                       ($ENV{'form.cuname'},$ENV{'form.cdomain'}));
                    619: 
1.4       www       620: 	} else {
                    621:            $r->print('Invalid login mode or password');    
                    622:         }          
                    623:     } else {
                    624:         $r->print('Invalid username or domain');
                    625:     }
                    626:    }
                    627:     my $now=time;
1.6       www       628:     $r->print('<h3>Modifying Roles</h3>');
1.24      matthew   629:     foreach (keys (%ENV)) {
1.4       www       630: 	if (($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
                    631:            $r->print('Revoking '.$2.' in '.$1.': '.
                    632:           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
                    633:                                       $1,$2,$now).'<br>');
1.11      www       634:            if ($2 eq 'st') {
                    635:                $1=~/^\/(\w+)\/(\w+)/;
                    636:                my $cid=$1.'_'.$2;
                    637: 	       $r->print('Drop from classlist: '.
                    638:           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                    639: 	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
                    640:                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.
                    641:                                               $ENV{'form.cdomain'}).'='.
                    642:                       &Apache::lonnet::escape($now.':'),
                    643: 	              $ENV{'course.'.$cid.'.home'}).'<br>');
                    644:            }
1.4       www       645: 	}
1.24      matthew   646:     } 
                    647:     foreach (keys(%ENV)) {
1.4       www       648: 	if (($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
1.5       www       649:             my $url='/'.$1.'/'.$2;
                    650:             if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) {
                    651: 		$url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3};
                    652:             }
                    653:             my $start=$now;
                    654:             if ($ENV{'form.start_'.$1.'_'.$2.'_'.$3}) {
                    655: 		$start=$ENV{'form.start_'.$1.'_'.$2.'_'.$3};
                    656:             }
                    657:             my $end=0;
                    658:             if ($ENV{'form.end_'.$1.'_'.$2.'_'.$3}) {
                    659: 		$end=$ENV{'form.end_'.$1.'_'.$2.'_'.$3};
                    660:             }
                    661:             $r->print('Assigning: '.$3.' in '.$url.': '.
                    662:           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
                    663:                                       $url,$3,$end,$start).'<br>');
1.10      www       664:             if ($3 eq 'st') {
1.11      www       665: 		$url=~/^\/(\w+)\/(\w+)/;
                    666:                 my $cid=$1.'_'.$2;
1.10      www       667:                $r->print('Add to classlist: '.
                    668:           &Apache::lonnet::critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
                    669: 	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
                    670:                       &Apache::lonnet::escape($ENV{'form.cuname'}.':'.
                    671:                                               $ENV{'form.cdomain'}).'='.
                    672:                       &Apache::lonnet::escape($end.':'.$start),
                    673: 	              $ENV{'course.'.$cid.'.home'}).'<br>');
                    674: 	    }
1.8       www       675: 	} elsif (($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) && ($ENV{$_})) {
                    676:             my $url='/'.$1.'/';
                    677:             my $start=$now;
                    678:             if ($ENV{'form.start_'.$1.'_'.$2}) {
                    679: 		$start=$ENV{'form.start_'.$1.'_'.$2};
                    680:             }
                    681:             my $end=0;
                    682:             if ($ENV{'form.end_'.$1.'_'.$2}) {
                    683: 		$end=$ENV{'form.end_'.$1.'_'.$2};
                    684:             }
                    685:             $r->print('Assigning: '.$2.' in '.$url.': '.
                    686:           &Apache::lonnet::assignrole($ENV{'form.cdomain'},$ENV{'form.cuname'},
                    687:                                       $url,$2,$end,$start).'<br>');
                    688:         }
1.24      matthew   689:     }
1.5       www       690:     $r->print('</body></html>');
1.4       www       691: }
                    692: 
1.2       www       693: # ================================================================ Main Handler
                    694: sub handler {
                    695:     my $r = shift;
                    696: 
                    697:     if ($r->header_only) {
                    698:        $r->content_type('text/html');
                    699:        $r->send_http_header;
                    700:        return OK;
                    701:     }
                    702: 
                    703:     if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) ||
                    704:         (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 
                    705:         (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 
                    706:         (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) ||
1.19      www       707:         (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) ||
1.2       www       708:         (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) {
                    709:        $r->content_type('text/html');
                    710:        $r->send_http_header;
                    711:        unless ($ENV{'form.phase'}) {
                    712: 	   &phase_one($r);
                    713:        }
                    714:        if ($ENV{'form.phase'} eq 'two') {
                    715:            &phase_two($r);
1.4       www       716:        } elsif ($ENV{'form.phase'} eq 'three') {
                    717:            &phase_three($r);
1.2       www       718:        }
1.1       www       719:    } else {
                    720:       $ENV{'user.error.msg'}=
1.9       albertel  721:         "/adm/createuser:mau:0:0:Cannot modify user data";
1.1       www       722:       return HTTP_NOT_ACCEPTABLE; 
                    723:    }
                    724:    return OK;
                    725: } 
1.26    ! matthew   726: 
        !           727: 
        !           728: sub course_level_table {
        !           729:     my %inccourses = @_;
        !           730:     my $table = '';
        !           731:     foreach (sort( keys(%inccourses))) {
        !           732: 	my $thiscourse=$_;
        !           733: 	my $protectedcourse=$_;
        !           734: 	$thiscourse=~s:_:/:g;
        !           735: 	my %coursedata=&Apache::lonnet::coursedescription($thiscourse);
        !           736: 	my $area=$coursedata{'description'};
        !           737: 	my $bgcol=$thiscourse;
        !           738: 	$bgcol=~s/[^8-9b-e]//g;
        !           739: 	$bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6);
        !           740: 	foreach  ('st','ta','ep','ad','in','cc') {
        !           741: 	    if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) {
        !           742: 		my $plrole=&Apache::lonnet::plaintext($_);
        !           743: 		$table .= <<ENDEXTENT;
        !           744: <tr bgcolor="#$bgcol">
        !           745: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td>
        !           746: <td>$plrole</td>
        !           747: <td>$area</td>
        !           748: ENDEXTENT
        !           749: 	        if ($_ ne 'cc') {
        !           750: 		    $table .= <<ENDSECTION;
        !           751: <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td>
        !           752: ENDSECTION
        !           753:                 } else { 
        !           754: 		    $table .= <<ENDSECTION;
        !           755: <td>&nbsp</td> 
        !           756: ENDSECTION
        !           757:                 }
        !           758: 		$table .= <<ENDTIMEENTRY;
        !           759: <td><input type=hidden name="start_$protectedcourse\_$_" value=''>
        !           760: <a href=
        !           761: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td>
        !           762: <td><input type=hidden name="end_$protectedcourse\_$_" value=''>
        !           763: <a href=
        !           764: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td>
        !           765: ENDTIMEENTRY
        !           766:                 $table.= "</tr>\n";
        !           767:             }
        !           768:         }
        !           769:     }
        !           770:     return '' if ($table eq ''); # return nothing if there is nothing 
        !           771:                                  # in the table
        !           772:     my $result = <<ENDTABLE;
        !           773: <h4>Course Level</h4>
        !           774: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>
        !           775: <th>Group/Section</th><th>Start</th><th>End</th></tr>
        !           776: $table
        !           777: </table>
        !           778: ENDTABLE
        !           779:     return $result;
        !           780: }
1.1       www       781: 
                    782: 1;
                    783: __END__
1.2       www       784: 
                    785: 

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