loncom/auth/lonroles.pm - view

File: [LON-CAPA] / loncom / auth / lonroles.pm
Revision 1.210: download - view: text, annotated - select for diffs
Wed Nov 12 20:01:09 2008 UTC (15 years, 6 months ago) by jms
Branches: MAIN
CVS tags: HEAD

Added/modified POD documentation

1: # The LearningOnline Network with CAPA 2: # User Roles Screen 3: # 4: # $Id: lonroles.pm,v 1.210 2008/11/12 20:01:09 jms 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: ### 29: 30: =pod 31: 32: =head1 NAME 33: 34: Apache::lonroles - User Roles Screen 35: 36: =head1 SYNOPSIS 37: 38: Invoked by /etc/httpd/conf/srm.conf: 39: 40: <Location /adm/roles> 41: PerlAccessHandler Apache::lonacc 42: SetHandler perl-script 43: PerlHandler Apache::lonroles 44: ErrorDocument 403 /adm/login 45: ErrorDocument 500 /adm/errorhandler 46: </Location> 47: 48: =head1 OVERVIEW 49: 50: =head2 Choosing Roles 51: 52: C<lonroles> is a handler that allows a user to switch roles in 53: mid-session. LON-CAPA attempts to work with "No Role Specified", the 54: default role that a user has before selecting a role, as widely as 55: possible, but certain handlers for example need specification which 56: course they should act on, etc. Both in this scenario, and when the 57: handler determines via C<lonnet>'s C<&allowed> function that a certain 58: action is not allowed, C<lonroles> is used as error handler. This 59: allows the user to select another role which may have permission to do 60: what they were trying to do. C<lonroles> can also be accessed via the 61: B<CRS> button in the Remote Control. 62: 63: =begin latex 64: 65: \begin{figure} 66: \begin{center} 67: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen} 68: \caption{\label{Sample_Roles_Screen}Sample Roles Screen} 69: \end{center} 70: \end{figure} 71: 72: =end latex 73: 74: =head2 Role Initialization 75: 76: The privileges for a user are established at login time and stored in the session environment. As a consequence, a new role does not become active till the next login. Handlers are able to query for privileges using C<lonnet>'s C<&allowed> function. When a user first logs in, their role is the "common" role, which means that they have the sum of all of their privileges. During a session it might become necessary to choose a particular role, which as a consequence also limits the user to only the privileges in that particular role. 77: 78: =head1 INTRODUCTION 79: 80: This module enables a user to select what role he wishes to 81: operate under (instructor, student, teaching assistant, course 82: coordinator, etc). These roles are pre-established by the actions 83: of upper-level users. 84: 85: This is part of the LearningOnline Network with CAPA project 86: described at http://www.lon-capa.org. 87: 88: =head1 HANDLER SUBROUTINE 89: 90: This routine is called by Apache and mod_perl. 91: 92: =over 4 93: 94: =item * 95: 96: Roles Initialization (yes/no) 97: 98: =item * 99: 100: Get Error Message from Environment 101: 102: =item * 103: 104: Who is this? 105: 106: =item * 107: 108: Generate Page Output 109: 110: =item * 111: 112: Choice or no choice 113: 114: =item * 115: 116: Table 117: 118: =item * 119: 120: Privileges 121: 122: =back 123: 124: =cut 125: 126: 127: package Apache::lonroles; 128: 129: use strict; 130: use Apache::lonnet; 131: use Apache::lonuserstate(); 132: use Apache::Constants qw(:common); 133: use Apache::File(); 134: use Apache::lonmenu; 135: use Apache::loncommon; 136: use Apache::lonhtmlcommon; 137: use Apache::lonannounce; 138: use Apache::lonlocal; 139: use Apache::lonpageflip(); 140: use Apache::lonnavdisplay(); 141: use GDBM_File; 142: use LONCAPA qw(:DEFAULT :match); 143: use HTML::Entities; 144: 145: 146: sub redirect_user { 147: my ($r,$title,$url,$msg,$launch_nav) = @_; 148: $msg = $title if (! defined($msg)); 149: &Apache::loncommon::content_type($r,'text/html'); 150: &Apache::loncommon::no_cache($r); 151: $r->send_http_header; 152: my $swinfo=&Apache::lonmenu::rawconfig(); 153: my $navwindow; 154: if ($launch_nav eq 'on') { 155: $navwindow.=&Apache::lonnavdisplay::launch_win('now',undef,undef, 156: ($url =~ m-^/adm/whatsnew-)); 157: } else { 158: $navwindow.=&Apache::lonnavmaps::close(); 159: } 160: my $start_page = &Apache::loncommon::start_page('Switching Role',undef, 161: {'redirect' => [1,$url],}); 162: my $end_page = &Apache::loncommon::end_page(); 163: 164: # Note to style police: 165: # This must only replace the spaces, nothing else, or it bombs elsewhere. 166: $url=~s/ /\%20/g; 167: $r->print(<<ENDREDIR); 168: $start_page 169: <script type="text/javascript"> 170: $swinfo 171: </script> 172: $navwindow 173: <h1>$msg</h1> 174: $end_page 175: ENDREDIR 176: return; 177: } 178: 179: sub error_page { 180: my ($r,$error,$dest)=@_; 181: &Apache::loncommon::content_type($r,'text/html'); 182: &Apache::loncommon::no_cache($r); 183: $r->send_http_header; 184: return OK if $r->header_only; 185: $r->print(&Apache::loncommon::start_page('Problems during Course Initialization'). 186: '<script type="text/javascript">'. 187: &Apache::lonmenu::rawconfig().'</script>'. 188: '<p>'.&mt('The following problems occurred:'). 189: $error. 190: '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'. 191: &Apache::loncommon::end_page()); 192: } 193: 194: sub handler { 195: 196: my $r = shift; 197: 198: my $now=time; 199: my $then=$env{'user.login.time'}; 200: my $envkey; 201: my %dcroles = (); 202: my $numdc = &check_fordc(\%dcroles,$then); 203: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); 204: 205: # ================================================================== Roles Init 206: if ($env{'form.selectrole'}) { 207: 208: my $locknum=&Apache::lonnet::get_locks(); 209: if ($locknum) { return 409; } 210: 211: if ($env{'form.newrole'}) { 212: $env{'form.'.$env{'form.newrole'}}=1; 213: } 214: if ($env{'request.course.id'}) { 215: # Check if user is CC trying to select a course role 216: if ($env{'form.switchrole'}) { 217: if (!defined($env{'user.role.'.$env{'form.switchrole'}})) { 218: &adhoc_course_role($then); 219: } 220: } 221: my %temp=('logout_'.$env{'request.course.id'} => time); 222: &Apache::lonnet::put('email_status',\%temp); 223: &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'}); 224: } 225: &Apache::lonnet::appenv({"request.course.id" => '', 226: "request.course.fn" => '', 227: "request.course.uri" => '', 228: "request.course.sec" => '', 229: "request.role" => 'cm', 230: "request.role.adv" => $env{'user.adv'}, 231: "request.role.domain" => $env{'user.domain'}}); 232: # Check if user is a DC trying to enter a course or author space and needs privs to be created 233: if ($numdc > 0) { 234: foreach my $envkey (keys %env) { 235: # Is this an ad-hoc CC-role? 236: if (my ($domain,$coursenum) = 237: ($envkey =~ m-^form\.cc\./($match_domain)/($match_courseid)$-)) { 238: if ($dcroles{$domain}) { 239: &check_privs($domain,$coursenum,$then,$now,'cc'); 240: } 241: last; 242: } 243: # Is this an ad-hoc CA-role? 244: if (my ($domain,$user) = 245: ($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) { 246: if (($domain eq $env{'user.domain'}) && ($user eq $env{'user.name'})) { 247: delete($env{$envkey}); 248: $env{'form.au./'.$domain.'/'} = 1; 249: my ($server_status,$home) = &check_author_homeserver($user,$domain); 250: if ($server_status eq 'switchserver') { 251: my $trolecode = 'au./'.$domain.'/'; 252: my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode; 253: $r->internal_redirect($switchserver); 254: } 255: last; 256: } 257: if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) { 258: if (((($castart) && ($castart < $now)) || !$castart) && 259: ((!$caend) || (($caend) && ($caend > $now)))) { 260: my ($server_status,$home) = &check_author_homeserver($user,$domain); 261: if ($server_status eq 'switchserver') { 262: my $trolecode = 'ca./'.$domain.'/'.$user; 263: my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode; 264: $r->internal_redirect($switchserver); 265: } 266: last; 267: } 268: } 269: # Check if author blocked ca-access 270: my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user); 271: if ($blocked{'domcoord.author'} eq 'blocked') { 272: delete($env{$envkey}); 273: $env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access'; 274: last; 275: } 276: if ($dcroles{$domain}) { 277: my ($server_status,$home) = &check_author_homeserver($user,$domain); 278: if (($server_status eq 'ok') || ($server_status eq 'switchserver')) { 279: &check_privs($domain,$user,$then,$now,'ca'); 280: if ($server_status eq 'switchserver') { 281: my $trolecode = 'ca./'.$domain.'/'.$user; 282: my $switchserver = '/adm/switchserver?' 283: .'otherserver='.$home.'&role='.$trolecode; 284: $r->internal_redirect($switchserver); 285: } 286: } else { 287: delete($env{$envkey}); 288: } 289: } else { 290: delete($env{$envkey}); 291: } 292: last; 293: } 294: } 295: } 296: 297: foreach $envkey (keys %env) { 298: next if ($envkey!~/^user\.role\./); 299: my ($where,$trolecode,$role,$tstatus,$tend,$tstart); 300: &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); 301: if ($env{'form.'.$trolecode}) { 302: if ($tstatus eq 'is') { 303: $where=~s/^\///; 304: my ($cdom,$cnum,$csec)=split(/\//,$where); 305: # check for course groups 306: my %coursegroups = &Apache::lonnet::get_active_groups( 307: $env{'user.domain'},$env{'user.name'},$cdom, $cnum); 308: my $cgrps = join(':',keys(%coursegroups)); 309: 310: # store role if recent_role list being kept 311: if ($env{'environment.recentroles'}) { 312: my %frozen_roles = 313: &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'}); 314: &Apache::lonhtmlcommon::store_recent('roles', 315: $trolecode,' ',$frozen_roles{$trolecode}); 316: } 317: 318: 319: # check for keyed access 320: if (($role eq 'st') && 321: ($env{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) { 322: # who is key authority? 323: my $authdom=$cdom; 324: my $authnum=$cnum; 325: if ($env{'course.'.$cdom.'_'.$cnum.'.keyauth'}) { 326: ($authnum,$authdom)= 327: split(/:/,$env{'course.'.$cdom.'_'.$cnum.'.keyauth'}); 328: } 329: # check with key authority 330: unless (&Apache::lonnet::validate_access_key( 331: $env{'environment.key.'.$cdom.'_'.$cnum}, 332: $authdom,$authnum)) { 333: # there is no valid key 334: if ($env{'form.newkey'}) { 335: # student attempts to register a new key 336: &Apache::loncommon::content_type($r,'text/html'); 337: &Apache::loncommon::no_cache($r); 338: $r->send_http_header; 339: my $swinfo=&Apache::lonmenu::rawconfig(); 340: my $start_page=&Apache::loncommon::start_page 341: ('Verifying Access Key to Unlock this Course'); 342: my $end_page=&Apache::loncommon::end_page(); 343: my $buttontext=&mt('Enter Course'); 344: my $message=&mt('Successfully registered key'); 345: my $assignresult= 346: &Apache::lonnet::assign_access_key( 347: $env{'form.newkey'}, 348: $authdom,$authnum, 349: $cdom,$cnum, 350: $env{'user.domain'}, 351: $env{'user.name'}, 352: &mt('Assigned from [_1] at [_2] for [_3]' 353: ,$ENV{'REMOTE_ADDR'} 354: ,&Apache::lonlocal::locallocaltime() 355: ,$trolecode) 356: ); 357: unless ($assignresult eq 'ok') { 358: $assignresult=~s/^error\:\s*//; 359: $message=&mt($assignresult). 360: '<br /><a href="/adm/logout">'. 361: &mt('Logout').'</a>'; 362: $buttontext=&mt('Re-Enter Key'); 363: } 364: $r->print(<<ENDENTEREDKEY); 365: $start_page 366: <script type="text/javascript"> 367: $swinfo 368: </script> 369: <form method="post"> 370: <input type="hidden" name="selectrole" value="1" /> 371: <input type="hidden" name="$trolecode" value="1" /> 372: <font size="+2">$message</font><br /> 373: <input type="submit" value="$buttontext" /> 374: </form> 375: $end_page 376: ENDENTEREDKEY 377: return OK; 378: } else { 379: # print form to enter a new key 380: &Apache::loncommon::content_type($r,'text/html'); 381: &Apache::loncommon::no_cache($r); 382: $r->send_http_header; 383: my $swinfo=&Apache::lonmenu::rawconfig(); 384: my $start_page=&Apache::loncommon::start_page 385: ('Enter Access Key to Unlock this Course'); 386: my $end_page=&Apache::loncommon::end_page(); 387: $r->print(<<ENDENTERKEY); 388: $start_page 389: <script type="text/javascript"> 390: $swinfo 391: </script> 392: <form method="post"> 393: <input type="hidden" name="selectrole" value="1" /> 394: <input type="hidden" name="$trolecode" value="1" /> 395: <input type="text" size="20" name="newkey" value="$env{'form.newkey'}" /> 396: <input type="submit" value="Enter key" /> 397: </form> 398: $end_page 399: ENDENTERKEY 400: return OK; 401: } 402: } 403: } 404: &Apache::lonnet::log($env{'user.domain'}, 405: $env{'user.name'}, 406: $env{'user.home'}, 407: "Role ".$trolecode); 408: 409: &Apache::lonnet::appenv( 410: {'request.role' => $trolecode, 411: 'request.role.domain' => $cdom, 412: 'request.course.sec' => $csec, 413: 'request.course.groups' => $cgrps}); 414: my $tadv=0; 415: 416: if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) { 417: my $msg; 418: my ($furl,$ferr)= 419: &Apache::lonuserstate::readmap($cdom.'/'.$cnum); 420: if (($env{'form.orgurl'}) && 421: ($env{'form.orgurl'}!~/^\/adm\/flip/)) { 422: my $dest=$env{'form.orgurl'}; 423: if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; } 424: &Apache::lonnet::appenv({'request.role.adv'=>$tadv}); 425: if (($ferr) && ($tadv)) { 426: &error_page($r,$ferr,$dest); 427: } else { 428: $r->internal_redirect($dest); 429: } 430: return OK; 431: } else { 432: if (!$env{'request.course.id'}) { 433: &Apache::lonnet::appenv( 434: {"request.course.id" => $cdom.'_'.$cnum}); 435: $furl='/adm/roles?tryagain=1'; 436: $msg= 437: '<h1><span class="LC_error">'. 438: &mt('Could not initialize [_1] at this time.', 439: $env{'course.'.$cdom.'_'.$cnum.'.description'}). 440: '</span></h1><h3>'.&mt('Please try again.').'</h3>'.$ferr; 441: } 442: if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; } 443: &Apache::lonnet::appenv({'request.role.adv'=>$tadv}); 444: 445: if (($ferr) && ($tadv)) { 446: &error_page($r,$ferr,$furl); 447: } else { 448: # Check to see if the user is a CC entering a course 449: # for the first time 450: my (undef, undef, $role, $courseid) = split(/\./, $envkey); 451: if (substr($courseid, 0, 1) eq '/') { 452: $courseid = substr($courseid, 1); 453: } 454: $courseid =~ s/\//_/; 455: if ($role eq 'cc' && $env{'course.' . $courseid . 456: '.course.helper.not.run'}) { 457: $furl = "/adm/helper/course.initialization.helper"; 458: # Send the user to the course they selected 459: } elsif ($env{'request.course.id'}) { 460: if ($env{'form.destinationurl'}) { 461: my $dest = $env{'form.destinationurl'}; 462: if ($env{'form.destsymb'} ne '') { 463: my $esc_symb = &HTML::Entities::encode($env{'form.destsymb'},'"<>&'); 464: $dest .= '?symb='.$esc_symb; 465: } 466: &redirect_user($r,&mt('Entering [_1]', 467: $env{'course.'.$courseid.'.description'}), 468: $dest,$msg, 469: $env{'environment.remotenavmap'}); 470: return OK; 471: } 472: if (&Apache::lonnet::allowed('whn', 473: $env{'request.course.id'}) 474: || &Apache::lonnet::allowed('whn', 475: $env{'request.course.id'}.'/' 476: .$env{'request.course.sec'}) 477: ) { 478: my $startpage = &courseloadpage($courseid); 479: unless ($startpage eq 'firstres') { 480: $msg = &mt('Entering [_1] ...', 481: $env{'course.'.$courseid.'.description'}); 482: &redirect_user($r,&mt('New in course'), 483: '/adm/whatsnew?refpage=start',$msg, 484: $env{'environment.remotenavmap'}); 485: return OK; 486: } 487: } 488: } 489: # Are we allowed to look at the first resource? 490: if ($furl !~ m|^/adm/|) { 491: # Guess not ... 492: $furl=&Apache::lonpageflip::first_accessible_resource(); 493: } 494: $msg = &mt('Entering [_1] ...', 495: $env{'course.'.$courseid.'.description'}); 496: &redirect_user($r,&mt('Entering [_1]', 497: $env{'course.'.$courseid.'.description'}), 498: $furl,$msg, 499: $env{'environment.remotenavmap'}); 500: } 501: return OK; 502: } 503: } 504: # 505: # Send the user to the construction space they selected 506: if ($role =~ /^(au|ca|aa)$/) { 507: my $redirect_url = '/priv/'; 508: if ($role eq 'au') { 509: $redirect_url.=$env{'user.name'}; 510: } else { 511: $where =~ /\/(.*)$/; 512: $redirect_url .= $1; 513: } 514: $redirect_url .= '/'; 515: &redirect_user($r,&mt('Entering Construction Space'), 516: $redirect_url); 517: return OK; 518: } 519: if ($role eq 'dc') { 520: my $redirect_url = '/adm/menu/'; 521: &redirect_user($r,&mt('Loading Domain Coordinator Menu'), 522: $redirect_url); 523: return OK; 524: } 525: } 526: } 527: } 528: } 529: 530: 531: # =============================================================== No Roles Init 532: 533: &Apache::loncommon::content_type($r,'text/html'); 534: &Apache::loncommon::no_cache($r); 535: $r->send_http_header; 536: return OK if $r->header_only; 537: 538: my $swinfo=&Apache::lonmenu::rawconfig(); 539: my $start_page=&Apache::loncommon::start_page('User Roles'); 540: my $standby=&mt('Role selected. Please stand by.'); 541: $standby=~s/\n/\\n/g; 542: my $noscript='<span class="LC_error">'.&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.').'<br />'.&mt('As this is not the case, most functionality in the system will be unavailable.').'</span><br />'; 543: 544: $r->print(<<ENDHEADER); 545: $start_page 546: <br /> 547: <noscript> 548: $noscript 549: </noscript> 550: <script type="text/javascript"> 551: $swinfo 552: window.focus(); 553: 554: active=true; 555: 556: function enterrole (thisform,rolecode,buttonname) { 557: if (active) { 558: active=false; 559: document.title='$standby'; 560: window.status='$standby'; 561: thisform.newrole.value=rolecode; 562: thisform.submit(); 563: } else { 564: alert('$standby'); 565: } 566: } 567: </script> 568: ENDHEADER 569: 570: # ------------------------------------------ Get Error Message from Environment 571: 572: my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$env{'user.error.msg'}); 573: if ($env{'user.error.msg'}) { 574: $r->log_reason( 575: "$msg for $env{'user.name'} domain $env{'user.domain'} access $priv",$fn); 576: } 577: 578: # ------------------------------------------------- Can this user re-init, etc? 579: 580: my $advanced=$env{'user.adv'}; 581: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['tryagain']); 582: my $tryagain=$env{'form.tryagain'}; 583: my $reinit=$env{'user.reinit'}; 584: delete $env{'user.reinit'}; 585: 586: # -------------------------------------------------------- Generate Page Output 587: # --------------------------------------------------------------- Error Header? 588: if ($error) { 589: $r->print("<h1>".&mt('LON-CAPA Access Control')."</h1>"); 590: $r->print("<hr /><pre>"); 591: if ($priv ne '') { 592: $r->print(&mt('Access : ').&Apache::lonnet::plaintext($priv)."\n"); 593: } 594: if ($fn ne '') { 595: $r->print(&mt('Resource: ').&Apache::lonenc::check_encrypt($fn)."\n"); 596: } 597: if ($msg ne '') { 598: $r->print(&mt('Action : ').$msg."\n"); 599: } 600: $r->print("</pre><hr />"); 601: my $url=$fn; 602: my $last; 603: if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', 604: &GDBM_READER(),0640)) { 605: $last=$hash{'last_known'}; 606: untie(%hash); 607: } 608: if ($last) { $fn.='?symb='.&escape($last); } 609: 610: &Apache::londocs::changewarning($r,undef,'You have modified your course recently, [_1] may fix this access problem.', 611: &Apache::lonenc::check_encrypt($fn)); 612: } else { 613: if ($env{'user.error.msg'}) { 614: if ($reinit) { 615: $r->print( 616: '<h3><span class="LC_error">'. 617: &mt('As your session file for the course has expired, you will need to re-select the course.').'</span></h3>'); 618: } else { 619: $r->print( 620: '<h3><span class="LC_error">'. 621: &mt('You need to choose another user role or enter a specific course for this function').'</span></h3>'); 622: } 623: } 624: } 625: # -------------------------------------------------------- Choice or no choice? 626: if ($nochoose) { 627: $r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>". 628: &mt('This action is currently not authorized.').'</span>'. 629: &Apache::loncommon::end_page()); 630: return OK; 631: } else { 632: if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) { 633: $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'}; 634: } 635: $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">'); 636: $r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />'); 637: $r->print('<input type="hidden" name="selectrole" value="1" />'); 638: $r->print('<input type="hidden" name="newrole" value="" />'); 639: } 640: my (%roletext,%sortrole,%roleclass); 641: my $countactive=0; 642: my $countfuture=0; 643: my $countwill=0; 644: my $inrole=0; 645: my $possiblerole=''; 646: my %futureroles; 647: my %roles_nextlogin; 648: foreach $envkey (sort keys %env) { 649: my $button = 1; 650: my $switchserver=''; 651: my $roletext; 652: my $sortkey; 653: if ($envkey=~/^user\.role\./) { 654: my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont); 655: &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); 656: next if (!defined($role) || $role eq '' || $role =~ /^gr/); 657: $tremark=''; 658: $tpstart=' '; 659: $tpend=' '; 660: $tfont='#000000'; 661: if ($tstart) { 662: $tpstart=&Apache::lonlocal::locallocaltime($tstart); 663: } 664: if ($tend) { 665: $tpend=&Apache::lonlocal::locallocaltime($tend); 666: } 667: if ($env{'request.role'} eq $trolecode) { 668: $tstatus='selected'; 669: } 670: my $tbg; 671: if (($tstatus eq 'is') 672: || ($tstatus eq 'selected') 673: || ($tstatus eq 'will') 674: || ($tstatus eq 'future') 675: || ($env{'form.showall'})) { 676: if ($tstatus eq 'is') { 677: $tbg='#77FF77'; 678: $tfont='#003300'; 679: $possiblerole=$trolecode; 680: $countactive++; 681: } elsif ($tstatus eq 'future') { 682: $tbg='#FFFF77'; 683: $button=0; 684: $futureroles{$trolecode} = $tstart.':'.$tend; 685: $countfuture ++; 686: } elsif ($tstatus eq 'will') { 687: $tbg='#FFAA77'; 688: $tremark.=&mt('Active at next login.').' '; 689: $roles_nextlogin{$trolecode} = $tstart.':'.$tend; 690: $countwill ++; 691: } elsif ($tstatus eq 'expired') { 692: $tbg='#FF7777'; 693: $tfont='#330000'; 694: $button=0; 695: } elsif ($tstatus eq 'will_not') { 696: $tbg='#AAFF77'; 697: $tremark.=&mt('Expired after logout.').' '; 698: } elsif ($tstatus eq 'selected') { 699: $tbg='#11CC55'; 700: $tfont='#002200'; 701: $inrole=1; 702: $countactive++; 703: $tremark.=&mt('Currently selected.').' '; 704: } 705: my $trole; 706: if ($role =~ /^cr\//) { 707: my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role); 708: if ($tremark) { $tremark.='<br />'; } 709: $tremark.=&mt('Defined by [_1] at [_2].',$rauthor,$rdomain); 710: } 711: $trole=Apache::lonnet::plaintext($role); 712: my $ttype; 713: my $twhere; 714: my ($tdom,$trest,$tsection)= 715: split(/\//,Apache::lonnet::declutter($where)); 716: # First, Co-Authorship roles 717: if (($role eq 'ca') || ($role eq 'aa')) { 718: my $home = &Apache::lonnet::homeserver($trest,$tdom); 719: my $allowed=0; 720: my @ids=&Apache::lonnet::current_machine_ids(); 721: foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } 722: if (!$allowed) { 723: $button=0; 724: $switchserver='otherserver='.$home.'&role='.$trolecode; 725: } 726: #next if ($home eq 'no_host'); 727: $home = &Apache::lonnet::hostname($home); 728: $ttype='Construction Space'; 729: $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain'). 730: ': '.$tdom.'<br />'. 731: ' '.&mt('Server').': '.$home; 732: $env{'course.'.$tdom.'_'.$trest.'.description'}='ca'; 733: $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/'); 734: $sortkey=$role."$trest:$tdom"; 735: } elsif ($role eq 'au') { 736: # Authors 737: my $home = &Apache::lonnet::homeserver 738: ($env{'user.name'},$env{'user.domain'}); 739: my $allowed=0; 740: my @ids=&Apache::lonnet::current_machine_ids(); 741: foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } 742: if (!$allowed) { 743: $button=0; 744: $switchserver='otherserver='.$home.'&role='.$trolecode; 745: } 746: #next if ($home eq 'no_host'); 747: $home = &Apache::lonnet::hostname($home); 748: $ttype='Construction Space'; 749: $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server'). 750: ': '.$home; 751: $env{'course.'.$tdom.'_'.$trest.'.description'}='ca'; 752: $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/'); 753: $sortkey=$role; 754: } elsif ($trest) { 755: my $tcourseid=$tdom.'_'.$trest; 756: $ttype = &Apache::loncommon::course_type($tcourseid); 757: $trole = &Apache::lonnet::plaintext($role,$ttype); 758: if ($env{'course.'.$tcourseid.'.description'}) { 759: $twhere=$env{'course.'.$tcourseid.'.description'}; 760: $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey; 761: unless ($twhere eq &mt('Currently not available')) { 762: $twhere.=' <font size="-2">'. 763: &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont). 764: '</font>'; 765: } 766: } else { 767: my %newhash=&Apache::lonnet::coursedescription($tcourseid); 768: if (%newhash) { 769: $sortkey=$role."\0".$tdom."\0".$newhash{'description'}. 770: "\0".$envkey; 771: $twhere=$newhash{'description'}. 772: ' <font size="-2">'. 773: &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont). 774: '</font>'; 775: $ttype = $newhash{'type'}; 776: $trole = &Apache::lonnet::plaintext($role,$ttype); 777: } else { 778: $twhere=&mt('Currently not available'); 779: $env{'course.'.$tcourseid.'.description'}=$twhere; 780: $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey; 781: $ttype = 'Unavailable'; 782: } 783: } 784: if ($tsection) { 785: $twhere.='<br />'.&mt('Section').': '.$tsection; 786: } 787: if ($role ne 'st') { $twhere.="<br />".&mt('Domain').":".$tdom; } 788: } elsif ($tdom) { 789: $ttype='Domain'; 790: $twhere=$tdom; 791: $sortkey=$role.$twhere; 792: } else { 793: $ttype='System'; 794: $twhere=&mt('system wide'); 795: $sortkey=$role.$twhere; 796: } 797: $roletext.=&build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$tfont,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit); 798: $roletext{$envkey}=$roletext; 799: if (!$sortkey) {$sortkey=$twhere."\0".$envkey;} 800: $sortrole{$sortkey}=$envkey; 801: $roleclass{$envkey}=$ttype; 802: } 803: } 804: } 805: if ($env{'user.adv'}) { 806: $r->print( 807: '<br /><span class="LC_rolesinfo"><label>'.&mt('Show all roles').': <input type="checkbox" name="showall"'); 808: if ($env{'form.showall'}) { $r->print(' checked="checked" '); } 809: $r->print(' /></label><input type="submit" value="'.&mt('Display').'" /></span>'); 810: } else { 811: if ($countactive > 0) { 812: my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); 813: my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); 814: $r->print('<p>'.&mt('[_1]Visit the [_2]Course Catalog[_3] to view all [_4] LON-CAPA courses.','<b>','<a href="/adm/coursecatalog?showdom='.$esc_dom.'">','</a></b>',$domdesc).'<br />'.&mt('If a course is [_1]not[_2] in your list of current courses below, you may be able to enroll if self-enrollment is permitted.','<b>','</b>').'</p>'); 815: } 816: } 817: 818: # No active roles 819: if ($countactive==0) { 820: if ($inrole) { 821: $r->print('<h2>'.&mt('Currently no additional roles or courses').'</h2>'); 822: } else { 823: $r->print('<h2>'.&mt('Currently no active roles or courses').'</h2>'); 824: } 825: &findcourse_advice($r); 826: $r->print('</form>'); 827: if ($countfuture) { 828: $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture)); 829: my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole, 830: $nochoose); 831: &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles, 832: \%roletext); 833: my $tremark=''; 834: my $tfont='#003300'; 835: if ($env{'request.role'} eq 'cm') { 836: $r->print('<tr bgcolor="#11CC55">'); 837: $tremark=&mt('Currently selected.').' '; 838: $tfont='#002200'; 839: } else { 840: $r->print('<tr bgcolor="#77FF77">'); 841: } 842: $r->print('<td></td><td colspan="3"><font color="'.$tfont.'"><span class="LC_rolesinfo">'.&mt('No role specified'). 843: '</span></font></td><td><font color="'.$tfont.'">'.$tremark. 844: ' </font></td></tr>'."\n"); 845: 846: $r->print('</table>'); 847: } 848: $r->print(&Apache::loncommon::end_page()); 849: return OK; 850: } 851: # ----------------------------------------------------------------------- Table 852: unless ((!&Apache::lonmenu::show_course()) || ($nochoose) || ($countactive==1)) { 853: $r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n"); 854: } 855: my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose); 856: if ($env{'environment.recentroles'}) { 857: my %recent_roles = 858: &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'}); 859: my $output=''; 860: foreach (sort(keys(%recent_roles))) { 861: if (defined($roletext{'user.role.'.$_})) { 862: $output.=$roletext{'user.role.'.$_}; 863: if ($_ =~ m-dc\./($match_domain)/- 864: && $dcroles{$1}) { 865: $output .= &adhoc_roles_row($1,'recent'); 866: } 867: } elsif ($numdc > 0) { 868: unless ($_ =~/^error\:/) { 869: $output.=&display_cc_role('user.role.'.$_); 870: } 871: } 872: } 873: if ($output) { 874: $r->print("<tr><td align='center' colspan='5'><font face='arial'>". 875: &mt('Recent Roles')."</font></td></tr>"); 876: $r->print($output); 877: $doheaders ++; 878: } 879: } 880: 881: if ($numdc > 0) { 882: $r->print(&coursepick_jscript()); 883: $r->print(&Apache::loncommon::coursebrowser_javascript(). 884: &Apache::loncommon::authorbrowser_javascript()); 885: } 886: &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext); 887: if ($countactive > 1) { 888: my $tremark=''; 889: my $tfont='#003300'; 890: if ($env{'request.role'} eq 'cm') { 891: $r->print('<tr bgcolor="#11CC55">'); 892: $tremark=&mt('Currently selected.').' '; 893: $tfont='#002200'; 894: } else { 895: $r->print('<tr bgcolor="#77FF77">'); 896: } 897: unless ($nochoose) { 898: if ($env{'request.role'} ne 'cm') { 899: $r->print('<td><input type="submit" value="'. 900: &mt('Select').'" name="cm" /></td>'); 901: } else { 902: $r->print('<td> </td>'); 903: } 904: } 905: $r->print('<td colspan="3"><font color="'.$tfont.'"><span class="LC_rolesinfo">'.&mt('No role specified'). 906: '</span></font></td><td><font color="'.$tfont.'">'.$tremark. 907: ' </font></td></tr>'."\n"); 908: } 909: $r->print('</table>'); 910: unless ($nochoose) { 911: $r->print("</form>\n"); 912: } 913: # ------------------------------------------------------------ Privileges Info 914: if (($advanced) && (($env{'user.error.msg'}) || ($error))) { 915: $r->print('<hr /><h2>Current Privileges</h2>'); 916: $r->print(&privileges_info()); 917: } 918: $r->print(&Apache::lonnet::getannounce()); 919: if ($advanced) { 920: my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); 921: $r->print('<p><small><i>' 922: .&mt('This is LON-CAPA [_1]',$r->dir_config('lonVersion')) 923: .'</i><br />' 924: .'<a href="/adm/logout">'.&mt('Logout').'</a>  ' 925: .'<a href="/adm/coursecatalog?showdom='.$esc_dom.'">' 926: .&mt('Course Catalog') 927: .'</small></p>'); 928: } 929: $r->print(&Apache::loncommon::end_page()); 930: return OK; 931: } 932: 933: sub roletable_headers { 934: my ($r,$roleclass,$sortrole,$nochoose) = @_; 935: my $doheaders; 936: if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) { 937: $r->print('<br /><table id="LC_rolesmenu"><tr>'); 938: if (!$nochoose) { $r->print('<th> </th>'); } 939: $r->print('<th>'.&mt('User Role').'</th><th>'.&mt('Extent') 940: .'</th><th>'.&mt('Start').'</th><th>'.&mt('End') 941: .'</th></tr>'."\n"); 942: $doheaders=-1; 943: my @roletypes = &roletypes(); 944: foreach my $type (@roletypes) { 945: my $haverole=0; 946: foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) { 947: if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) { 948: $haverole=1; 949: } 950: } 951: if ($haverole) { $doheaders++; } 952: } 953: } 954: return $doheaders; 955: } 956: 957: sub roletypes { 958: my @types = ('Domain','Construction Space','Course','Unavailable','System'); 959: return @types; 960: } 961: 962: sub print_rolerows { 963: my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext) = @_; 964: if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) { 965: my @types = &roletypes(); 966: foreach my $type (@types) { 967: my $output; 968: foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) { 969: if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) { 970: if (ref($roletext) eq 'HASH') { 971: $output.=$roletext->{$sortrole->{$which}}; 972: if ($sortrole->{$which} =~ m-dc\./($match_domain)/-) { 973: if (ref($dcroles) eq 'HASH') { 974: if ($dcroles->{$1}) { 975: $output .= &adhoc_roles_row($1,''); 976: } 977: } 978: } 979: } 980: } 981: } 982: if ($output) { 983: if ($doheaders > 0) { 984: $r->print("<tr>". 985: "<td align='center' colspan='5'><font face='arial'>". 986: &mt($type)."</font></td></tr>"); 987: } 988: $r->print($output); 989: } 990: } 991: } 992: } 993: 994: sub findcourse_advice { 995: my ($r) = @_; 996: my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); 997: my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); 998: if (&Apache::lonnet::auto_run(undef,$env{'user.domain'})) { 999: $r->print(&mt('If you were expecting to see an active role listed for a particular course in the [_1] domain, it may be missing for one of the following reasons:',$domdesc).' 1000: <ul> 1001: <li>'.&mt('The course has yet to be created.').'</li> 1002: <li>'.&mt('Automatic enrollment of registered students has not been enabled for the course.').'</li> 1003: <li>'.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'</li> 1004: <li>'.&mt('The start date for automated enrollment has yet to be reached.').'</li> 1005: <li>'.&mt('You registered for the course recently and there is a time lag between the time you register, and the time this information becomes available for the update of LON-CAPA course rosters.').'</li> 1006: </ul>'); 1007: } else { 1008: $r->print(&mt('If you were expecting to see an active role listed for a particular course, that course may not have been created yet.').'<br />'); 1009: } 1010: $r->print('<p>'.&mt('The [_1]Course Catalog[_2] provides information about all [_3] classes for which LON-CAPA courses have been created.','<a href="/adm/coursecatalog?showdom='.$esc_dom.'">','</a>',$domdesc).'<br />'); 1011: $r->print(&mt('You can search the course catalog for courses which permit self-enrollment, if you would like to enroll in a course.').'</p>'); 1012: return; 1013: } 1014: 1015: sub privileges_info { 1016: my ($which) = @_; 1017: my $output; 1018: 1019: $which ||= $env{'request.role'}; 1020: 1021: foreach my $envkey (sort(keys(%env))) { 1022: next if ($envkey!~/^user\.priv\.\Q$which\E\.(.*)/); 1023: 1024: my $where=$1; 1025: my $ttype; 1026: my $twhere; 1027: my (undef,$tdom,$trest,$tsec)=split(m{/},$where); 1028: if ($trest) { 1029: if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') { 1030: $ttype='Construction Space'; 1031: $twhere='User: '.$trest.', Domain: '.$tdom; 1032: } else { 1033: $ttype= &Apache::loncommon::course_type($tdom.'_'.$trest); 1034: $twhere=$env{'course.'.$tdom.'_'.$trest.'.description'}; 1035: if ($tsec) { 1036: my $sec_type = 'Section'; 1037: if (exists($env{"user.role.gr.$where"})) { 1038: $sec_type = 'Group'; 1039: } 1040: $twhere.=' ('.$sec_type.': '.$tsec.')'; 1041: } 1042: } 1043: } elsif ($tdom) { 1044: $ttype='Domain'; 1045: $twhere=$tdom; 1046: } else { 1047: $ttype='System'; 1048: $twhere='/'; 1049: } 1050: $output .= "\n<h3>".&mt($ttype).': '.$twhere.'</h3>'."\n<ul>"; 1051: foreach my $priv (sort(split(/:/,$env{$envkey}))) { 1052: next if (!$priv); 1053: 1054: my ($prv,$restr)=split(/\&/,$priv); 1055: my $trestr=''; 1056: if ($restr ne 'F') { 1057: $trestr.=' ('. 1058: join(', ', 1059: map { &Apache::lonnet::plaintext($_) } 1060: (split('',$restr))).') '; 1061: } 1062: $output .= "\n\t". 1063: '<li>'.&Apache::lonnet::plaintext($prv).$trestr.'</li>'; 1064: } 1065: $output .= "\n".'</ul>'; 1066: } 1067: return $output; 1068: } 1069: 1070: sub role_status { 1071: my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_; 1072: my @pwhere = (); 1073: if (exists($env{$rolekey}) && $env{$rolekey} ne '') { 1074: (undef,undef,$$role,@pwhere)=split(/\./,$rolekey); 1075: unless (!defined($$role) || $$role eq '') { 1076: $$where=join('.',@pwhere); 1077: $$trolecode=$$role.'.'.$$where; 1078: ($$tstart,$$tend)=split(/\./,$env{$rolekey}); 1079: $$tstatus='is'; 1080: if ($$tstart && $$tstart>$then) { 1081: $$tstatus='future'; 1082: if ($$tstart<$now) { $$tstatus='will'; } 1083: } 1084: if ($$tend) { 1085: if ($$tend<$then) { 1086: $$tstatus='expired'; 1087: } elsif ($$tend<$now) { 1088: $$tstatus='will_not'; 1089: } 1090: } 1091: } 1092: } 1093: } 1094: 1095: sub build_roletext { 1096: my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$tfont,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit) = @_; 1097: my $roletext='<tr bgcolor="'.$tbg.'" class="LC_rolesmenu_'.$tstatus.'">'; 1098: my $is_dc=($trolecode =~ m/^dc\./); 1099: my $rowspan=($is_dc) ? '' 1100: : ' rowspan="2" '; 1101: 1102: unless ($nochoose) { 1103: my $buttonname=$trolecode; 1104: $buttonname=~s/\W//g; 1105: if (!$button) { 1106: if ($switchserver) { 1107: $roletext.='<td'.$rowspan.'><span class="LC_rolesinfo"><a href="/adm/switchserver?'. 1108: $switchserver.'">'.&mt('Switch Server').'</a></span></td>'; 1109: } else { 1110: $roletext.=('<td'.$rowspan.'> </td>'); 1111: } 1112: } elsif ($tstatus eq 'is') { 1113: $roletext.='<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'. 1114: &mt('Select').'" onClick="javascript:enterrole(this.form,\''. 1115: $trolecode."','".$buttonname.'\');" /></td>'; 1116: } elsif ($tryagain) { 1117: $roletext.= 1118: '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'. 1119: &mt('Try Selecting Again').'" onClick="javascript:enterrole(this.form,\''. 1120: $trolecode."','".$buttonname.'\');" /></td>'; 1121: } elsif ($advanced) { 1122: $roletext.= 1123: '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'. 1124: &mt('Re-Initialize').'" onClick="javascript:enterrole(this.form,\''. 1125: $trolecode."','".$buttonname.'\');" /></td>'; 1126: } elsif ($reinit) { 1127: $roletext.= 1128: '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'. 1129: &mt('Re-Select').'" onClick="javascript:enterrole(this.form,\''. 1130: $trolecode."','".$buttonname.'\');" /></td>'; 1131: } else { 1132: $roletext.= 1133: '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'. 1134: &mt('Re-Initialize').'" onClick="javascript:enterrole(this.form,\''. 1135: $trolecode."','".$buttonname.'\');" /></td>'; 1136: } 1137: } 1138: if ($trolecode !~ m/^(dc|ca|au|aa)\./) { 1139: $tremark.=&Apache::lonannounce::showday(time,1, 1140: &Apache::lonannounce::readcalendar($tdom.'_'.$trest)); 1141: } 1142: $roletext.='<td><font color="'.$tfont.'">'.$trole. 1143: '</font></td><td><font color="'.$tfont.'">'.$twhere. 1144: '</font></td><td><font color="'.$tfont.'">'.$tpstart. 1145: '</font></td><td><font color="'.$tfont.'">'.$tpend. 1146: '</font></td></tr>'; 1147: if (!$is_dc) { 1148: $roletext.='<tr bgcolor="'.$tbg.'"><td colspan="4"><font color="'.$tfont.'"><span class="LC_rolesinfo">'.$tremark. 1149: '</span> </font></td></tr><tr><td colspan="5" height="3"></td></tr>'."\n"; 1150: } 1151: return $roletext; 1152: } 1153: 1154: sub check_needs_switchserver { 1155: my ($possiblerole) = @_; 1156: my $needs_switchserver; 1157: my ($role,$where) = split(/\./,$possiblerole,2); 1158: my (undef,$tdom,$twho) = split(/\//,$where); 1159: my ($server_status,$home); 1160: if (($role eq 'ca') || ($role eq 'aa')) { 1161: ($server_status,$home) = &check_author_homeserver($twho,$tdom); 1162: } else { 1163: ($server_status,$home) = &check_author_homeserver($env{'user.name'}, 1164: $env{'user.domain'}); 1165: } 1166: if ($server_status eq 'switchserver') { 1167: $needs_switchserver = 1; 1168: } 1169: return $needs_switchserver; 1170: } 1171: 1172: sub check_author_homeserver { 1173: my ($uname,$udom)=@_; 1174: if (($uname eq '') || ($udom eq '')) { 1175: return ('fail',''); 1176: } 1177: my $home = &Apache::lonnet::homeserver($uname,$udom); 1178: if (&Apache::lonnet::host_domain($home) ne $udom) { 1179: return ('fail',$home); 1180: } 1181: my @ids=&Apache::lonnet::current_machine_ids(); 1182: if (grep(/^\Q$home\E$/,@ids)) { 1183: return ('ok',$home); 1184: } else { 1185: return ('switchserver',$home); 1186: } 1187: } 1188: 1189: sub check_privs { 1190: my ($cdom,$cnum,$then,$now,$checkrole) = @_; 1191: my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; 1192: if ($env{$cckey}) { 1193: my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont); 1194: &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); 1195: unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { 1196: &set_privileges($cdom,$cnum,$checkrole); 1197: } 1198: } else { 1199: &set_privileges($cdom,$cnum,$checkrole); 1200: } 1201: } 1202: 1203: sub check_fordc { 1204: my ($dcroles,$then) = @_; 1205: my $numdc = 0; 1206: if ($env{'user.adv'}) { 1207: foreach my $envkey (sort keys %env) { 1208: if ($envkey=~/^user\.role\.dc\.\/($match_domain)\/$/) { 1209: my $dcdom = $1; 1210: my $livedc = 1; 1211: my ($tstart,$tend)=split(/\./,$env{$envkey}); 1212: if ($tstart && $tstart>$then) { $livedc = 0; } 1213: if ($tend && $tend <$then) { $livedc = 0; } 1214: if ($livedc) { 1215: $$dcroles{$dcdom} = $envkey; 1216: $numdc++; 1217: } 1218: } 1219: } 1220: } 1221: return $numdc; 1222: } 1223: 1224: sub adhoc_course_role { 1225: my ($then) = @_; 1226: my ($cdom,$cnum); 1227: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 1228: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 1229: if (&check_forcc($cdom,$cnum,$then)) { 1230: my $setprivs; 1231: if (!defined($env{'user.role.'.$env{'form.switchrole'}})) { 1232: $setprivs = 1; 1233: } else { 1234: my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}}); 1235: if (($start && ($start>$then || $start == -1)) || 1236: ($end && $end<$then)) { 1237: $setprivs = 1; 1238: } 1239: } 1240: if ($setprivs) { 1241: if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)([\w/]*)\./\Q$cdom\E/\Q$cnum\E/?(\w*)$-) { 1242: my $role = $1; 1243: my $custom_role = $2; 1244: my $usec = $3; 1245: if ($role eq 'cr') { 1246: if ($custom_role =~ m-^/$match_domain/$match_username/\w+$-) { 1247: $role .= $custom_role; 1248: } else { 1249: return; 1250: } 1251: } 1252: my (%userroles,%newrole,%newgroups,%group_privs); 1253: my %cgroups = 1254: &Apache::lonnet::get_active_groups($env{'user.domain'}, 1255: $env{'user.name'},$cdom,$cnum); 1256: foreach my $group (keys(%cgroups)) { 1257: $group_privs{$group} = 1258: $env{'user.priv.cc./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group}; 1259: } 1260: $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs; 1261: my $area = '/'.$cdom.'/'.$cnum; 1262: my $spec = $role.'.'.$area; 1263: if ($usec ne '') { 1264: $spec .= '/'.$usec; 1265: $area .= '/'.$usec; 1266: } 1267: &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area); 1268: &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups); 1269: my $adhocstart = $then-1; 1270: $userroles{'user.role.'.$spec} = $adhocstart.'.'; 1271: &Apache::lonnet::appenv(\%userroles,[$role,'cm']); 1272: } 1273: } 1274: } 1275: return; 1276: } 1277: 1278: sub check_forcc { 1279: my ($cdom,$cnum,$then) = @_; 1280: my $is_cc; 1281: if ($cdom ne '' && $cnum ne '') { 1282: if (&Apache::lonnet::is_course($cdom,$cnum)) { 1283: my $envkey = 'user.role.cc./'.$cdom.'/'.$cnum; 1284: if (defined($env{$envkey})) { 1285: $is_cc = 1; 1286: my ($tstart,$tend)=split(/\./,$env{$envkey}); 1287: if ($tstart && $tstart>$then) { $is_cc = 0; } 1288: if ($tend && $tend <$then) { $is_cc = 0; } 1289: } 1290: } 1291: } 1292: return $is_cc; 1293: } 1294: 1295: sub courselink { 1296: my ($dcdom,$rowtype) = @_; 1297: my $courseform=&Apache::loncommon::selectcourse_link 1298: ('rolechoice','dccourse'.$rowtype.'_'.$dcdom, 1299: 'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'. 1300: $dcdom,$dcdom,undef); 1301: my $hiddenitems = '<input type="hidden" name="dcdomain'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'. 1302: '<input type="hidden" name="origdom'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'. 1303: '<input type="hidden" name="dccourse'.$rowtype.'_'.$dcdom.'" value="" />'. 1304: '<input type="hidden" name="coursedesc'.$rowtype.'_'.$dcdom.'" value="" />'; 1305: return $courseform.$hiddenitems; 1306: } 1307: 1308: sub coursepick_jscript { 1309: my %lt = &Apache::lonlocal::texthash( 1310: plsu => "Please use the 'Select Course' link to open a separate pick course window where you may select the course you wish to enter.", 1311: youc => 'You can only use this screen to select courses in the current domain.', 1312: ); 1313: my $verify_script = <<"END"; 1314: <script type="text/javascript"> 1315: function verifyCoursePick(caller) { 1316: var numbutton = getIndex(caller) 1317: var pickedCourse = document.rolechoice.elements[numbutton+4].value 1318: var pickedDomain = document.rolechoice.elements[numbutton+2].value 1319: if (document.rolechoice.elements[numbutton+2].value == document.rolechoice.elements[numbutton+3].value) { 1320: if (pickedCourse != '') { 1321: if (numbutton != -1) { 1322: var courseTarget = "cc./"+pickedDomain+"/"+pickedCourse 1323: document.rolechoice.elements[numbutton+1].name = courseTarget 1324: document.rolechoice.submit() 1325: } 1326: } 1327: else { 1328: alert("$lt{'plsu'}"); 1329: } 1330: } 1331: else { 1332: alert("$lt{'youc'}") 1333: } 1334: } 1335: function getIndex(caller) { 1336: for (var i=0;i<document.rolechoice.elements.length;i++) { 1337: if (document.rolechoice.elements[i] == caller) { 1338: return i; 1339: } 1340: } 1341: return -1; 1342: } 1343: </script> 1344: END 1345: return $verify_script; 1346: } 1347: 1348: sub coauthorlink { 1349: my ($dcdom,$rowtype) = @_; 1350: my $coauthorform=&Apache::loncommon::selectauthor_link('rolechoice',$dcdom); 1351: my $hiddenitems = '<input type="hidden" name="adhoccauname'.$rowtype.'_'.$dcdom.'" value="" />'; 1352: return $coauthorform.$hiddenitems; 1353: } 1354: 1355: sub display_cc_role { 1356: my $rolekey = shift; 1357: my $roletext; 1358: my $advanced = $env{'user.adv'}; 1359: my $tryagain = $env{'form.tryagain'}; 1360: unless ($rolekey =~/^error\:/) { 1361: if ($rolekey =~ m-^user\.role.cc\./($match_domain)/($match_courseid)$-) { 1362: my $tcourseid = $1.'_'.$2; 1363: my $trolecode = 'cc./'.$1.'/'.$2; 1364: my $twhere; 1365: my $ttype; 1366: my $tbg='#77FF77'; 1367: my $tfont='#003300'; 1368: my %newhash=&Apache::lonnet::coursedescription($tcourseid); 1369: if (%newhash) { 1370: $twhere=$newhash{'description'}. 1371: ' <font size="-2">'. 1372: &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$2,$1,$tfont). 1373: '</font>'; 1374: $ttype = $newhash{'type'}; 1375: } else { 1376: $twhere=&mt('Currently not available'); 1377: $env{'course.'.$tcourseid.'.description'}=$twhere; 1378: } 1379: my $trole = &Apache::lonnet::plaintext('cc',$ttype); 1380: $twhere.="<br />".&mt('Domain').":".$1; 1381: $roletext = &build_roletext($trolecode,$1,$2,'is',$tryagain,$advanced,'',$tbg,$tfont,$trole,$twhere,'','','',1,''); 1382: } 1383: } 1384: return ($roletext); 1385: } 1386: 1387: sub adhoc_roles_row { 1388: my ($dcdom,$rowtype) = @_; 1389: my $output = '<tr bgcolor="#77FF77">'. 1390: ' <td colspan="5"><table><tr><td><span class="LC_rolesinfo">' 1391: .&mt('[_1]Ad hoc[_2] roles in domain [_3] --', 1392: '<span class="LC_cusr_emph">','</span>',$dcdom).'</span></td><td>'; 1393: my $selectcclink = &courselink($dcdom,$rowtype); 1394: my $ccrole = &Apache::lonnet::plaintext('cc'); 1395: my $carole = &Apache::lonnet::plaintext('ca'); 1396: my $selectcalink = &coauthorlink($dcdom,$rowtype); 1397: $output.= '<span class="LC_rolesinfo">'. 1398: &mt('[_1]: [_2]',$ccrole,$selectcclink). 1399: '</span><br /></td><td>  </td><td><span class="LC_rolesinfo">'. 1400: &mt('[_1]: [_2]',$carole,$selectcalink). 1401: '</span><br /></td></tr></table></td></tr>'. 1402: '<tr><td colspan="5" height="3"></td></tr>'."\n"; 1403: return $output; 1404: } 1405: 1406: sub recent_filename { 1407: my $area=shift; 1408: return 'nohist_recent_'.&escape($area); 1409: } 1410: 1411: sub set_privileges { 1412: # role can be cc or ca 1413: my ($dcdom,$pickedcourse,$role) = @_; 1414: my $area = '/'.$dcdom.'/'.$pickedcourse; 1415: my $spec = $role.'.'.$area; 1416: my %userroles = &Apache::lonnet::set_arearole($role,$area,'','', 1417: $env{'user.domain'}, 1418: $env{'user.name'}); 1419: my %ccrole = (); 1420: &Apache::lonnet::standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area); 1421: my ($author,$adv)= &Apache::lonnet::set_userprivs(\%userroles,\%ccrole); 1422: &Apache::lonnet::appenv(\%userroles,[$role,'cm']); 1423: 1424: &Apache::lonnet::log($env{'user.domain'}, 1425: $env{'user.name'}, 1426: $env{'user.home'}, 1427: "Role ".$role); 1428: &Apache::lonnet::appenv( 1429: {'request.role' => $spec, 1430: 'request.role.domain' => $dcdom, 1431: 'request.course.sec' => ''}); 1432: my $tadv=0; 1433: if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; } 1434: &Apache::lonnet::appenv({'request.role.adv' => $tadv}); 1435: } 1436: 1437: sub courseloadpage { 1438: my ($courseid) = @_; 1439: my $startpage; 1440: my %entry_settings = &Apache::lonnet::get('nohist_whatsnew', 1441: [$courseid.':courseinit']); 1442: my ($tmp) = %entry_settings; 1443: unless ($tmp =~ /^error: 2 /) { 1444: $startpage = $entry_settings{$courseid.':courseinit'}; 1445: } 1446: if ($startpage eq '') { 1447: if (exists($env{'environment.course_init_display'})) { 1448: $startpage = $env{'environment.course_init_display'}; 1449: } 1450: } 1451: return $startpage; 1452: } 1453: 1454: 1; 1455: __END__ 1456: 1457: =head1 NAME 1458: 1459: Apache::lonroles - User Roles Screen 1460: 1461: =head1 SYNOPSIS 1462: 1463: Invoked by /etc/httpd/conf/srm.conf: 1464: 1465: <Location /adm/roles> 1466: PerlAccessHandler Apache::lonacc 1467: SetHandler perl-script 1468: PerlHandler Apache::lonroles 1469: ErrorDocument 403 /adm/login 1470: ErrorDocument 500 /adm/errorhandler 1471: </Location> 1472: 1473: =head1 OVERVIEW 1474: 1475: =head2 Choosing Roles 1476: 1477: C<lonroles> is a handler that allows a user to switch roles in 1478: mid-session. LON-CAPA attempts to work with "No Role Specified", the 1479: default role that a user has before selecting a role, as widely as 1480: possible, but certain handlers for example need specification which 1481: course they should act on, etc. Both in this scenario, and when the 1482: handler determines via C<lonnet>'s C<&allowed> function that a certain 1483: action is not allowed, C<lonroles> is used as error handler. This 1484: allows the user to select another role which may have permission to do 1485: what they were trying to do. C<lonroles> can also be accessed via the 1486: B<CRS> button in the Remote Control. 1487: 1488: =begin latex 1489: 1490: \begin{figure} 1491: \begin{center} 1492: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen} 1493: \caption{\label{Sample_Roles_Screen}Sample Roles Screen} 1494: \end{center} 1495: \end{figure} 1496: 1497: =end latex 1498: 1499: =head2 Role Initialization 1500: 1501: The privileges for a user are established at login time and stored in the session environment. As a consequence, a new role does not become active till the next login. Handlers are able to query for privileges using C<lonnet>'s C<&allowed> function. When a user first logs in, their role is the "common" role, which means that they have the sum of all of their privileges. During a session it might become necessary to choose a particular role, which as a consequence also limits the user to only the privileges in that particular role. 1502: 1503: =head1 INTRODUCTION 1504: 1505: This module enables a user to select what role he wishes to 1506: operate under (instructor, student, teaching assistant, course 1507: coordinator, etc). These roles are pre-established by the actions 1508: of upper-level users. 1509: 1510: This is part of the LearningOnline Network with CAPA project 1511: described at http://www.lon-capa.org. 1512: 1513: =head1 HANDLER SUBROUTINE 1514: 1515: This routine is called by Apache and mod_perl. 1516: 1517: =over 4 1518: 1519: =item * 1520: 1521: Roles Initialization (yes/no) 1522: 1523: =item * 1524: 1525: Get Error Message from Environment 1526: 1527: =item * 1528: 1529: Who is this? 1530: 1531: =item * 1532: 1533: Generate Page Output 1534: 1535: =item * 1536: 1537: Choice or no choice 1538: 1539: =item * 1540: 1541: Table 1542: 1543: =item * 1544: 1545: Privileges 1546: 1547: =back 1548: 1549: =cut