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, 3 months 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.

1: # The LearningOnline Network with CAPA 2: # Create a user 3: # 4: # $Id: loncreateuser.pm,v 1.29 2002/04/04 21:46:44 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.29 2002/04/04 21:46:44 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: ENDFORMINFO 264: my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain); 265: my %incdomains; 266: my %inccourses; 267: my %home_servers = &get_home_servers($ccdomain); 268: foreach (%Apache::lonnet::hostdom) { 269: $incdomains{$_}=1; 270: } 271: foreach (keys(%ENV)) { 272: if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) { 273: $inccourses{$1.'_'.$2}=1; 274: } 275: } 276: if ($uhome eq 'no_host') { 277: my $home_server_list= 278: '<option value="default" selected>default</option>'."\n"; 279: foreach (sort keys(%home_servers)) { 280: $home_server_list.= 281: '<option value="'.$_.'">'.$_.' '. 282: $home_servers{$_}."</option>\n"; 283: } 284: $r->print(<<ENDNEWUSER); 285: $dochead 286: <h1>Create New User</h1> 287: $forminfo 288: <h2>New user "$ccuname" in domain $ccdomain</h2> 289: $loginscript 290: <input type='hidden' name='makeuser' value='1' /> 291: <h3>Personal Data</h3> 292: <p> 293: <table> 294: <tr><td>First Name </td> 295: <td><input type='text' name='cfirst' size='15' /></td></tr> 296: <tr><td>Middle Name </td> 297: <td><input type='text' name='cmiddle' size='15' /></td></tr> 298: <tr><td>Last Name </td> 299: <td><input type='text' name='clast' size='15' /></td></tr> 300: <tr><td>Generation </td> 301: <td><input type='text' name='cgen' size='5' /></td></tr> 302: </table> 303: ID/Student Number <input type='text' name='cstid' size='15' /></p> 304: Home Server: <select name="hserver" size="1"> $home_server_list </select> 305: <hr /> 306: <h3>Login Data</h3> 307: $generalrule 308: $authformkrb 309: $authformint 310: $authformfsys 311: $authformloc 312: ENDNEWUSER 313: } else { # user already exists 314: $r->print(<<ENDCHANGEUSER); 315: $dochead 316: <h1>Change User Privileges</h1> 317: $forminfo 318: <h2>User "$ccuname" in domain $ccdomain </h2> 319: ENDCHANGEUSER 320: # Get the users information 321: my %userenv = &Apache::lonnet::get('environment', 322: ['firstname','middlename','lastname','generation'], 323: $ccdomain,$ccuname); 324: my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname); 325: $r->print(<<END); 326: <hr /> 327: <table border="2"> 328: <tr> 329: <th>first name</th><th>middle name</th><th>last name</th><th>generation</th> 330: </tr> 331: <tr> 332: END 333: foreach ('firstname','middlename','lastname','generation') { 334: if (&Apache::lonnet::allowed('mau',$ccdomain)) { 335: $r->print(<<"END"); 336: <td><input type="text" name="c$_" value="$userenv{$_}" size="15"/></td> 337: END 338: } else { 339: $r->print('<td>'.$userenv{$_}.'</td>'); 340: } 341: } 342: $r->print(<<END); 343: </tr> 344: </table> 345: END 346: # Build up table of user roles to allow revocation of a role. 347: my ($tmp) = keys(%rolesdump); 348: unless ($tmp =~ /^(con_lost|error)/i) { 349: my $now=time; 350: $r->print('<hr /><h3>Revoke Existing Roles</h3>'. 351: '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'. 352: '<th>Start</th><th>End</th>'); 353: foreach my $area (keys(%rolesdump)) { 354: if ($area!~/^rolesdef/) { 355: my $role = $rolesdump{$area}; 356: my $thisrole=$area; 357: $area=~s/\_\w\w$//; 358: my ($role_code,$role_end_time,$role_start_time) = 359: split(/_/,$role); 360: my $bgcol='ffffff'; 361: my $allows=0; 362: if ($area=~/^\/(\w+)\/(\d\w+)/) { 363: my %coursedata= 364: &Apache::lonnet::coursedescription($1.'_'.$2); 365: my $carea='Course: '.$coursedata{'description'}; 366: $inccourses{$1.'_'.$2}=1; 367: if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) { 368: $allows=1; 369: } 370: # Compute the background color based on $area 371: $bgcol=$1.'_'.$2; 372: $bgcol=~s/[^8-9b-e]//g; 373: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6); 374: if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) { 375: $carea.='<br>Section/Group: '.$3; 376: } 377: $area=$carea; 378: } else { 379: # Determine if current user is able to revoke privileges 380: if ($area=~/^\/(\w+)\//) { 381: if (&Apache::lonnet::allowed('c'.$role_code,$1)) { 382: $allows=1; 383: } 384: } else { 385: if (&Apache::lonnet::allowed('c'.$role_code,'/')) { 386: $allows=1; 387: } 388: } 389: } 390: $r->print('<tr bgcolor=#"'.$bgcol.'"><td>'); 391: my $active=1; 392: $active=0 if (($role_end_time) && ($now>$role_end_time)); 393: if (($active) && ($allows)) { 394: $r->print('<input type="checkbox" name="rev:' 395: .$thisrole.'">'); 396: } else { 397: $r->print(' '); 398: } 399: $r->print('</td><td>'. 400: &Apache::lonnet::plaintext($role_code). 401: '</td><td>'.$area.'</td><td>'. 402: ($role_start_time ? localtime($role_start_time) 403: : ' ' ) 404: .'</td><td>'. 405: ($role_end_time ? localtime($role_end_time) 406: : ' ' ) 407: ."</td></tr>\n"); 408: } 409: } # end of foreach (table building loop) 410: $r->print('</table>'); 411: } # End of unless 412: my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain); 413: if ($currentauth=~/^krb4:/) { 414: $currentauth=~/^krb4:(.*)/; 415: my $krbdefdom2=$1; 416: $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/; 417: } 418: # Check for a bad authentication type 419: unless ($currentauth=~/^krb4:/ or 420: $currentauth=~/^unix:/ or 421: $currentauth=~/^internal:/ or 422: $currentauth=~/^localauth:/ 423: ) { # bad authentication scheme 424: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 425: $r->print(<<ENDBADAUTH); 426: <hr /> 427: $loginscript 428: <font color='#ff0000'>ERROR:</font> 429: This user has an unrecognized authentication scheme ($currentauth). 430: Please specify login data below. 431: <h3>Login Data</h3> 432: $generalrule 433: $authformkrb 434: $authformint 435: $authformfsys 436: $authformloc 437: ENDBADAUTH 438: } else { 439: # This user is not allowed to modify the users 440: # authentication scheme, so just notify them of the problem 441: $r->print(<<ENDBADAUTH); 442: <hr /> 443: $loginscript 444: <font color="#ff0000"> ERROR: </font> 445: This user has an unrecognized authentication scheme ($currentauth). 446: Please alert a domain coordinator of this situation. 447: <hr /> 448: ENDBADAUTH 449: } 450: } else { # Authentication type is valid 451: my $authformcurrent=''; 452: my $authform_other=''; 453: if ($currentauth=~/^krb4:/) { 454: $authformcurrent=$authformkrb; 455: $authform_other=$authformint.$authformfsys.$authformloc; 456: # embarrassing script hack here 457: $loginscript=~s/login\[3\]/login\[4\]/; # loc 458: $loginscript=~s/login\[2\]/login\[3\]/; # fsys 459: $loginscript=~s/login\[1\]/login\[2\]/; # int 460: $loginscript=~s/login\[0\]/login\[1\]/; # krb4 461: } 462: elsif ($currentauth=~/^internal:/) { 463: $authformcurrent=$authformint; 464: $authform_other=$authformkrb.$authformfsys.$authformloc; 465: # embarrassing script hack here 466: $loginscript=~s/login\[3\]/login\[4\]/; # loc 467: $loginscript=~s/login\[2\]/login\[3\]/; # fsys 468: $loginscript=~s/login\[1\]/login\[1\]/; # int 469: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 470: } 471: elsif ($currentauth=~/^unix:/) { 472: $authformcurrent=$authformfsys; 473: $authform_other=$authformkrb.$authformint.$authformloc; 474: # embarrassing script hack here 475: $loginscript=~s/login\[3\]/login\[4\]/; # loc 476: $loginscript=~s/login\[1\]/login\[3\]/; # int 477: $loginscript=~s/login\[2\]/login\[1\]/; # fsys 478: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 479: } 480: elsif ($currentauth=~/^localauth:/) { 481: $authformcurrent=$authformloc; 482: $authform_other=$authformkrb.$authformint.$authformfsys; 483: # embarrassing script hack here 484: $loginscript=~s/login\[3\]/login\[loc\]/; # loc 485: $loginscript=~s/login\[2\]/login\[4\]/; # fsys 486: $loginscript=~s/login\[1\]/login\[3\]/; # int 487: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 488: $loginscript=~s/login\[loc\]/login\[1\]/; # loc 489: } 490: $authformcurrent=<<ENDCURRENTAUTH; 491: <table border='1'> 492: <tr> 493: <td><font color='#ff0000'>* * * WARNING * * *</font></td> 494: <td><font color='#ff0000'>* * * WARNING * * *</font></td> 495: </tr> 496: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td> 497: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr> 498: </table> 499: ENDCURRENTAUTH 500: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 501: # Current user has login modification privileges 502: $r->print(<<ENDOTHERAUTHS); 503: <hr /> 504: $loginscript 505: <h3>Change Current Login Data</h3> 506: $generalrule 507: $authformnop 508: $authformcurrent 509: <h3>Enter New Login Data</h3> 510: $authform_other 511: ENDOTHERAUTHS 512: } 513: } ## End of "check for bad authentication type" logic 514: } ## End of new user/old user logic 515: $r->print('<hr /><h3>Add Roles</h3>'); 516: # 517: # Co-Author 518: # 519: 520: if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) { 521: my $cuname=$ENV{'user.name'}; 522: my $cudom=$ENV{'user.domain'}; 523: $r->print(<<ENDCOAUTH); 524: <h4>Construction Space</h4> 525: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th> 526: <th>Start</th><th>End</th></tr> 527: <tr> 528: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td> 529: <td>Co-Author</td> 530: <td>$cudom\_$cuname</td> 531: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''> 532: <a href= 533: "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> 534: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''> 535: <a href= 536: "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> 537: </tr> 538: </table> 539: ENDCOAUTH 540: } 541: # 542: # Domain level 543: # 544: $r->print('<h4>Domain Level</h4>'. 545: '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'. 546: '<th>Start</th><th>End</th></tr>'); 547: foreach ( sort( keys(%incdomains))) { 548: my $thisdomain=$_; 549: foreach ('dc','li','dg','au') { 550: if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) { 551: my $plrole=&Apache::lonnet::plaintext($_); 552: $r->print(<<ENDDROW); 553: <tr> 554: <td><input type=checkbox name="act_$thisdomain\_$_"></td> 555: <td>$plrole</td> 556: <td>$thisdomain</td> 557: <td><input type=hidden name="start_$thisdomain\_$_" value=''> 558: <a href= 559: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td> 560: <td><input type=hidden name="end_$thisdomain\_$_" value=''> 561: <a href= 562: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td> 563: </tr> 564: ENDDROW 565: } 566: } 567: } 568: $r->print('</table>'); 569: # 570: # Course level 571: # 572: $r->print(&course_level_table(%inccourses)); 573: $r->print("<hr /><input type=submit value=\"Modify User\">\n"); 574: $r->print("</form></body></html>"); 575: } 576: 577: # ================================================================= Phase Three 578: sub phase_three { 579: my $r=shift; 580: my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'}, 581: $ENV{'form.ccdomain'}); 582: # Error messages 583: my $error = '<font color="#ff0000">Error:</font>'; 584: my $end = '</body></html>'; 585: # Print header 586: $r->print(<<ENDTHREEHEAD); 587: <html> 588: <head> 589: <title>The LearningOnline Network with CAPA</title> 590: </head> 591: <body bgcolor="#FFFFFF"> 592: <img align="right" src="/adm/lonIcons/lonlogos.gif"> 593: ENDTHREEHEAD 594: # Check Inputs 595: if (! $ENV{'form.ccuname'} ) { 596: $r->print($error.'No login name specified.'.$end); 597: return; 598: } 599: if ( $ENV{'form.ccuname'} =~/\W/) { 600: $r->print($error.'Invalid login name. '. 601: 'Only letters, numbers, and underscores are valid.'. 602: $end); 603: return; 604: } 605: if (! $ENV{'form.ccdomain'} ) { 606: $r->print($error.'No domain specified.'.$end); 607: return; 608: } 609: if ( $ENV{'form.ccdomain'} =~/\W/) { 610: $r->print($error.'Invalid domain name. '. 611: 'Only letters, numbers, and underscores are valid.'. 612: $end); 613: return; 614: } 615: if (! exists($ENV{'form.makeuser'})) { 616: # Modifying an existing user, so check the validity of the name 617: if ($uhome eq 'no_host') { 618: $r->print($error.'Unable to determine home server for '. 619: $ENV{'form.ccuname'}.' in domain '. 620: $ENV{'form.ccdomain'}.'.'); 621: return; 622: } 623: } 624: # Determine authentication method and password for the user being modified 625: my $amode=''; 626: my $genpwd=''; 627: if ($ENV{'form.login'} eq 'krb') { 628: $amode='krb4'; 629: $genpwd=$ENV{'form.krbdom'}; 630: } elsif ($ENV{'form.login'} eq 'int') { 631: $amode='internal'; 632: $genpwd=$ENV{'form.intpwd'}; 633: } elsif ($ENV{'form.login'} eq 'fsys') { 634: $amode='unix'; 635: $genpwd=$ENV{'form.fsyspwd'}; 636: } elsif ($ENV{'form.login'} eq 'loc') { 637: $amode='localauth'; 638: $genpwd=$ENV{'form.locarg'}; 639: $genpwd=" " if (!$genpwd); 640: } 641: if ($ENV{'form.makeuser'}) { 642: # Create a new user 643: $r->print(<<ENDNEWUSERHEAD); 644: <h1>Create User</h1> 645: <h3>Creating user "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2> 646: ENDNEWUSERHEAD 647: # Check for the authentication mode and password 648: if (! $amode || ! $genpwd) { 649: $r->print($error.'Invalid login mode or password'.$end); 650: return; 651: } 652: # Determine desired host 653: my $desiredhost = $ENV{'form.hserver'}; 654: if (lc($desiredhost) eq 'default') { 655: $desiredhost = undef; 656: } else { 657: my %home_servers = &get_home_servers($ENV{'form.ccdomain'}); 658: if (! exists($home_servers{$desiredhost})) { 659: $r->print($error.'Invalid home server specified'); 660: return; 661: } 662: } 663: # Call modifyuser 664: my $result = &Apache::lonnet::modifyuser 665: ($ENV{'form.ccdomain'},$ENV{'form.ccuname'},$ENV{'form.cstid'}, 666: $amode,$genpwd,$ENV{'form.cfirst'}, 667: $ENV{'form.cmiddle'},$ENV{'form.clast'},$ENV{'form.cgen'}, 668: undef,$desiredhost 669: ); 670: $r->print('Generating user: '.$result); 671: my $home = &Apache::lonnet::homeserver($ENV{'form.ccuname'}, 672: $ENV{'form.ccdomain'}); 673: $r->print('<br>Home server: '.$home.' '. 674: $Apache::lonnet::libserv{$home}); 675: } elsif ($ENV{'form.login'} ne '') { 676: # Modify user privileges 677: $r->print(<<ENDMODIFYUSERHEAD); 678: <h1>Change User Privileges</h1> 679: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2> 680: ENDMODIFYUSERHEAD 681: if (! $amode || ! $genpwd) { 682: $r->print($error.'Invalid login mode or password'.$end); 683: return; 684: } 685: # Only allow authentification modification if the person has authority 686: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 687: $r->print('Modifying authentication: '. 688: &Apache::lonnet::modifyuserauth( 689: $ENV{'form.ccdomain'},$ENV{'form.ccuname'}, 690: $amode,$genpwd)); 691: $r->print('<br>Home server: '.&Apache::lonnet::homeserver 692: ($ENV{'form.ccuname'},$ENV{'form.ccdomain'})); 693: } else { 694: # Okay, this is a non-fatal error. 695: $r->print($error.'You do not have the authority to modify '. 696: 'this users authentification information.'); 697: } 698: } 699: ## 700: if (! $ENV{'form.makeuser'} ) { 701: # Check for need to change 702: my %userenv = &Apache::lonnet::get 703: ('environment',['firstname','middlename','lastname','generation'], 704: $ENV{'form.ccdomain'},$ENV{'form.ccuname'}); 705: my ($tmp) = keys(%userenv); 706: if ($tmp =~ /^(con_lost|error)/i) { 707: %userenv = (); 708: } 709: # Check to see if we need to change user information 710: foreach ('firstname','middlename','lastname','generation') { 711: # Strip leading and trailing whitespace 712: $ENV{'form.c'.$_} =~ s/(\s+$|^\s+)//g; 713: } 714: if (&Apache::lonnet::allowed('mau',$ENV{'form.ccdomain'}) && 715: ($ENV{'form.cfirstname'} ne $userenv{'firstname'} || 716: $ENV{'form.cmiddlename'} ne $userenv{'middlename'} || 717: $ENV{'form.clastname'} ne $userenv{'lastname'} || 718: $ENV{'form.cgeneration'} ne $userenv{'generation'} )) { 719: # Make the change 720: my %changeHash; 721: $changeHash{'firstname'} = $ENV{'form.cfirstname'}; 722: $changeHash{'middlename'} = $ENV{'form.cmiddlename'}; 723: $changeHash{'lastname'} = $ENV{'form.clastname'}; 724: $changeHash{'generation'} = $ENV{'form.cgeneration'}; 725: my $putresult = &Apache::lonnet::put 726: ('environment',\%changeHash, 727: $ENV{'form.ccdomain'},$ENV{'form.ccuname'}); 728: if ($putresult eq 'ok') { 729: # Tell the user we changed the name 730: $r->print(<<"END"); 731: <table border="2"> 732: <caption>User Information Changed</caption> 733: <tr><th> </th> 734: <th>first</th> 735: <th>middle</th> 736: <th>last</th> 737: <th>generation</th></tr> 738: <tr><td>Previous</td> 739: <td>$userenv{'firstname'} </td> 740: <td>$userenv{'middlename'} </td> 741: <td>$userenv{'lastname'} </td> 742: <td>$userenv{'generation'} </td></tr> 743: <tr><td>Changed To</td> 744: <td>$ENV{'form.cfirstname'} </td> 745: <td>$ENV{'form.cmiddlename'} </td> 746: <td>$ENV{'form.clastname'} </td> 747: <td>$ENV{'form.cgeneration'} </td></tr> 748: </table> 749: END 750: } else { # error occurred 751: $r->print("<h2>Unable to successfully change environment for ". 752: $ENV{'form.ccuname'}." in domain ". 753: $ENV{'form.ccdomain'}."</h2>"); 754: } 755: } else { # End of if ($ENV ... ) logic 756: # They did not want to change the users name but we can 757: # still tell them what the name is 758: $r->print(<<"END"); 759: <h2>User "$ENV{'form.ccuname'}" in domain "$ENV{'form.ccdomain'}"</h2> 760: <h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} </h4> 761: <h4>Generation: $userenv{'generation'}</h4> 762: END 763: } 764: } 765: ## 766: my $now=time; 767: $r->print('<h3>Modifying Roles</h3>'); 768: foreach (keys (%ENV)) { 769: next if (! $ENV{$_}); 770: # Revoke roles 771: if ($_=~/^form\.rev/) { 772: if ($_=~/^form\.rev\:([^\_]+)\_([^\_]+)$/) { 773: $r->print('Revoking '.$2.' in '.$1.': '. 774: &Apache::lonnet::assignrole($ENV{'form.ccdomain'}, 775: $ENV{'form.ccuname'},$1,$2,$now).'<br>'); 776: if ($2 eq 'st') { 777: $1=~/^\/(\w+)\/(\w+)/; 778: my $cid=$1.'_'.$2; 779: $r->print('Drop from classlist: '. 780: &Apache::lonnet::critical('put:'. 781: $ENV{'course.'.$cid.'.domain'}.':'. 782: $ENV{'course.'.$cid.'.num'}.':classlist:'. 783: &Apache::lonnet::escape($ENV{'form.ccuname'}.':'. 784: $ENV{'form.ccdomain'}).'='. 785: &Apache::lonnet::escape($now.':'), 786: $ENV{'course.'.$cid.'.home'}).'<br>'); 787: } 788: } 789: } elsif ($_=~/^form\.act/) { 790: if ($_=~/^form\.act\_([^\_]+)\_([^\_]+)\_([^\_]+)$/) { 791: # Activate roles for sections with 3 id numbers 792: # set start, end times, and the url for the class 793: my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 794: $ENV{'form.start_'.$1.'_'.$2} : 795: $now ); 796: my $end = ( $ENV{'form.end_'.$1.'_'.$2} ? 797: $ENV{'form.end_'.$1.'_'.$2} : 798: 0 ); 799: my $url='/'.$1.'/'.$2; 800: if ($ENV{'form.sec_'.$1.'_'.$2.'_'.$3}) { 801: $url.='/'.$ENV{'form.sec_'.$1.'_'.$2.'_'.$3}; 802: } 803: # Assign the role and report it 804: $r->print('Assigning: '.$3.' in '.$url.': '. 805: &Apache::lonnet::assignrole( 806: $ENV{'form.ccdomain'},$ENV{'form.ccuname'}, 807: $url,$3,$end,$start). 808: '<br>'); 809: # Handle students differently 810: if ($3 eq 'st') { 811: $url=~/^\/(\w+)\/(\w+)/; 812: my $cid=$1.'_'.$2; 813: $r->print('Add to classlist: '. 814: &Apache::lonnet::critical( 815: 'put:'.$ENV{'course.'.$cid.'.domain'}.':'. 816: $ENV{'course.'.$cid.'.num'}.':classlist:'. 817: &Apache::lonnet::escape( 818: $ENV{'form.ccuname'}.':'. 819: $ENV{'form.ccdomain'} ).'='. 820: &Apache::lonnet::escape($end.':'.$start), 821: $ENV{'course.'.$cid.'.home'}) 822: .'<br>'); 823: } 824: } elsif ($_=~/^form\.act\_([^\_]+)\_([^\_]+)$/) { 825: # Activate roles for sections with two id numbers 826: # set start, end times, and the url for the class 827: my $start = ( $ENV{'form.start_'.$1.'_'.$2} ? 828: $ENV{'form.start_'.$1.'_'.$2} : 829: $now ); 830: my $end = ( $ENV{'form.end_'.$1.'_'.$2} ? 831: $ENV{'form.end_'.$1.'_'.$2} : 832: 0 ); 833: my $url='/'.$1.'/'; 834: # Assign the role and report it. 835: $r->print('Assigning: '.$2.' in '.$url.': '. 836: &Apache::lonnet::assignrole( 837: $ENV{'form.ccdomain'},$ENV{'form.ccuname'}, 838: $url,$2,$end,$start) 839: .'<br>'); 840: } 841: } 842: } # End of foreach (keys(%ENV)) 843: $r->print('</body></html>'); 844: } 845: 846: # ================================================================ Main Handler 847: sub handler { 848: my $r = shift; 849: 850: if ($r->header_only) { 851: $r->content_type('text/html'); 852: $r->send_http_header; 853: return OK; 854: } 855: 856: if ((&Apache::lonnet::allowed('cta',$ENV{'request.course.id'})) || 857: (&Apache::lonnet::allowed('cin',$ENV{'request.course.id'})) || 858: (&Apache::lonnet::allowed('ccr',$ENV{'request.course.id'})) || 859: (&Apache::lonnet::allowed('cep',$ENV{'request.course.id'})) || 860: (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) || 861: (&Apache::lonnet::allowed('mau',$ENV{'user.domain'}))) { 862: $r->content_type('text/html'); 863: $r->send_http_header; 864: unless ($ENV{'form.phase'}) { 865: &phase_one($r); 866: } 867: if ($ENV{'form.phase'} eq 'two') { 868: &phase_two($r); 869: } elsif ($ENV{'form.phase'} eq 'three') { 870: &phase_three($r); 871: } 872: } else { 873: $ENV{'user.error.msg'}= 874: "/adm/createuser:mau:0:0:Cannot modify user data"; 875: return HTTP_NOT_ACCEPTABLE; 876: } 877: return OK; 878: } 879: 880: #-------------------------------------------------- functions for &phase_two 881: sub course_level_table { 882: my %inccourses = @_; 883: my $table = ''; 884: foreach (sort( keys(%inccourses))) { 885: my $thiscourse=$_; 886: my $protectedcourse=$_; 887: $thiscourse=~s:_:/:g; 888: my %coursedata=&Apache::lonnet::coursedescription($thiscourse); 889: my $area=$coursedata{'description'}; 890: my $bgcol=$thiscourse; 891: $bgcol=~s/[^8-9b-e]//g; 892: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6); 893: foreach ('st','ta','ep','ad','in','cc') { 894: if (&Apache::lonnet::allowed('c'.$_,$thiscourse)) { 895: my $plrole=&Apache::lonnet::plaintext($_); 896: $table .= <<ENDEXTENT; 897: <tr bgcolor="#$bgcol"> 898: <td><input type="checkbox" name="act_$protectedcourse\_$_"></td> 899: <td>$plrole</td> 900: <td>$area</td> 901: ENDEXTENT 902: if ($_ ne 'cc') { 903: $table .= <<ENDSECTION; 904: <td><input type="text" size="5" name="sec_$protectedcourse\_$_"></td> 905: ENDSECTION 906: } else { 907: $table .= <<ENDSECTION; 908: <td>&nbsp</td> 909: ENDSECTION 910: } 911: $table .= <<ENDTIMEENTRY; 912: <td><input type=hidden name="start_$protectedcourse\_$_" value=''> 913: <a href= 914: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$protectedcourse\_$_.value,'start_$protectedcourse\_$_','cu.pres','dateset')">Set Start Date</a></td> 915: <td><input type=hidden name="end_$protectedcourse\_$_" value=''> 916: <a href= 917: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$protectedcourse\_$_.value,'end_$protectedcourse\_$_','cu.pres','dateset')">Set End Date</a></td> 918: ENDTIMEENTRY 919: $table.= "</tr>\n"; 920: } 921: } 922: } 923: return '' if ($table eq ''); # return nothing if there is nothing 924: # in the table 925: my $result = <<ENDTABLE; 926: <h4>Course Level</h4> 927: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th> 928: <th>Group/Section</th><th>Start</th><th>End</th></tr> 929: $table 930: </table> 931: ENDTABLE 932: return $result; 933: } 934: #---------------------------------------------- end functions for &phase_two 935: 936: #--------------------------------- functions for &phase_two and &phase_three 937: sub get_home_servers { 938: my $domain = shift; 939: my %home_servers; 940: foreach (keys(%Apache::lonnet::libserv)) { 941: if ($Apache::lonnet::hostdom{$_} eq $domain) { 942: $home_servers{$_} = $Apache::lonnet::hostname{$_}; 943: } 944: } 945: return %home_servers; 946: } 947: 948: #--------------------------end of functions for &phase_two and &phase_three 949: 950: 1; 951: __END__ 952: 953: