loncom/interface/loncreateuser.pm - view

File: [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.29: download - view: text, annotated - select for diffs
Thu Apr 4 21:46:44 2002 UTC (22 years, 1 month ago) by matthew
Branches: MAIN
CVS tags: HEAD

Allow specification of server for new users.  This is somewhat experimental
and has not been fully tested.  Checks are not in place to disallow creation
of new users by existing users who should not be able to.

# The LearningOnline Network with CAPA # Create a user # # $Id: loncreateuser.pm,v 1.29 2002/04/04 21:46:44 matthew Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # (Create a course # (My Desk # # (Internal Server Error Handler # # (Login Screen # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14, # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer) # # YEAR=2001 # 3/1/1 Gerd Kortemeyer) # # 3/1 Gerd Kortemeyer) # # 2/14 Gerd Kortemeyer) # # 2/14,2/17,2/19,2/20,2/21,2/22,2/23,3/2,3/17,3/24,04/12 Gerd Kortemeyer # April Guy Albertelli # 05/10,10/16 Gerd Kortemeyer # 11/12,11/13,11/15 Scott Harrison # 02/11/02 Matthew Hall # # $Id: loncreateuser.pm,v 1.29 2002/04/04 21:46:44 matthew Exp $ ### package Apache::loncreateuser; use strict; use Apache::Constants qw(:common :http); use Apache::lonnet; my $loginscript; # piece of javascript used in two separate instances my $generalrule; my $authformnop; my $authformkrb; my $authformint; my $authformfsys; my $authformloc; BEGIN { $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; my $krbdefdom=$1; $krbdefdom=~tr/a-z/A-Z/; $authformnop=(<<END); <p> <input type="radio" name="login" value="" checked="checked" onClick="clicknop(this.form);"> Do not change login data </p> END $authformkrb=(<<END); <p> <input type=radio name=login value=krb onClick="clickkrb(this.form);"> Kerberos authenticated with domain <input type=text size=10 name=krbdom onChange="setkrb(this.form);"> </p> END $authformint=(<<END); <p> <input type=radio name=login value=int onClick="clickint(this.form);"> Internally authenticated (with initial password <input type=text size=10 name=intpwd onChange="setint(this.form);">) </p> END $authformfsys=(<<END); <p> <input type=radio name=login value=fsys onClick="clickfsys(this.form);"> Filesystem authenticated (with initial password <input type=text size=10 name=fsyspwd onChange="setfsys(this.form);">) </p> END $authformloc=(<<END); <p> <input type=radio name=login value=loc onClick="clickloc(this.form);" /> Local Authentication with argument <input type=text size=10 name=locarg onChange="setloc(this.form);" /> </p> END $loginscript=(<<ENDLOGINSCRIPT); <script> function setkrb(vf) { if (vf.krbdom.value!='') { vf.login[0].checked=true; vf.krbdom.value=vf.krbdom.value.toUpperCase(); vf.intpwd.value=''; vf.fsyspwd.value=''; vf.locarg.value=''; } } function setint(vf) { if (vf.intpwd.value!='') { vf.login[1].checked=true; vf.krbdom.value=''; vf.fsyspwd.value=''; vf.locarg.value=''; } } function setfsys(vf) { if (vf.fsyspwd.value!='') { vf.login[2].checked=true; vf.krbdom.value=''; vf.intpwd.value=''; vf.locarg.value=''; } } function setloc(vf) { if (vf.locarg.value!='') { vf.login[3].checked=true; vf.krbdom.value=''; vf.intpwd.value=''; vf.fsyspwd.value=''; } } function clicknop(vf) { vf.krbdom.value=''; vf.intpwd.value=''; vf.fsyspwd.value=''; vf.locarg.value=''; } function clickkrb(vf) { vf.krbdom.value='$krbdefdom'; vf.intpwd.value=''; vf.fsyspwd.value=''; vf.locarg.value=''; } function clickint(vf) { vf.krbdom.value=''; vf.fsyspwd.value=''; vf.locarg.value=''; } function clickfsys(vf) { vf.krbdom.value=''; vf.intpwd.value=''; vf.locarg.value=''; } function clickloc(vf) { vf.krbdom.value=''; vf.intpwd.value=''; vf.fsyspwd.value=''; } </script> ENDLOGINSCRIPT $generalrule=<<END; <p> <i>As a general rule, only authors or co-authors should be filesystem authenticated (which allows access to the server filesystem).</i> </p> END } # =================================================================== Phase one sub phase_one { my $r=shift; my $defdom=$ENV{'user.domain'}; $r->print(<<ENDDOCUMENT); <html> <head> <title>The LearningOnline Network with CAPA</title> </head> <body bgcolor="#FFFFFF"> <h1>Create User, Change User Privileges</h1> <form action=/adm/createuser method=post> <input type=hidden name=phase value=two> Username: <input type=text size=15 name=ccuname><br> Domain: <input type=text size=15 name=ccdomain value=$defdom><p> <input type=submit value="Continue"> </form> </body> </html> ENDDOCUMENT } # =================================================================== Phase two sub phase_two { my $r=shift; my $ccuname=$ENV{'form.ccuname'}; my $ccdomain=$ENV{'form.ccdomain'}; $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; my $krbdefdom=$1; $krbdefdom=~tr/a-z/A-Z/; my $defdom=$ENV{'user.domain'}; $ccuname=~s/\W//g; $ccdomain=~s/\W//g; my $dochead =<<"ENDDOCHEAD"; <html> <head> <title>The LearningOnline Network with CAPA</title> <script> function pclose() { parmwin=window.open("/adm/rat/empty.html","LONCAPAparms", "height=350,width=350,scrollbars=no,menubar=no"); parmwin.close(); } function pjump(type,dis,value,marker,ret,call) { parmwin=window.open("/adm/rat/parameter.html?type="+escape(type) +"&value="+escape(value)+"&marker="+escape(marker) +"&return="+escape(ret) +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms", "height=350,width=350,scrollbars=no,menubar=no"); } function dateset() { eval("document.cu."+document.cu.pres_marker.value+ ".value=document.cu.pres_value.value"); pclose(); } </script> </head> <body bgcolor="#FFFFFF"> <img align="right" src="/adm/lonIcons/lonlogos.gif"> ENDDOCHEAD my $forminfo =<<"ENDFORMINFO"; <form action="/adm/createuser" method="post" name="cu"> <input type="hidden" name="phase" value="three"> <input type="hidden" name="ccuname" value="$ccuname"> <input type="hidden" name="ccdomain" value="$ccdomain"> <input type="hidden" name="pres_value" value="" > <input type="hidden" name="pres_type" value="" > <input type="hidden" name="pres_marker" value="" > ENDFORMINFO my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain); my %incdomains; my %inccourses; my %home_servers = &get_home_servers($ccdomain); foreach (%Apache::lonnet::hostdom) { $incdomains{$_}=1; } foreach (keys(%ENV)) { if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) { $inccourses{$1.'_'.$2}=1; } } if ($uhome eq 'no_host') { my $home_server_list= '<option value="default" selected>default</option>'."\n"; foreach (sort keys(%home_servers)) { $home_server_list.= '<option value="'.$_.'">'.$_.' '. $home_servers{$_}."</option>\n"; } $r->print(<<ENDNEWUSER); $dochead <h1>Create New User</h1> $forminfo <h2>New user "$ccuname" in domain $ccdomain</h2> $loginscript <input type='hidden' name='makeuser' value='1' /> <h3>Personal Data</h3> <p> <table> <tr><td>First Name </td> <td><input type='text' name='cfirst' size='15' /></td></tr> <tr><td>Middle Name </td> <td><input type='text' name='cmiddle' size='15' /></td></tr> <tr><td>Last Name </td> <td><input type='text' name='clast' size='15' /></td></tr> <tr><td>Generation </td> <td><input type='text' name='cgen' size='5' /></td></tr> </table> ID/Student Number <input type='text' name='cstid' size='15' /></p> Home Server: <select name="hserver" size="1"> $home_server_list </select> <hr /> <h3>Login Data</h3> $generalrule $authformkrb $authformint $authformfsys $authformloc ENDNEWUSER } else { # user already exists $r->print(<<ENDCHANGEUSER); $dochead <h1>Change User Privileges</h1> $forminfo <h2>User "$ccuname" in domain $ccdomain </h2> ENDCHANGEUSER # Get the users information my %userenv = &Apache::lonnet::get('environment', ['firstname','middlename','lastname','generation'], $ccdomain,$ccuname); my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname); $r->print(<<END); <hr /> <table border="2"> <tr> <th>first name</th><th>middle name</th><th>last name</th><th>generation</th> </tr> <tr> END foreach ('firstname','middlename','lastname','generation') { if (&Apache::lonnet::allowed('mau',$ccdomain)) { $r->print(<<"END"); <td><input type="text" name="c$_" value="$userenv{$_}" size="15"/></td> END } else { $r->print('<td>'.$userenv{$_}.'</td>'); } } $r->print(<<END); </tr> </table> END # Build up table of user roles to allow revocation of a role. my ($tmp) = keys(%rolesdump); unless ($tmp =~ /^(con_lost|error)/i) { my $now=time; $r->print('<hr /><h3>Revoke Existing Roles</h3>'. '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'. '<th>Start</th><th>End</th>'); foreach my $area (keys(%rolesdump)) { if ($area!~/^rolesdef/) { my $role = $rolesdump{$area}; my $thisrole=$area; $area=~s/\_\w\w$//; my ($role_code,$role_end_time,$role_start_time) = split(/_/,$role); my $bgcol='ffffff'; my $allows=0; if ($area=~/^\/(\w+)\/(\d\w+)/) { my %coursedata= &Apache::lonnet::coursedescription($1.'_'.$2); my $carea='Course: '.$coursedata{'description'}; $inccourses{$1.'_'.$2}=1; if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) { $allows=1; } # Compute the background color based on $area $bgcol=$1.'_'.$2; $bgcol=~s/[^8-9b-e]//g; $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6); if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) { $carea.='<br>Section/Group: '.$3; } $area=$carea; } else { # Determine if current user is able to revoke privileges if ($area=~/^\/(\w+)\//) { if (&Apache::lonnet::allowed('c'.$role_code,$1)) { $allows=1; } } else { if (&Apache::lonnet::allowed('c'.$role_code,'/')) { $allows=1; } } } $r->print('<tr bgcolor=#"'.$bgcol.'"><td>'); my $active=1; $active=0 if (($role_end_time) && ($now>$role_end_time)); if (($active) && ($allows)) { $r->print('<input type="checkbox" name="rev:' .$thisrole.'">'); } else { $r->print(' '); } $r->print('</td><td>'. &Apache::lonnet::plaintext($role_code). '</td><td>'.$area.'</td><td>'. ($role_start_time ? localtime($role_start_time) : ' ' ) .'</td><td>'. ($role_end_time ? localtime($role_end_time) : ' ' ) ."</td></tr>\n"); } } # end of foreach (table building loop) $r->print('</table>'); } # End of unless my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain); if ($currentauth=~/^krb4:/) { $currentauth=~/^krb4:(.*)/; my $krbdefdom2=$1; $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/; } # Check for a bad authentication type unless ($currentauth=~/^krb4:/ or $currentauth=~/^unix:/ or $currentauth=~/^internal:/ or $currentauth=~/^localauth:/ ) { # bad authentication scheme if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { $r->print(<<ENDBADAUTH); <hr /> $loginscript <font color='#ff0000'>ERROR:</font> This user has an unrecognized authentication scheme ($currentauth). Please specify login data below. <h3>Login Data</h3> $generalrule $authformkrb $authformint $authformfsys $authformloc ENDBADAUTH } else { # This user is not allowed to modify the users # authentication scheme, so just notify them of the problem $r->print(<<ENDBADAUTH); <hr /> $loginscript <font color="#ff0000"> ERROR: </font> This user has an unrecognized authentication scheme ($currentauth). Please alert a domain coordinator of this situation. <hr /> ENDBADAUTH } } else { # Authentication type is valid my $authformcurrent=''; my $authform_other=''; if ($currentauth=~/^krb4:/) { $authformcurrent=$authformkrb; $authform_other=$authformint.$authformfsys.$authformloc; # embarrassing script hack here $loginscript=~s/login\[3\]/login\[4\]/; # loc $loginscript=~s/login\[2\]/login\[3\]/; # fsys $loginscript=~s/login\[1\]/login\[2\]/; # int $loginscript=~s/login\[0\]/login\[1\]/; # krb4 } elsif ($currentauth=~/^internal:/) { $authformcurrent=$authformint; $authform_other=$authformkrb.$authformfsys.$authformloc; # embarrassing script hack here $loginscript=~s/login\[3\]/login\[4\]/; # loc $loginscript=~s/login\[2\]/login\[3\]/; # fsys $loginscript=~s/login\[1\]/login\[1\]/; # int $loginscript=~s/login\[0\]/login\[2\]/; # krb4 } elsif ($currentauth=~/^unix:/) { $authformcurrent=$authformfsys; $authform_other=$authformkrb.$authformint.$authformloc; # embarrassing script hack here $loginscript=~s/login\[3\]/login\[4\]/; # loc $loginscript=~s/login\[1\]/login\[3\]/; # int $loginscript=~s/login\[2\]/login\[1\]/; # fsys $loginscript=~s/login\[0\]/login\[2\]/; # krb4 } elsif ($currentauth=~/^localauth:/) { $authformcurrent=$authformloc; $authform_other=$authformkrb.$authformint.$authformfsys; # embarrassing script hack here $loginscript=~s/login\[3\]/login\[loc\]/; # loc $loginscript=~s/login\[2\]/login\[4\]/; # fsys $loginscript=~s/login\[1\]/login\[3\]/; # int $loginscript=~s/login\[0\]/login\[2\]/; # krb4 $loginscript=~s/login\[loc\]/login\[1\]/; # loc } $authformcurrent=<<ENDCURRENTAUTH; <table border='1'> <tr> <td><font color='#ff0000'>* * * WARNING * * *</font></td> <td><font color='#ff0000'>* * * WARNING * * *</font></td> </tr> <tr><td bgcolor='#cbbcbb'>$authformcurrent</td> <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr> </table> ENDCURRENTAUTH if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { # Current user has login modification privileges $r->print(<<ENDOTHERAUTHS); <hr /> $loginscript <h3>Change Current Login Data</h3> $generalrule $authformnop $authformcurrent <h3>Enter New Login Data</h3> $authform_other ENDOTHERAUTHS } } ## End of "check for bad authentication type" logic } ## End of new user/old user logic $r->print('<hr /><h3>Add Roles</h3>'); # # Co-Author # if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) { my $cuname=$ENV{'user.name'}; my $cudom=$ENV{'user.domain'}; $r->print(<<ENDCOAUTH); <h4>Construction Space</h4> <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th> <th>Start</th><th>End</th></tr> <tr> <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td> <td>Co-Author</td> <td>$cudom\_$cuname</td> <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''> <a href= "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> <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''> <a href= "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> </tr> </table> ENDCOAUTH } # # Domain level # $r->print('<h4>Domain Level</h4>'. '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'. '<th>Start</th><th>End</th></tr>'); foreach ( sort( keys(%incdomains))) { my $thisdomain=$_; foreach ('dc','li','dg','au') { if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) { my $plrole=&Apache::lonnet::plaintext($_); $r->print(<<ENDDROW); <tr> <td><input type=checkbox name="act_$thisdomain\_$_"></td> <td>$plrole</td> <td>$thisdomain</td> <td><input type=hidden name="start_$thisdomain\_$_" value=''> <a href= "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td> <td><input type=hidden name="end_$thisdomain\_$_" value=''> <a href= "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td> </tr> ENDDROW } } } $r->print('</table>'); # # Course level # $r->print(&course_level_table(%inccourses)); $r->print("<hr /><input type=submit value=\"Modify User\">\n"); $r->print("</form></body></html>"); } # ================================================================= Phase Three sub phase_three { my $r=shift; my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'}, $ENV{'form.ccdomain'}); # Error messages my $error = '<font color="#ff0000">Error:</font>'; my $end = '</body></html>'; # Print header $r->print(<<ENDTHREEHEAD); <html> <head> <title>The LearningOnline Network with CAPA</title> </head> <body bgcolor="#FFFFFF"> <img align="right" src="/adm/lonIcons/lonlogos.gif"> ENDTHREEHEAD # Check Inputs if (! $ENV{'form.ccuname'} ) { $r->print($error.'No login name specified.'.$end); return; } if ( $ENV{'form.ccuname'} =~/\W/) { $r->print($error.'Invalid login name. '. 'Only letters, numbers, and underscores are valid.'. $end); return; } if (! $ENV{'form.ccdomain'} ) { $r->print($error.'No domain specified.'.$end); return; } if ( $ENV{'form.ccdomain'} =~/\W/) { $r->print($error.'Invalid domain name. '. 'Only letters, numbers, and underscores are valid.'. $end); return; } if (! exists($ENV{'form.makeuser'})) { # Modifying an existing user, so check the validity of the name if ($uhome eq 'no_host') { $r->print($error.'Unable to determine home server for '. $ENV{'form.ccuname'}.' in domain '. $ENV{'form.ccdomain'}.'.'); return; } } # Determine authentication method and password for the user being modified my $amode=''; my $genpwd=''; if ($ENV{'form.login'} eq 'krb') { $amode='krb4'; $genpwd=$ENV{'form.krbdom'}; } elsif ($ENV{'form.login'} eq 'int') { $amode='internal'; $genpwd=$ENV{'form.intpwd'}; } elsif ($ENV{'form.login'} eq 'fsys') { $amode='unix'; $genpwd=$ENV{'form.fsyspwd'}; } elsif ($ENV{'form.login'} eq 'loc') { $amode='localauth'; $genpwd=$ENV{'form.locarg'}; $genpwd=" " if (!$genpwd); } if ($ENV{'form.makeuser'}) { # Create a new user $r->print(<<ENDNEWUSERHEAD); <h1>Create User</h1> <h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2> ENDNEWUSERHEAD # Check for the authentication mode and password if (! $amode || ! $genpwd) { $r->print($error.'Invalid login mode or password'.$end); return; } # Determine desired host my $desiredhost = $ENV{'form.hserver'}; if (lc($desiredhost) eq 'default') { $desiredhost = undef; } else { my %home_servers = &get_home_servers($ENV{'form.ccdomain'}); if (! exists($home_servers{$desiredhost})) { $r->print($error.'Invalid home server specified'); return; } } # Call modifyuser my $result = &Apache::lonnet::modifyuser ($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'}, $amode,$genpwd,$ENV{'form.cfirst'}, $ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'}, undef,$desiredhost ); $r->print('Generating user: '.$result); my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'}, $ENV{'form.ccdomain'}); $r->print('<br>Home server: '.$home.' '. $Apache::lonnet::libserv{$home}); } elsif ($ENV{'form.login'} ne '') { # Modify user privileges $r->print(<<ENDMODIFYUSERHEAD); <h1>Change User Privileges</h1> <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2> ENDMODIFYUSERHEAD if (! $amode || ! $genpwd) { $r->print($error.'Invalid login mode or password'.$end); return; } # Only allow authentification modification if the person has authority if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { $r->print('Modifying authentication: '. &Apache::lonnet::modifyuserauth( $ENV{'form.ccdomain'},$ENV{'form.ccuname'}, $amode,$genpwd)); $r->print('<br>Home server: '.&Apache::lonnet::homeserver ($ENV{'form.ccuname'},$ENV{'form.ccdomain'})); } else { # Okay, this is a non-fatal error. $r->print($error.'You do not have the authority to modify '. 'this users authentification information.'); } } ## if (! $ENV{'form.makeuser'} ) { # Check for need to change my %userenv = &Apache::lonnet::get ('environment',['firstname','middlename','lastname','generation'], $ENV{'form.ccdomain'},$ENV{'form.ccuname'}); my ($tmp) = keys(%userenv); if ($tmp =~ /^(con_lost|error)/i) { %userenv = (); } # Check to see if we need to change user information foreach ('firstname','middlename','lastname','generation') { # Strip leading and trailing whitespace $ENV{'form.c'.$_} =~ s/(\s+$|^\s+)//g; } if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'}) && ($ENV{'form.cfirstname'} ne $userenv{'firstname'} || $ENV{'form.cmiddlename'} ne $userenv{'middlename'} || $ENV{'form.clastname'} ne $userenv{'lastname'} || $ENV{'form.cgeneration'} ne $userenv{'generation'} )) { # Make the change my %changeHash; $changeHash{'firstname'} = $ENV{'form.cfirstname'}; $changeHash{'middlename'} = $ENV{'form.cmiddlename'}; $changeHash{'lastname'} = $ENV{'form.clastname'}; $changeHash{'generation'} = $ENV{'form.cgeneration'}; my $putresult = &Apache::lonnet::put ('environment',\%changeHash, $ENV{'form.ccdomain'},$ENV{'form.ccuname'}); if ($putresult eq 'ok') { # Tell the user we changed the name $r->print(<<"END"); <table border="2"> <caption>User Information Changed</caption> <tr><th> </th> <th>first</th> <th>middle</th> <th>last</th> <th>generation</th></tr> <tr><td>Previous</td> <td>$userenv{'firstname'} </td> <td>$userenv{'middlename'} </td> <td>$userenv{'lastname'} </td> <td>$userenv{'generation'} </td></tr> <tr><td>Changed To</td> <td>$ENV{'form.cfirstname'} </td> <td>$ENV{'form.cmiddlename'} </td> <td>$ENV{'form.clastname'} </td> <td>$ENV{'form.cgeneration'} </td></tr> </table> END } else { # error occurred $r->print("<h2>Unable to successfully change environment for ". $ENV{'form.ccuname'}." in domain ". $ENV{'form.ccdomain'}."</h2>"); } } else { # End of if ($ENV ... ) logic # They did not want to change the users name but we can # still tell them what the name is $r->print(<<"END"); <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2> <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4> <h4>Generation: $userenv{'generation'}</h4> END } } ## my $now=time; $r->print('<h3>Modifying Roles</h3>'); foreach (keys (%ENV)) { next if (! $ENV{$_}); # Revoke roles if ($_=~/^form\.rev/) { if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) { $r->print('Revoking '.$2.' in '.$1.': '. &Apache::lonnet::assignrole($ENV{'form.ccdomain'}, $ENV{'form.ccuname'},$1,$2,$now).'<br>'); if ($2 eq 'st') { $1=~/^\/(\w+)\/(\w+)/; my $cid=$1.'_'.$2; $r->print('Drop from classlist: '. &Apache::lonnet::critical('put:'. $ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}.':classlist:'. &Apache::lonnet::escape($ENV{'form.ccuname'}.':'. $ENV{'form.ccdomain'}).'='. &Apache::lonnet::escape($now.':'), $ENV{'course.'.$cid.'.home'}).'<br>'); } } } elsif ($_=~/^form\.act/) { if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) { # Activate roles for sections with 3 id numbers # set start, end times, and the url for the class my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? $ENV{'form.start_'.$1.'_'.$2} : $now ); my $end = ( $ENV{'form.end_'.$1.'_'.$2} ? $ENV{'form.end_'.$1.'_'.$2} : 0 ); my $url='/'.$1.'/'.$2; if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) { $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3}; } # Assign the role and report it $r->print('Assigning: '.$3.' in '.$url.': '. &Apache::lonnet::assignrole( $ENV{'form.ccdomain'},$ENV{'form.ccuname'}, $url,$3,$end,$start). '<br>'); # Handle students differently if ($3 eq 'st') { $url=~/^\/(\w+)\/(\w+)/; my $cid=$1.'_'.$2; $r->print('Add to classlist: '. &Apache::lonnet::critical( 'put:'.$ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}.':classlist:'. &Apache::lonnet::escape( $ENV{'form.ccuname'}.':'. $ENV{'form.ccdomain'} ).'='. &Apache::lonnet::escape($end.':'.$start), $ENV{'course.'.$cid.'.home'}) .'<br>'); } } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) { # Activate roles for sections with two id numbers # set start, end times, and the url for the class my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? $ENV{'form.start_'.$1.'_'.$2} : $now ); my $end = ( $ENV{'form.end_'.$1.'_'.$2} ? $ENV{'form.end_'.$1.'_'.$2} : 0 ); my $url='/'.$1.'/'; # Assign the role and report it. $r->print('Assigning: '.$2.' in '.$url.': '. &Apache::lonnet::assignrole( $ENV{'form.ccdomain'},$ENV{'form.ccuname'}, $url,$2,$end,$start) .'<br>'); } } } # End of foreach (keys(%ENV)) $r->print('</body></html>'); } # ================================================================ Main Handler sub handler { my $r = shift; if ($r->header_only) { $r->content_type('text/html'); $r->send_http_header; return OK; } if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) || (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) || (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) || (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) { $r->content_type('text/html'); $r->send_http_header; unless ($ENV{'form.phase'}) { &phase_one($r); } if ($ENV{'form.phase'} eq 'two') { &phase_two($r); } elsif ($ENV{'form.phase'} eq 'three') { &phase_three($r); } } else { $ENV{'user.error.msg'}= "/adm/createuser:mau:0:0:Cannot modify user data"; return HTTP_NOT_ACCEPTABLE; } return OK; } #-------------------------------------------------- functions for &phase_two sub course_level_table { my %inccourses = @_; my $table = ''; foreach (sort( keys(%inccourses))) { my $thiscourse=$_; my $protectedcourse=$_; $thiscourse=~s:_:/:g; my %coursedata=&Apache::lonnet::coursedescription($thiscourse); my $area=$coursedata{'description'}; my $bgcol=$thiscourse; $bgcol=~s/[^8-9b-e]//g; $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6); foreach ('st','ta','ep','ad','in','cc') { if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) { my $plrole=&Apache::lonnet::plaintext($_); $table .= <<ENDEXTENT; <tr bgcolor="#$bgcol"> <td><input type="checkbox" name="act_$protectedcourse\_$_"></td> <td>$plrole</td> <td>$area</td> ENDEXTENT if ($_ ne 'cc') { $table .= <<ENDSECTION; <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td> ENDSECTION } else { $table .= <<ENDSECTION; <td>&nbsp</td> ENDSECTION } $table .= <<ENDTIMEENTRY; <td><input type=hidden name="start_$protectedcourse\_$_" value=''> <a href= "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td> <td><input type=hidden name="end_$protectedcourse\_$_" value=''> <a href= "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td> ENDTIMEENTRY $table.= "</tr>\n"; } } } return '' if ($table eq ''); # return nothing if there is nothing # in the table my $result = <<ENDTABLE; <h4>Course Level</h4> <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th> <th>Group/Section</th><th>Start</th><th>End</th></tr> $table </table> ENDTABLE return $result; } #---------------------------------------------- end functions for &phase_two #--------------------------------- functions for &phase_two and &phase_three sub get_home_servers { my $domain = shift; my %home_servers; foreach (keys(%Apache::lonnet::libserv)) { if ($Apache::lonnet::hostdom{$_} eq $domain) { $home_servers{$_} = $Apache::lonnet::hostname{$_}; } } return %home_servers; } #--------------------------end of functions for &phase_two and &phase_three 1; __END__