loncom/interface/loncreateuser.pm - view

File: [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.42: download - view: text, annotated - select for diffs
Fri Aug 23 19:43:11 2002 UTC (21 years, 9 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Changes to attempt fix for bug 263.

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