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

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

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