loncom/interface/loncreateuser.pm - view

File: [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.44: download - view: text, annotated - select for diffs
Mon Nov 18 20:06:53 2002 UTC (21 years, 6 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Fixed a "bug" which allowed the user to assign co-author privileges to
themselves.

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