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

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

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