loncom/interface/loncreateuser.pm - view

File: [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.30: download - view: text, annotated - select for diffs
Thu Apr 18 20:16:43 2002 UTC (22 years, 2 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Changes made to javascript in the hopes of being able to later move them
to loncommon.pm so that londropadd.pm can also use them.

1: # The LearningOnline Network with CAPA 2: # Create a user 3: # 4: # $Id: loncreateuser.pm,v 1.30 2002/04/18 20:16:43 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.30 2002/04/18 20:16:43 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="nochange" checked="checked" 74: onclick="changed_radio('nochange',document.cu);"> 75: Do not change login data 76: </p> 77: END 78: $authformkrb=(<<END); 79: <p> 80: <input type="radio" name="login" value="krb" 81: onclick="changed_radio('krb',document.cu);"> 82: Kerberos authenticated with domain 83: <input type="text" size="10" name="krbarg" 84: onclick="changed_text('krb',document.cu);" 85: onchange="changed_text('krb',document.cu);"> 86: </p> 87: END 88: $authformint=(<<END); 89: <p> 90: <input type="radio" name="login" value="int" 91: onclick="changed_radio('int',document.cu);"> 92: Internally authenticated (with initial password 93: <input type="text" size="10" name="intarg" 94: onclick="changed_text('int',document.cu);" 95: onchange="changed_text('int',document.cu);"> 96: </p> 97: END 98: $authformfsys=(<<END); 99: <p> 100: <input type="radio" name="login" value="fsys" 101: onclick="changed_radio('fsys',document.cu);"> 102: Filesystem authenticated (with initial password 103: <input type="text" size="10" name="fsysarg" 104: onclick="changed_text('fsys',document.cu);" 105: onchange="changed_text('fsys',document.cu);"> 106: </p> 107: END 108: $authformloc=(<<END); 109: <p> 110: <input type="radio" name="login" value="loc" 111: onclick="changed_radio('loc',document.cu);"> 112: Local Authentication with argument 113: <input type="text" size="10" name="locarg" 114: onclick="changed_text('loc',document.cu);" 115: onchange="changed_text('loc',document.cu);"> 116: </p> 117: END 118: $loginscript=(<<ENDLOGINSCRIPT); 119: <script> 120: 121: var authvalues = new Object(); 122: authvalues.names = new Array('krbarg','intarg','fsysarg','locarg'); 123: authvalues.defaults = new Array('MSU.EDU','','',''); 124: 125: function changed_radio(choice,currentform) { 126: var choicearg = choice + 'arg'; 127: if (currentform.elements[choicearg].value == '') { 128: clear(currentform,authvalues.names); 129: for (var i=0; i<authvalues.names.length; i++) { 130: if (authvalues.names[i] == choicearg) { 131: currentform.elements[choicearg].value = authvalues.defaults[i]; 132: } 133: } 134: } 135: } 136: 137: function changed_text(choice,currentform) { 138: var choicearg = choice + 'arg'; 139: if (currentform.elements[choicearg].value !='') { 140: // clear the other values 141: var keep = currentform.elements[choicearg].value; 142: clear(currentform,authvalues.names); 143: currentform.elements[choicearg].value = keep; 144: // validate our value 145: if (choice == 'krb') { 146: currentform.elements[choicearg].value = keep.toUpperCase(); 147: } 148: // check the appropriate checkbox 149: set_checked('login',choice,currentform); 150: } 151: } 152: 153: function clear(currentform,names) { 154: for (var i=0; i< currentform.elements.length; i++) { 155: for (var j = 0; j< names.length; j++) { 156: if (currentform.elements[i].name == names[j]) { 157: currentform.elements[i].value = ''; 158: } 159: } 160: } 161: } 162: 163: function set_checked(name,choice,currentform) { 164: for (var i=0; i< currentform.elements.length; i++) { 165: if (currentform.elements[i].name == name) { 166: if (currentform.elements[i].value == choice) { 167: currentform.elements[i].checked =true; 168: } 169: } 170: } 171: } 172: 173: </script> 174: ENDLOGINSCRIPT 175: $generalrule=<<END; 176: <p> 177: <i>As a general rule, only authors or co-authors should be filesystem 178: authenticated (which allows access to the server filesystem).</i> 179: </p> 180: END 181: } 182: 183: # =================================================================== Phase one 184: 185: sub phase_one { 186: my $r=shift; 187: my $defdom=$ENV{'user.domain'}; 188: $r->print(<<ENDDOCUMENT); 189: <html> 190: <head> 191: <title>The LearningOnline Network with CAPA</title> 192: </head> 193: <body bgcolor="#FFFFFF"> 194: <h1>Create User, Change User Privileges</h1> 195: <form action=/adm/createuser method=post> 196: <input type=hidden name=phase value=two> 197: Username: <input type=text size=15 name=ccuname><br> 198: Domain: <input type=text size=15 name=ccdomain value=$defdom><p> 199: <input type=submit value="Continue"> 200: </form> 201: </body> 202: </html> 203: ENDDOCUMENT 204: } 205: 206: # =================================================================== Phase two 207: sub phase_two { 208: my $r=shift; 209: my $ccuname=$ENV{'form.ccuname'}; 210: my $ccdomain=$ENV{'form.ccdomain'}; 211: 212: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; 213: my $krbdefdom=$1; 214: $krbdefdom=~tr/a-z/A-Z/; 215: 216: my $defdom=$ENV{'user.domain'}; 217: 218: $ccuname=~s/\W//g; 219: $ccdomain=~s/\W//g; 220: my $dochead =<<"ENDDOCHEAD"; 221: <html> 222: <head> 223: <title>The LearningOnline Network with CAPA</title> 224: <script> 225: 226: function pclose() { 227: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms", 228: "height=350,width=350,scrollbars=no,menubar=no"); 229: parmwin.close(); 230: } 231: 232: function pjump(type,dis,value,marker,ret,call) { 233: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type) 234: +"&value="+escape(value)+"&marker="+escape(marker) 235: +"&return="+escape(ret) 236: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms", 237: "height=350,width=350,scrollbars=no,menubar=no"); 238: 239: } 240: 241: function dateset() { 242: eval("document.cu."+document.cu.pres_marker.value+ 243: ".value=document.cu.pres_value.value"); 244: pclose(); 245: } 246: 247: </script> 248: </head> 249: <body bgcolor="#FFFFFF"> 250: <img align="right" src="/adm/lonIcons/lonlogos.gif"> 251: ENDDOCHEAD 252: my $forminfo =<<"ENDFORMINFO"; 253: <form action="/adm/createuser" method="post" name="cu"> 254: <input type="hidden" name="phase" value="three"> 255: <input type="hidden" name="ccuname" value="$ccuname"> 256: <input type="hidden" name="ccdomain" value="$ccdomain"> 257: <input type="hidden" name="pres_value" value="" > 258: <input type="hidden" name="pres_type" value="" > 259: <input type="hidden" name="pres_marker" value="" > 260: ENDFORMINFO 261: my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain); 262: my %incdomains; 263: my %inccourses; 264: my %home_servers = &get_home_servers($ccdomain); 265: foreach (%Apache::lonnet::hostdom) { 266: $incdomains{$_}=1; 267: } 268: foreach (keys(%ENV)) { 269: if ($_=~/^user\.priv\.cm\.\/(\w+)\/(\w+)/) { 270: $inccourses{$1.'_'.$2}=1; 271: } 272: } 273: if ($uhome eq 'no_host') { 274: my $home_server_list= 275: '<option value="default" selected>default</option>'."\n"; 276: foreach (sort keys(%home_servers)) { 277: $home_server_list.= 278: '<option value="'.$_.'">'.$_.' '. 279: $home_servers{$_}."</option>\n"; 280: } 281: $r->print(<<ENDNEWUSER); 282: $dochead 283: <h1>Create New User</h1> 284: $forminfo 285: <h2>New user "$ccuname" in domain $ccdomain</h2> 286: $loginscript 287: <input type='hidden' name='makeuser' value='1' /> 288: <h3>Personal Data</h3> 289: <p> 290: <table> 291: <tr><td>First Name </td> 292: <td><input type='text' name='cfirst' size='15' /></td></tr> 293: <tr><td>Middle Name </td> 294: <td><input type='text' name='cmiddle' size='15' /></td></tr> 295: <tr><td>Last Name </td> 296: <td><input type='text' name='clast' size='15' /></td></tr> 297: <tr><td>Generation </td> 298: <td><input type='text' name='cgen' size='5' /></td></tr> 299: </table> 300: ID/Student Number <input type='text' name='cstid' size='15' /></p> 301: Home Server: <select name="hserver" size="1"> $home_server_list </select> 302: <hr /> 303: <h3>Login Data</h3> 304: $generalrule 305: $authformkrb 306: $authformint 307: $authformfsys 308: $authformloc 309: ENDNEWUSER 310: } else { # user already exists 311: $r->print(<<ENDCHANGEUSER); 312: $dochead 313: <h1>Change User Privileges</h1> 314: $forminfo 315: <h2>User "$ccuname" in domain $ccdomain </h2> 316: ENDCHANGEUSER 317: # Get the users information 318: my %userenv = &Apache::lonnet::get('environment', 319: ['firstname','middlename','lastname','generation'], 320: $ccdomain,$ccuname); 321: my %rolesdump=&Apache::lonnet::dump('roles',$ccdomain,$ccuname); 322: $r->print(<<END); 323: <hr /> 324: <table border="2"> 325: <tr> 326: <th>first name</th><th>middle name</th><th>last name</th><th>generation</th> 327: </tr> 328: <tr> 329: END 330: foreach ('firstname','middlename','lastname','generation') { 331: if (&Apache::lonnet::allowed('mau',$ccdomain)) { 332: $r->print(<<"END"); 333: <td><input type="text" name="c$_" value="$userenv{$_}" size="15"/></td> 334: END 335: } else { 336: $r->print('<td>'.$userenv{$_}.'</td>'); 337: } 338: } 339: $r->print(<<END); 340: </tr> 341: </table> 342: END 343: # Build up table of user roles to allow revocation of a role. 344: my ($tmp) = keys(%rolesdump); 345: unless ($tmp =~ /^(con_lost|error)/i) { 346: my $now=time; 347: $r->print('<hr /><h3>Revoke Existing Roles</h3>'. 348: '<table border=2><tr><th>Revoke</th><th>Role</th><th>Extent</th>'. 349: '<th>Start</th><th>End</th>'); 350: foreach my $area (keys(%rolesdump)) { 351: if ($area!~/^rolesdef/) { 352: my $role = $rolesdump{$area}; 353: my $thisrole=$area; 354: $area=~s/\_\w\w$//; 355: my ($role_code,$role_end_time,$role_start_time) = 356: split(/_/,$role); 357: my $bgcol='ffffff'; 358: my $allows=0; 359: if ($area=~/^\/(\w+)\/(\d\w+)/) { 360: my %coursedata= 361: &Apache::lonnet::coursedescription($1.'_'.$2); 362: my $carea='Course: '.$coursedata{'description'}; 363: $inccourses{$1.'_'.$2}=1; 364: if (&Apache::lonnet::allowed('c'.$role_code,$1.'/'.$2)) { 365: $allows=1; 366: } 367: # Compute the background color based on $area 368: $bgcol=$1.'_'.$2; 369: $bgcol=~s/[^8-9b-e]//g; 370: $bgcol=substr($bgcol.$bgcol.$bgcol.'ffffff',0,6); 371: if ($area=~/^\/(\w+)\/(\d\w+)\/(\w+)/) { 372: $carea.='<br>Section/Group: '.$3; 373: } 374: $area=$carea; 375: } else { 376: # Determine if current user is able to revoke privileges 377: if ($area=~/^\/(\w+)\//) { 378: if (&Apache::lonnet::allowed('c'.$role_code,$1)) { 379: $allows=1; 380: } 381: } else { 382: if (&Apache::lonnet::allowed('c'.$role_code,'/')) { 383: $allows=1; 384: } 385: } 386: } 387: $r->print('<tr bgcolor=#"'.$bgcol.'"><td>'); 388: my $active=1; 389: $active=0 if (($role_end_time) && ($now>$role_end_time)); 390: if (($active) && ($allows)) { 391: $r->print('<input type="checkbox" name="rev:' 392: .$thisrole.'">'); 393: } else { 394: $r->print(' '); 395: } 396: $r->print('</td><td>'. 397: &Apache::lonnet::plaintext($role_code). 398: '</td><td>'.$area.'</td><td>'. 399: ($role_start_time ? localtime($role_start_time) 400: : ' ' ) 401: .'</td><td>'. 402: ($role_end_time ? localtime($role_end_time) 403: : ' ' ) 404: ."</td></tr>\n"); 405: } 406: } # end of foreach (table building loop) 407: $r->print('</table>'); 408: } # End of unless 409: my $currentauth=&Apache::lonnet::queryauthenticate($ccuname,$ccdomain); 410: if ($currentauth=~/^krb4:/) { 411: $currentauth=~/^krb4:(.*)/; 412: my $krbdefdom2=$1; 413: $loginscript=~s/vf\.krbdom\.value='.*?';/vf.krbdom.value='$krbdefdom2';/; 414: } 415: # Check for a bad authentication type 416: unless ($currentauth=~/^krb4:/ or 417: $currentauth=~/^unix:/ or 418: $currentauth=~/^internal:/ or 419: $currentauth=~/^localauth:/ 420: ) { # bad authentication scheme 421: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 422: $r->print(<<ENDBADAUTH); 423: <hr /> 424: $loginscript 425: <font color='#ff0000'>ERROR:</font> 426: This user has an unrecognized authentication scheme ($currentauth). 427: Please specify login data below. 428: <h3>Login Data</h3> 429: $generalrule 430: $authformkrb 431: $authformint 432: $authformfsys 433: $authformloc 434: ENDBADAUTH 435: } else { 436: # This user is not allowed to modify the users 437: # authentication scheme, so just notify them of the problem 438: $r->print(<<ENDBADAUTH); 439: <hr /> 440: $loginscript 441: <font color="#ff0000"> ERROR: </font> 442: This user has an unrecognized authentication scheme ($currentauth). 443: Please alert a domain coordinator of this situation. 444: <hr /> 445: ENDBADAUTH 446: } 447: } else { # Authentication type is valid 448: my $authformcurrent=''; 449: my $authform_other=''; 450: if ($currentauth=~/^krb4:/) { 451: $authformcurrent=$authformkrb; 452: $authform_other=$authformint.$authformfsys.$authformloc; 453: # embarrassing script hack here 454: $loginscript=~s/login\[3\]/login\[4\]/; # loc 455: $loginscript=~s/login\[2\]/login\[3\]/; # fsys 456: $loginscript=~s/login\[1\]/login\[2\]/; # int 457: $loginscript=~s/login\[0\]/login\[1\]/; # krb4 458: } 459: elsif ($currentauth=~/^internal:/) { 460: $authformcurrent=$authformint; 461: $authform_other=$authformkrb.$authformfsys.$authformloc; 462: # embarrassing script hack here 463: $loginscript=~s/login\[3\]/login\[4\]/; # loc 464: $loginscript=~s/login\[2\]/login\[3\]/; # fsys 465: $loginscript=~s/login\[1\]/login\[1\]/; # int 466: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 467: } 468: elsif ($currentauth=~/^unix:/) { 469: $authformcurrent=$authformfsys; 470: $authform_other=$authformkrb.$authformint.$authformloc; 471: # embarrassing script hack here 472: $loginscript=~s/login\[3\]/login\[4\]/; # loc 473: $loginscript=~s/login\[1\]/login\[3\]/; # int 474: $loginscript=~s/login\[2\]/login\[1\]/; # fsys 475: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 476: } 477: elsif ($currentauth=~/^localauth:/) { 478: $authformcurrent=$authformloc; 479: $authform_other=$authformkrb.$authformint.$authformfsys; 480: # embarrassing script hack here 481: $loginscript=~s/login\[3\]/login\[loc\]/; # loc 482: $loginscript=~s/login\[2\]/login\[4\]/; # fsys 483: $loginscript=~s/login\[1\]/login\[3\]/; # int 484: $loginscript=~s/login\[0\]/login\[2\]/; # krb4 485: $loginscript=~s/login\[loc\]/login\[1\]/; # loc 486: } 487: $authformcurrent=<<ENDCURRENTAUTH; 488: <table border='1'> 489: <tr> 490: <td><font color='#ff0000'>* * * WARNING * * *</font></td> 491: <td><font color='#ff0000'>* * * WARNING * * *</font></td> 492: </tr> 493: <tr><td bgcolor='#cbbcbb'>$authformcurrent</td> 494: <td bgcolor='#cbbcbb'>Changing this value will overwrite existing authentication for the user; you should notify the user of this change.</td></tr> 495: </table> 496: ENDCURRENTAUTH 497: if (&Apache::lonnet::allowed('mau',$ENV{'user.domain'})) { 498: # Current user has login modification privileges 499: $r->print(<<ENDOTHERAUTHS); 500: <hr /> 501: $loginscript 502: <h3>Change Current Login Data</h3> 503: $generalrule 504: $authformnop 505: $authformcurrent 506: <h3>Enter New Login Data</h3> 507: $authform_other 508: ENDOTHERAUTHS 509: } 510: } ## End of "check for bad authentication type" logic 511: } ## End of new user/old user logic 512: $r->print('<hr /><h3>Add Roles</h3>'); 513: # 514: # Co-Author 515: # 516: 517: if (&Apache::lonnet::allowed('cca',$ENV{'user.domain'})) { 518: my $cuname=$ENV{'user.name'}; 519: my $cudom=$ENV{'user.domain'}; 520: $r->print(<<ENDCOAUTH); 521: <h4>Construction Space</h4> 522: <table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th> 523: <th>Start</th><th>End</th></tr> 524: <tr> 525: <td><input type=checkbox name="act_$cudom\_$cuname\_ca"></td> 526: <td>Co-Author</td> 527: <td>$cudom\_$cuname</td> 528: <td><input type=hidden name="start_$cudom\_$cuname\_ca" value=''> 529: <a href= 530: "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> 531: <td><input type=hidden name="end_$cudom\_$cuname\_ca" value=''> 532: <a href= 533: "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> 534: </tr> 535: </table> 536: ENDCOAUTH 537: } 538: # 539: # Domain level 540: # 541: $r->print('<h4>Domain Level</h4>'. 542: '<table border=2><tr><th>Activate</th><th>Role</th><th>Extent</th>'. 543: '<th>Start</th><th>End</th></tr>'); 544: foreach ( sort( keys(%incdomains))) { 545: my $thisdomain=$_; 546: foreach ('dc','li','dg','au') { 547: if (&Apache::lonnet::allowed('c'.$_,$thisdomain)) { 548: my $plrole=&Apache::lonnet::plaintext($_); 549: $r->print(<<ENDDROW); 550: <tr> 551: <td><input type=checkbox name="act_$thisdomain\_$_"></td> 552: <td>$plrole</td> 553: <td>$thisdomain</td> 554: <td><input type=hidden name="start_$thisdomain\_$_" value=''> 555: <a href= 556: "javascript:pjump('date_start','Start Date $plrole',document.cu.start_$thisdomain\_$_.value,'start_$thisdomain\_$_','cu.pres','dateset')">Set Start Date</a></td> 557: <td><input type=hidden name="end_$thisdomain\_$_" value=''> 558: <a href= 559: "javascript:pjump('date_end','End Date $plrole',document.cu.end_$thisdomain\_$_.value,'end_$thisdomain\_$_','cu.pres','dateset')">Set End Date</a></td> 560: </tr> 561: ENDDROW 562: } 563: } 564: } 565: $r->print('</table>'); 566: # 567: # Course level 568: # 569: $r->print(&course_level_table(%inccourses)); 570: $r->print("<hr /><input type=submit value=\"Modify User\">\n"); 571: $r->print("</form></body></html>"); 572: } 573: 574: # ================================================================= Phase Three 575: sub phase_three { 576: my $r=shift; 577: my $uhome=&Apache::lonnet::homeserver($ENV{'form.ccuname'}, 578: $ENV{'form.ccdomain'}); 579: # Error messages 580: my $error = '<font color="#ff0000">Error:</font>'; 581: my $end = '</body></html>'; 582: # Print header 583: $r->print(<<ENDTHREEHEAD); 584: <html> 585: <head> 586: <title>The LearningOnline Network with CAPA</title> 587: </head> 588: <body bgcolor="#FFFFFF"> 589: <img align="right" src="/adm/lonIcons/lonlogos.gif"> 590: ENDTHREEHEAD 591: # Check Inputs 592: if (! $ENV{'form.ccuname'} ) { 593: $r->print($error.'No login name specified.'.$end); 594: return; 595: } 596: if ( $ENV{'form.ccuname'} =~/\W/) { 597: $r->print($error.'Invalid login name. '. 598: 'Only letters, numbers, and underscores are valid.'. 599: $end); 600: return; 601: } 602: if (! $ENV{'form.ccdomain'} ) { 603: $r->print($error.'No domain specified.'.$end); 604: return; 605: } 606: if ( $ENV{'form.ccdomain'} =~/\W/) { 607: $r->print($error.'Invalid domain name. '. 608: 'Only letters, numbers, and underscores are valid.'. 609: $end); 610: return; 611: } 612: if (! exists($ENV{'form.makeuser'})) { 613: # Modifying an existing user, so check the validity of the name 614: if ($uhome eq 'no_host') { 615: $r->print($error.'Unable to determine home server for '. 616: $ENV{'form.ccuname'}.' in domain '. 617: $ENV{'form.ccdomain'}.'.'); 618: return; 619: } 620: } 621: # Determine authentication method and password for the user being modified 622: my $amode=''; 623: my $genpwd=''; 624: if ($ENV{'form.login'} eq 'krb') { 625: $amode='krb4'; 626: $genpwd=$ENV{'form.krbarg'}; 627: } elsif ($ENV{'form.login'} eq 'int') { 628: $amode='internal'; 629: $genpwd=$ENV{'form.intarg'}; 630: } elsif ($ENV{'form.login'} eq 'fsys') { 631: $amode='unix'; 632: $genpwd=$ENV{'form.fsysarg'}; 633: } elsif ($ENV{'form.login'} eq 'loc') { 634: $amode='localauth'; 635: $genpwd=$ENV{'form.locarg'}; 636: $genpwd=" " if (!$genpwd); 637: } else { 638: $r->print($error.'Invalid login mode or password'.$end); 639: return; 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: