loncom/interface/loncreateuser.pm - view

File: [LON-CAPA] / loncom / interface / loncreateuser.pm
Revision 1.32: download - view: text, annotated - select for diffs
Mon Apr 22 18:04:19 2002 UTC (22 years, 1 month ago) by matthew
Branches: MAIN
CVS tags: HEAD

Moved home server list generating code to loncommon from loncreateuser.

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