loncom/interface/loncreateuser.pm - view

File: [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.28: download - view: text, annotated - select for diffs
Fri Mar 22 22:23:23 2002 UTC (22 years, 2 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Changed a lonnet::reply to lonnet::dump, added ability to change user
name and display of name if the current user does not have MAU authorization.

1: # The LearningOnline Network with CAPA 2: # Create a user 3: # 4: # $Id: loncreateuser.pm,v 1.28 2002/03/22 22:23:23 matthew Exp $ 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: # 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: # 37: # YEAR=2001 38: # 3/1/1 Gerd Kortemeyer) 39: # 40: # 3/1 Gerd Kortemeyer) 41: # 42: # 2/14 Gerd Kortemeyer) 43: # 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 45: # April Guy Albertelli 46: # 05/10,10/16 Gerd Kortemeyer 47: # 11/12,11/13,11/15 Scott Harrison 48: # 02/11/02 Matthew Hall 49: # 50: # $Id: loncreateuser.pm,v 1.28 2002/03/22 22:23:23 matthew Exp $ 51: ### 52: 53: package Apache::loncreateuser; 54: 55: use strict; 56: use Apache::Constants qw(:common :http); 57: use Apache::lonnet; 58: 59: my $loginscript; # piece of javascript used in two separate instances 60: my $generalrule; 61: my $authformnop; 62: my $authformkrb; 63: my $authformint; 64: my $authformfsys; 65: my $authformloc; 66: 67: BEGIN { 68: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; 69: my $krbdefdom=$1; 70: $krbdefdom=~tr/a-z/A-Z/; 71: $authformnop=(<<END); 72: <p> 73: <input type="radio" name="login" value="" checked="checked" 74: onClick="clicknop(this.form);"> 75: Do not change login data 76: </p> 77: END 78: $authformkrb=(<<END); 79: <p> 80: <input type=radio name=login value=krb onClick="clickkrb(this.form);"> 81: Kerberos authenticated with domain 82: <input type=text size=10 name=krbdom onChange="setkrb(this.form);"> 83: </p> 84: END 85: $authformint=(<<END); 86: <p> 87: <input type=radio name=login value=int onClick="clickint(this.form);"> 88: Internally authenticated (with initial password 89: <input type=text size=10 name=intpwd onChange="setint(this.form);">) 90: </p> 91: END 92: $authformfsys=(<<END); 93: <p> 94: <input type=radio name=login value=fsys onClick="clickfsys(this.form);"> 95: Filesystem authenticated (with initial password 96: <input type=text size=10 name=fsyspwd onChange="setfsys(this.form);">) 97: </p> 98: END 99: $authformloc=(<<END); 100: <p> 101: <input type=radio name=login value=loc onClick="clickloc(this.form);" /> 102: Local Authentication with argument 103: <input type=text size=10 name=locarg onChange="setloc(this.form);" /> 104: </p> 105: END 106: $loginscript=(<<ENDLOGINSCRIPT); 107: <script> 108: function setkrb(vf) { 109: if (vf.krbdom.value!='') { 110: vf.login[0].checked=true; 111: vf.krbdom.value=vf.krbdom.value.toUpperCase(); 112: vf.intpwd.value=''; 113: vf.fsyspwd.value=''; 114: vf.locarg.value=''; 115: } 116: } 117: 118: function setint(vf) { 119: if (vf.intpwd.value!='') { 120: vf.login[1].checked=true; 121: vf.krbdom.value=''; 122: vf.fsyspwd.value=''; 123: vf.locarg.value=''; 124: } 125: } 126: 127: function setfsys(vf) { 128: if (vf.fsyspwd.value!='') { 129: vf.login[2].checked=true; 130: vf.krbdom.value=''; 131: vf.intpwd.value=''; 132: vf.locarg.value=''; 133: } 134: } 135: 136: function setloc(vf) { 137: if (vf.locarg.value!='') { 138: vf.login[3].checked=true; 139: vf.krbdom.value=''; 140: vf.intpwd.value=''; 141: vf.fsyspwd.value=''; 142: } 143: } 144: 145: function clicknop(vf) { 146: vf.krbdom.value=''; 147: vf.intpwd.value=''; 148: vf.fsyspwd.value=''; 149: vf.locarg.value=''; 150: } 151: 152: function clickkrb(vf) { 153: vf.krbdom.value='$krbdefdom'; 154: vf.intpwd.value=''; 155: vf.fsyspwd.value=''; 156: vf.locarg.value=''; 157: } 158: 159: function clickint(vf) { 160: vf.krbdom.value=''; 161: vf.fsyspwd.value=''; 162: vf.locarg.value=''; 163: } 164: 165: function clickfsys(vf) { 166: vf.krbdom.value=''; 167: vf.intpwd.value=''; 168: vf.locarg.value=''; 169: } 170: 171: function clickloc(vf) { 172: vf.krbdom.value=''; 173: vf.intpwd.value=''; 174: vf.fsyspwd.value=''; 175: } 176: </script> 177: ENDLOGINSCRIPT 178: $generalrule=<<END; 179: <p> 180: <i>As a general rule, only authors or co-authors should be filesystem 181: authenticated (which allows access to the server filesystem).</i> 182: </p> 183: END 184: } 185: 186: # =================================================================== Phase one 187: 188: sub phase_one { 189: my $r=shift; 190: my $defdom=$ENV{'user.domain'}; 191: $r->print(<<ENDDOCUMENT); 192: <html> 193: <head> 194: <title>The LearningOnline Network with CAPA</title> 195: </head> 196: <body bgcolor="#FFFFFF"> 197: <h1>Create User, Change User Privileges</h1> 198: <form action=/adm/createuser method=post> 199: <input type=hidden name=phase value=two> 200: Username: <input type=text size=15 name=ccuname><br> 201: Domain: <input type=text size=15 name=ccdomain value=$defdom><p> 202: <input type=submit value="Continue"> 203: </form> 204: </body> 205: </html> 206: ENDDOCUMENT 207: } 208: 209: # =================================================================== Phase two 210: sub phase_two { 211: my $r=shift; 212: my $ccuname=$ENV{'form.ccuname'}; 213: my $ccdomain=$ENV{'form.ccdomain'}; 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: 221: $ccuname=~s/\W//g; 222: $ccdomain=~s/\W//g; 223: my $dochead =<<"ENDDOCHEAD"; 224: <html> 225: <head> 226: <title>The LearningOnline Network with CAPA</title> 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> 251: </head> 252: <body bgcolor="#FFFFFF"> 253: <img align="right" src="/adm/lonIcons/lonlogos.gif"> 254: ENDDOCHEAD 255: my $forminfo =<<"ENDFORMINFO"; 256: <form action="/adm/createuser" method="post" name="cu"> 257: <input type="hidden" name="phase" value="three"> 258: <input type="hidden" name="ccuname" value="$ccuname"> 259: <input type="hidden" name="ccdomain" value="$ccdomain"> 260: <input type="hidden" name="pres_value" value="" > 261: <input type="hidden" name="pres_type" value="" > 262: <input type="hidden" name="pres_marker" value="" > 263: <input type="hidden" name="cuname" value="$ccuname"> 264: <input type="hidden" name="cdomain" value="$ccdomain"> 265: ENDFORMINFO 266: my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain); 267: my %incdomains; 268: my %inccourses; 269: foreach (%Apache::lonnet::hostdom) { 270: $incdomains{$_}=1; 271: } 272: foreach (keys(%ENV)) { 273: if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) { 274: $inccourses{$1.'_'.$2}=1; 275: } 276: } 277: if ($uhome eq 'no_host') { 278: $r->print(<<ENDNEWUSER); 279: $dochead 280: <h1>Create New User</h1> 281: $forminfo 282: <h2>New user "$ccuname" in domain $ccdomain</h2> 283: $loginscript 284: <input type='hidden' name='makeuser' value='1' /> 285: <h3>Personal Data</h3> 286: <p> 287: <table> 288: <tr><td>First Name </td> 289: <td><input type='text' name='cfirst' size='15' /></td></tr> 290: <tr><td>Middle Name </td> 291: <td><input type='text' name='cmiddle' size='15' /></td></tr> 292: <tr><td>Last Name </td> 293: <td><input type='text' name='clast' size='15' /></td></tr> 294: <tr><td>Generation </td> 295: <td><input type='text' name='cgen' size='5' /></td></tr> 296: </table> 297: ID/Student Number <input type='text' name='cstid' size='15' /></p> 298: <hr /> 299: <h3>Login Data</h3> 300: $generalrule 301: $authformkrb 302: $authformint 303: $authformfsys 304: $authformloc 305: ENDNEWUSER 306: } else { # user already exists 307: $r->print(<<ENDCHANGEUSER); 308: $dochead 309: <h1>Change User Privileges</h1> 310: $forminfo 311: <h2>User "$ccuname" in domain $ccdomain </h2> 312: ENDCHANGEUSER 313: # Get the users information 314: my %userenv = &Apache::lonnet::get('environment', 315: ['firstname','middlename','lastname','generation'], 316: $ccdomain,$ccuname); 317: my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname); 318: $r->print(<<END); 319: <hr /> 320: <table border="2"> 321: <tr> 322: <th>first name</th><th>middle name</th><th>last name</th><th>generation</th> 323: </tr> 324: <tr> 325: END 326: foreach ('firstname','middlename','lastname','generation') { 327: if (&Apache::lonnet::allowed('mau',$ccdomain)) { 328: $r->print(<<"END"); 329: <td><input type="text" name="c$_" value="$userenv{$_}" size="15"/></td> 330: END 331: } else { 332: $r->print('<td>'.$userenv{$_}.'</td>'); 333: } 334: } 335: $r->print(<<END); 336: </tr> 337: </table> 338: END 339: # Build up table of user roles to allow revocation of a role. 340: my ($tmp) = keys(%rolesdump); 341: unless ($tmp =~ /^(con_lost|error)/i) { 342: my $now=time; 343: $r->print('<hr /><h3>Revoke Existing Roles</h3>'. 344: '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'. 345: '<th>Start</th><th>End</th>'); 346: foreach my $area (keys(%rolesdump)) { 347: if ($area!~/^rolesdef/) { 348: my $role = $rolesdump{$area}; 349: my $thisrole=$area; 350: $area=~s/\_\w\w$//; 351: my ($role_code,$role_end_time,$role_start_time) = 352: split(/_/,$role); 353: my $bgcol='ffffff'; 354: my $allows=0; 355: if ($area=~/^\/(\w+)\/(\d\w+)/) { 356: my %coursedata= 357: &Apache::lonnet::coursedescription($1.'_'.$2); 358: my $carea='Course: '.$coursedata{'description'}; 359: $inccourses{$1.'_'.$2}=1; 360: if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) { 361: $allows=1; 362: } 363: # Compute the background color based on $area 364: $bgcol=$1.'_'.$2; 365: $bgcol=~s/[^8-9b-e]//g; 366: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6); 367: if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) { 368: $carea.='<br>Section/Group: '.$3; 369: } 370: $area=$carea; 371: } else { 372: # Determine if current user is able to revoke privileges 373: if ($area=~/^\/(\w+)\//) { 374: if (&Apache::lonnet::allowed('c'.$role_code,$1)) { 375: $allows=1; 376: } 377: } else { 378: if (&Apache::lonnet::allowed('c'.$role_code,'/')) { 379: $allows=1; 380: } 381: } 382: } 383: $r->print('<tr bgcolor=#"'.$bgcol.'"><td>'); 384: my $active=1; 385: $active=0 if (($role_end_time) && ($now>$role_end_time)); 386: if (($active) && ($allows)) { 387: $r->print('<input type="checkbox" name="rev:' 388: .$thisrole.'">'); 389: } else { 390: $r->print(' '); 391: } 392: $r->print('</td><td>'. 393: &Apache::lonnet::plaintext($role_code). 394: '</td><td>'.$area.'</td><td>'. 395: ($role_start_time ? localtime($role_start_time) 396: : ' ' ) 397: .'</td><td>'. 398: ($role_end_time ? localtime($role_end_time) 399: : ' ' ) 400: ."</td></tr>\n"); 401: } 402: } # end of foreach (table building loop) 403: $r->print('</table>'); 404: } # End of unless 405: my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain); 406: if ($currentauth=~/^krb4:/) { 407: $currentauth=~/^krb4:(.*)/; 408: my $krbdefdom2=$1; 409: $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/; 410: } 411: # Check for a bad authentication type 412: unless ($currentauth=~/^krb4:/ or 413: $currentauth=~/^unix:/ or 414: $currentauth=~/^internal:/ or 415: $currentauth=~/^localauth:/ 416: ) { # bad authentication scheme 417: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 418: $r->print(<<ENDBADAUTH); 419: <hr /> 420: $loginscript 421: <font color='#ff0000'>ERROR:</font> 422: This user has an unrecognized authentication scheme ($currentauth). 423: Please specify login data below. 424: <h3>Login Data</h3> 425: $generalrule 426: $authformkrb 427: $authformint 428: $authformfsys 429: $authformloc 430: ENDBADAUTH 431: } else { 432: # This user is not allowed to modify the users 433: # authentication scheme, so just notify them of the problem 434: $r->print(<<ENDBADAUTH); 435: <hr /> 436: $loginscript 437: <font color="#ff0000"> ERROR: </font> 438: This user has an unrecognized authentication scheme ($currentauth). 439: Please alert a domain coordinator of this situation. 440: <hr /> 441: ENDBADAUTH 442: } 443: } else { # Authentication type is valid 444: my $authformcurrent=''; 445: my $authform_other=''; 446: if ($currentauth=~/^krb4:/) { 447: $authformcurrent=$authformkrb; 448: $authform_other=$authformint.$authformfsys.$authformloc; 449: # embarrassing script hack here 450: $loginscript=~s/login\[3\]/login\[4\]/; # loc 451: $loginscript=~s/login\[2\]/login\[3\]/; # fsys 452: $loginscript=~s/login\[1\]/login\[2\]/; # int 453: $loginscript=~s/login\[0\]/login\[1\]/; # krb4 454: } 455: elsif ($currentauth=~/^internal:/) { 456: $authformcurrent=$authformint; 457: $authform_other=$authformkrb.$authformfsys.$authformloc; 458: # embarrassing script hack here 459: $loginscript=~s/login\[3\]/login\[4\]/; # loc 460: $loginscript=~s/login\[2\]/login\[3\]/; # fsys 461: $loginscript=~s/login\[1\]/login\[1\]/; # int 462: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 463: } 464: elsif ($currentauth=~/^unix:/) { 465: $authformcurrent=$authformfsys; 466: $authform_other=$authformkrb.$authformint.$authformloc; 467: # embarrassing script hack here 468: $loginscript=~s/login\[3\]/login\[4\]/; # loc 469: $loginscript=~s/login\[1\]/login\[3\]/; # int 470: $loginscript=~s/login\[2\]/login\[1\]/; # fsys 471: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 472: } 473: elsif ($currentauth=~/^localauth:/) { 474: $authformcurrent=$authformloc; 475: $authform_other=$authformkrb.$authformint.$authformfsys; 476: # embarrassing script hack here 477: $loginscript=~s/login\[3\]/login\[loc\]/; # loc 478: $loginscript=~s/login\[2\]/login\[4\]/; # fsys 479: $loginscript=~s/login\[1\]/login\[3\]/; # int 480: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 481: $loginscript=~s/login\[loc\]/login\[1\]/; # loc 482: } 483: $authformcurrent=<<ENDCURRENTAUTH; 484: <table border='1'> 485: <tr> 486: <td><font color='#ff0000'>* * * WARNING * * *</font></td> 487: <td><font color='#ff0000'>* * * WARNING * * *</font></td> 488: </tr> 489: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td> 490: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr> 491: </table> 492: ENDCURRENTAUTH 493: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 494: # Current user has login modification privileges 495: $r->print(<<ENDOTHERAUTHS); 496: <hr /> 497: $loginscript 498: <h3>Change Current Login Data</h3> 499: $generalrule 500: $authformnop 501: $authformcurrent 502: <h3>Enter New Login Data</h3> 503: $authform_other 504: ENDOTHERAUTHS 505: } 506: } ## End of "check for bad authentication type" logic 507: } ## End of new user/old user logic 508: $r->print('<hr /><h3>Add Roles</h3>'); 509: # 510: # Co-Author 511: # 512: 513: if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) { 514: my $cuname=$ENV{'user.name'}; 515: my $cudom=$ENV{'user.domain'}; 516: $r->print(<<ENDCOAUTH); 517: <h4>Construction Space</h4> 518: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th> 519: <th>Start</th><th>End</th></tr> 520: <tr> 521: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td> 522: <td>Co-Author</td> 523: <td>$cudom\_$cuname</td> 524: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''> 525: <a href= 526: "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> 527: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''> 528: <a href= 529: "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> 530: </tr> 531: </table> 532: ENDCOAUTH 533: } 534: # 535: # Domain level 536: # 537: $r->print('<h4>Domain Level</h4>'. 538: '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'. 539: '<th>Start</th><th>End</th></tr>'); 540: foreach ( sort( keys(%incdomains))) { 541: my $thisdomain=$_; 542: foreach ('dc','li','dg','au') { 543: if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) { 544: my $plrole=&Apache::lonnet::plaintext($_); 545: $r->print(<<ENDDROW); 546: <tr> 547: <td><input type=checkbox name="act_$thisdomain\_$_"></td> 548: <td>$plrole</td> 549: <td>$thisdomain</td> 550: <td><input type=hidden name="start_$thisdomain\_$_" value=''> 551: <a href= 552: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td> 553: <td><input type=hidden name="end_$thisdomain\_$_" value=''> 554: <a href= 555: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td> 556: </tr> 557: ENDDROW 558: } 559: } 560: } 561: $r->print('</table>'); 562: # 563: # Course level 564: # 565: $r->print(&course_level_table(%inccourses)); 566: $r->print("<hr /><input type=submit value=\"Modify User\">\n"); 567: $r->print("</form></body></html>"); 568: } 569: 570: # ================================================================= Phase Three 571: sub phase_three { 572: my $r=shift; 573: # Error messages 574: my $error = '<font color="#ff0000">Error:</font>'; 575: my $end = '</body></html>'; 576: # Print header 577: $r->print(<<ENDTHREEHEAD); 578: <html> 579: <head> 580: <title>The LearningOnline Network with CAPA</title> 581: </head> 582: <body bgcolor="#FFFFFF"> 583: <img align="right" src="/adm/lonIcons/lonlogos.gif"> 584: ENDTHREEHEAD 585: # Check Inputs 586: if (! $ENV{'form.cuname'} ) { 587: $r->print($error.'No login name specified.'.$end); 588: return; 589: } 590: if ( $ENV{'form.cuname'} =~/\W/) { 591: $r->print($error.'Invalid login name. '. 592: 'Only letters, numbers, and underscores are valid.'. 593: $end); 594: return; 595: } 596: if (! $ENV{'form.cdomain'} ) { 597: $r->print($error.'No domain specified.'.$end); 598: return; 599: } 600: if ( $ENV{'form.cdomain'} =~/\W/) { 601: $r->print($error.'Invalid domain name. '. 602: 'Only letters, numbers, and underscores are valid.'. 603: $end); 604: return; 605: } 606: # Determine authentication method and password for the user being modified 607: my $amode=''; 608: my $genpwd=''; 609: if ($ENV{'form.login'} eq 'krb') { 610: $amode='krb4'; 611: $genpwd=$ENV{'form.krbdom'}; 612: } elsif ($ENV{'form.login'} eq 'int') { 613: $amode='internal'; 614: $genpwd=$ENV{'form.intpwd'}; 615: } elsif ($ENV{'form.login'} eq 'fsys') { 616: $amode='unix'; 617: $genpwd=$ENV{'form.fsyspwd'}; 618: } elsif ($ENV{'form.login'} eq 'loc') { 619: $amode='localauth'; 620: $genpwd=$ENV{'form.locarg'}; 621: $genpwd=" " if (!$genpwd); 622: } 623: if ($ENV{'form.makeuser'}) { 624: # Create a new user 625: $r->print(<<ENDNEWUSERHEAD); 626: <h1>Create User</h1> 627: <h3>Creating user "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2> 628: ENDNEWUSERHEAD 629: # Check for the authentication mode and password 630: if (! $amode || ! $genpwd) { 631: $r->print($error.'Invalid login mode or password'.$end); 632: return; 633: } 634: # Call modifyuser 635: my $result = &Apache::lonnet::modifyuser 636: ($ENV{'form.cdomain'},$ENV{'form.cuname'}, 637: $ENV{'form.cstid'},$amode,$genpwd, 638: $ENV{'form.cfirst'},$ENV{'form.cmiddle'}, 639: $ENV{'form.clast'},$ENV{'form.cgen'} 640: ); 641: $r->print('Generating user: '.$result); 642: $r->print('<br>Home server: '.&Apache::lonnet::homeserver 643: ($ENV{'form.cuname'},$ENV{'form.cdomain'})); 644: } elsif ($ENV{'form.login'} ne '') { 645: # Modify user privileges 646: $r->print(<<ENDMODIFYUSERHEAD); 647: <h1>Change User Privileges</h1> 648: <h2>User "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2> 649: ENDMODIFYUSERHEAD 650: if (! $amode || ! $genpwd) { 651: $r->print($error.'Invalid login mode or password'.$end); 652: return; 653: } 654: # Only allow authentification modification if the person has authority 655: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 656: $r->print('Modifying authentication: '. 657: &Apache::lonnet::modifyuserauth( 658: $ENV{'form.cdomain'},$ENV{'form.cuname'}, 659: $amode,$genpwd)); 660: $r->print('<br>Home server: '.&Apache::lonnet::homeserver 661: ($ENV{'form.cuname'},$ENV{'form.cdomain'})); 662: } else { 663: # Okay, this is a non-fatal error. 664: $r->print($error.'You do not have the authority to modify '. 665: 'this users authentification information.'); 666: } 667: } 668: ## 669: if (! $ENV{'form.makeuser'} ) { 670: # Check for need to change 671: my %userenv = &Apache::lonnet::get 672: ('environment',['firstname','middlename','lastname','generation'], 673: $ENV{'form.cdomain'},$ENV{'form.cuname'}); 674: my ($tmp) = keys(%userenv); 675: if ($tmp =~ /^(con_lost|error)/i) { 676: %userenv = (); 677: } 678: # Check to see if we need to change user information 679: foreach ('firstname','middlename','lastname','generation') { 680: # Strip leading and trailing whitespace 681: $ENV{'form.c'.$_} =~ s/(\s+$|^\s+)//g; 682: } 683: if (&Apache::lonnet::allowed('mau',$ENV{'form.cdomain'}) && 684: ($ENV{'form.cfirstname'} ne $userenv{'firstname'} || 685: $ENV{'form.cmiddlename'} ne $userenv{'middlename'} || 686: $ENV{'form.clastname'} ne $userenv{'lastname'} || 687: $ENV{'form.cgeneration'} ne $userenv{'generation'} )) { 688: # Make the change 689: my %changeHash; 690: $changeHash{'firstname'} = $ENV{'form.cfirstname'}; 691: $changeHash{'middlename'} = $ENV{'form.cmiddlename'}; 692: $changeHash{'lastname'} = $ENV{'form.clastname'}; 693: $changeHash{'generation'} = $ENV{'form.cgeneration'}; 694: my $putresult = &Apache::lonnet::put 695: ('environment',\%changeHash, 696: $ENV{'form.cdomain'},$ENV{'form.cuname'}); 697: if ($putresult eq 'ok') { 698: # Tell the user we changed the name 699: $r->print(<<"END"); 700: <table border="2"> 701: <caption>User Information Changed</caption> 702: <tr><th> </th> 703: <th>first</th> 704: <th>middle</th> 705: <th>last</th> 706: <th>generation</th></tr> 707: <tr><td>Previous</td> 708: <td>$userenv{'firstname'} </td> 709: <td>$userenv{'middlename'} </td> 710: <td>$userenv{'lastname'} </td> 711: <td>$userenv{'generation'} </td></tr> 712: <tr><td>Changed To</td> 713: <td>$ENV{'form.cfirstname'} </td> 714: <td>$ENV{'form.cmiddlename'} </td> 715: <td>$ENV{'form.clastname'} </td> 716: <td>$ENV{'form.cgeneration'} </td></tr> 717: </table> 718: END 719: } else { # error occurred 720: $r->print("<h2>Unable to successfully change environment for ". 721: $ENV{'form.cuname'}." in domain ". 722: $ENV{'form.cdomain'}."</h2>"); 723: } 724: } else { # End of if ($ENV ... ) logic 725: # They did not want to change the users name but we can 726: # still tell them what the name is 727: $r->print(<<"END"); 728: <h2>User "$ENV{'form.cuname'}" in domain "$ENV{'form.cdomain'}"</h2> 729: <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4> 730: <h4>Generation: $userenv{'generation'}</h4> 731: END 732: } 733: } 734: ## 735: my $now=time; 736: $r->print('<h3>Modifying Roles</h3>'); 737: foreach (keys (%ENV)) { 738: next if (! $ENV{$_}); 739: # Revoke roles 740: if ($_=~/^form\.rev/) { 741: if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) { 742: $r->print('Revoking '.$2.' in '.$1.': '. 743: &Apache::lonnet::assignrole($ENV{'form.cdomain'}, 744: $ENV{'form.cuname'},$1,$2,$now).'<br>'); 745: if ($2 eq 'st') { 746: $1=~/^\/(\w+)\/(\w+)/; 747: my $cid=$1.'_'.$2; 748: $r->print('Drop from classlist: '. 749: &Apache::lonnet::critical('put:'. 750: $ENV{'course.'.$cid.'.domain'}.':'. 751: $ENV{'course.'.$cid.'.num'}.':classlist:'. 752: &Apache::lonnet::escape($ENV{'form.cuname'}.':'. 753: $ENV{'form.cdomain'}).'='. 754: &Apache::lonnet::escape($now.':'), 755: $ENV{'course.'.$cid.'.home'}).'<br>'); 756: } 757: } 758: } elsif ($_=~/^form\.act/) { 759: if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) { 760: # Activate roles for sections with 3 id numbers 761: # set start, end times, and the url for the class 762: my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 763: $ENV{'form.start_'.$1.'_'.$2} : 764: $now ); 765: my $end = ( $ENV{'form.end_'.$1.'_'.$2} ? 766: $ENV{'form.end_'.$1.'_'.$2} : 767: 0 ); 768: my $url='/'.$1.'/'.$2; 769: if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) { 770: $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3}; 771: } 772: # Assign the role and report it 773: $r->print('Assigning: '.$3.' in '.$url.': '. 774: &Apache::lonnet::assignrole( 775: $ENV{'form.cdomain'},$ENV{'form.cuname'}, 776: $url,$3,$end,$start). 777: '<br>'); 778: # Handle students differently 779: if ($3 eq 'st') { 780: $url=~/^\/(\w+)\/(\w+)/; 781: my $cid=$1.'_'.$2; 782: $r->print('Add to classlist: '. 783: &Apache::lonnet::critical( 784: 'put:'.$ENV{'course.'.$cid.'.domain'}.':'. 785: $ENV{'course.'.$cid.'.num'}.':classlist:'. 786: &Apache::lonnet::escape( 787: $ENV{'form.cuname'}.':'. 788: $ENV{'form.cdomain'} ).'='. 789: &Apache::lonnet::escape($end.':'.$start), 790: $ENV{'course.'.$cid.'.home'}) 791: .'<br>'); 792: } 793: } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) { 794: # Activate roles for sections with two id numbers 795: # set start, end times, and the url for the class 796: my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 797: $ENV{'form.start_'.$1.'_'.$2} : 798: $now ); 799: my $end = ( $ENV{'form.end_'.$1.'_'.$2} ? 800: $ENV{'form.end_'.$1.'_'.$2} : 801: 0 ); 802: my $url='/'.$1.'/'; 803: # Assign the role and report it. 804: $r->print('Assigning: '.$2.' in '.$url.': '. 805: &Apache::lonnet::assignrole( 806: $ENV{'form.cdomain'},$ENV{'form.cuname'}, 807: $url,$2,$end,$start) 808: .'<br>'); 809: } 810: } 811: } # End of foreach (keys(%ENV)) 812: $r->print('</body></html>'); 813: } 814: 815: # ================================================================ Main Handler 816: sub handler { 817: my $r = shift; 818: 819: if ($r->header_only) { 820: $r->content_type('text/html'); 821: $r->send_http_header; 822: return OK; 823: } 824: 825: if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) || 826: (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 827: (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 828: (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) || 829: (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) || 830: (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) { 831: $r->content_type('text/html'); 832: $r->send_http_header; 833: unless ($ENV{'form.phase'}) { 834: &phase_one($r); 835: } 836: if ($ENV{'form.phase'} eq 'two') { 837: &phase_two($r); 838: } elsif ($ENV{'form.phase'} eq 'three') { 839: &phase_three($r); 840: } 841: } else { 842: $ENV{'user.error.msg'}= 843: "/adm/createuser:mau:0:0:Cannot modify user data"; 844: return HTTP_NOT_ACCEPTABLE; 845: } 846: return OK; 847: } 848: 849: #-------------------------------------------------- functions for &phase_two 850: sub course_level_table { 851: my %inccourses = @_; 852: my $table = ''; 853: foreach (sort( keys(%inccourses))) { 854: my $thiscourse=$_; 855: my $protectedcourse=$_; 856: $thiscourse=~s:_:/:g; 857: my %coursedata=&Apache::lonnet::coursedescription($thiscourse); 858: my $area=$coursedata{'description'}; 859: my $bgcol=$thiscourse; 860: $bgcol=~s/[^8-9b-e]//g; 861: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6); 862: foreach ('st','ta','ep','ad','in','cc') { 863: if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) { 864: my $plrole=&Apache::lonnet::plaintext($_); 865: $table .= <<ENDEXTENT; 866: <tr bgcolor="#$bgcol"> 867: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td> 868: <td>$plrole</td> 869: <td>$area</td> 870: ENDEXTENT 871: if ($_ ne 'cc') { 872: $table .= <<ENDSECTION; 873: <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td> 874: ENDSECTION 875: } else { 876: $table .= <<ENDSECTION; 877: <td>&nbsp</td> 878: ENDSECTION 879: } 880: $table .= <<ENDTIMEENTRY; 881: <td><input type=hidden name="start_$protectedcourse\_$_" value=''> 882: <a href= 883: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td> 884: <td><input type=hidden name="end_$protectedcourse\_$_" value=''> 885: <a href= 886: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td> 887: ENDTIMEENTRY 888: $table.= "</tr>\n"; 889: } 890: } 891: } 892: return '' if ($table eq ''); # return nothing if there is nothing 893: # in the table 894: my $result = <<ENDTABLE; 895: <h4>Course Level</h4> 896: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th> 897: <th>Group/Section</th><th>Start</th><th>End</th></tr> 898: $table 899: </table> 900: ENDTABLE 901: return $result; 902: } 903: #---------------------------------------------- end functions for &phase_two 904: 905: 1; 906: __END__ 907: 908: