Annotation of loncom/auth/lonroles.pm, revision 1.181.2.2

1.1       harris41    1: # The LearningOnline Network with CAPA
                      2: # User Roles Screen
1.31      www         3: #
1.181.2.2! raeburn     4: # $Id: lonroles.pm,v 1.181.2.1 2008/03/22 03:40:58 raeburn Exp $
1.31      www         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: #
1.32      harris41   28: ###
1.22      harris41   29: 
1.1       harris41   30: package Apache::lonroles;
                     31: 
                     32: use strict;
1.118     albertel   33: use Apache::lonnet;
1.7       www        34: use Apache::lonuserstate();
1.1       harris41   35: use Apache::Constants qw(:common);
1.2       www        36: use Apache::File();
1.26      www        37: use Apache::lonmenu;
1.29      albertel   38: use Apache::loncommon;
1.104     raeburn    39: use Apache::lonhtmlcommon;
1.57      www        40: use Apache::lonannounce;
1.72      www        41: use Apache::lonlocal;
1.151     www        42: use Apache::lonpageflip();
1.167     albertel   43: use Apache::lonnavdisplay();
1.120     albertel   44: use GDBM_File;
1.170     albertel   45: use LONCAPA qw(:DEFAULT :match);
1.149     www        46:  
1.1       harris41   47: 
1.62      matthew    48: sub redirect_user {
1.95      albertel   49:     my ($r,$title,$url,$msg,$launch_nav) = @_;
1.62      matthew    50:     $msg = $title if (! defined($msg));
1.73      www        51:     &Apache::loncommon::content_type($r,'text/html');
1.62      matthew    52:     &Apache::loncommon::no_cache($r);
                     53:     $r->send_http_header;
                     54:     my $swinfo=&Apache::lonmenu::rawconfig();
1.96      albertel   55:     my $navwindow;
1.95      albertel   56:     if ($launch_nav eq 'on') {
1.166     albertel   57: 	$navwindow.=&Apache::lonnavdisplay::launch_win('now',undef,undef,
                     58: 						       ($url =~ m-^/adm/whatsnew-));
1.96      albertel   59:     } else {
                     60: 	$navwindow.=&Apache::lonnavmaps::close();
1.95      albertel   61:     }
1.147     albertel   62:     my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
                     63: 						    {'redirect' => [1,$url],});
                     64:     my $end_page   = &Apache::loncommon::end_page();
                     65: 
1.92      www        66: # Note to style police: 
                     67: # This must only replace the spaces, nothing else, or it bombs elsewhere.
                     68:     $url=~s/ /\%20/g;
1.93      albertel   69:     $r->print(<<ENDREDIR);
1.147     albertel   70: $start_page
1.96      albertel   71: <script type="text/javascript">
1.62      matthew    72: $swinfo
                     73: </script>
1.96      albertel   74: $navwindow
1.62      matthew    75: <h1>$msg</h1>
1.147     albertel   76: $end_page
1.62      matthew    77: ENDREDIR
                     78:     return;
                     79: }
                     80: 
1.150     www        81: sub error_page {
                     82:     my ($r,$error,$dest)=@_;
                     83:     &Apache::loncommon::content_type($r,'text/html');
                     84:     &Apache::loncommon::no_cache($r);
                     85:     $r->send_http_header;
                     86:     return OK if $r->header_only;
                     87:     $r->print(&Apache::loncommon::start_page('Problems during Course Initialization').
                     88: 	      '<script type="text/javascript">'.
                     89: 	      &Apache::lonmenu::rawconfig().'</script>'.
                     90: 	      '<p>'.&mt('The following problems occurred:').
                     91: 	      $error.
1.156     albertel   92: 	      '</p><br /><a href="'.$dest.'">'.&mt('Continue').'</a>'.
1.150     www        93: 	      &Apache::loncommon::end_page());
                     94: }
                     95: 
1.1       harris41   96: sub handler {
1.10      www        97: 
1.1       harris41   98:     my $r = shift;
                     99: 
1.6       www       100:     my $now=time;
1.118     albertel  101:     my $then=$env{'user.login.time'};
1.6       www       102:     my $envkey;
1.107     raeburn   103:     my %dcroles = ();
                    104:     my $numdc = &check_fordc(\%dcroles,$then);
1.148     albertel  105:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.10      www       106: 
1.6       www       107: # ================================================================== Roles Init
1.118     albertel  108:     if ($env{'form.selectrole'}) {
1.134     www       109:         if ($env{'form.newrole'}) {
                    110:             $env{'form.'.$env{'form.newrole'}}=1;
                    111: 	}
1.118     albertel  112: 	if ($env{'request.course.id'}) {
                    113: 	    my %temp=('logout_'.$env{'request.course.id'} => time);
1.33      www       114: 	    &Apache::lonnet::put('email_status',\%temp);
1.118     albertel  115: 	    &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
1.100     albertel  116: 	}
1.55      albertel  117: 	&Apache::lonnet::appenv("request.course.id"   => '',
                    118: 				"request.course.fn"   => '',
                    119: 				"request.course.uri"  => '',
                    120: 				"request.course.sec"  => '',
                    121: 				"request.role"        => 'cm',
1.118     albertel  122:                                 "request.role.adv"    => $env{'user.adv'},
                    123: 				"request.role.domain" => $env{'user.domain'});
1.106     raeburn   124: 
1.110     raeburn   125: # Check if user is a DC trying to enter a course and needs privs to be created
1.107     raeburn   126:         if ($numdc > 0) {
1.118     albertel  127:             foreach my $envkey (keys %env) {
1.146     raeburn   128:                 if (my ($domain,$coursenum) =
1.171     albertel  129: 		    ($envkey =~ m-^form\.cc\./($match_domain)/($match_courseid)$-)) {
1.146     raeburn   130:                     if ($dcroles{$domain}) {
                    131:                         &check_privs($domain,$coursenum,$then,$now);
1.107     raeburn   132:                     }
                    133:                     last;
                    134:                 }
                    135:             }
                    136:         }
                    137: 
1.118     albertel  138:         foreach $envkey (keys %env) {
1.40      matthew   139:             next if ($envkey!~/^user\.role\./);
1.102     raeburn   140:             my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
                    141:             &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
1.118     albertel  142:             if ($env{'form.'.$trolecode}) {
1.55      albertel  143: 		if ($tstatus eq 'is') {
                    144: 		    $where=~s/^\///;
                    145: 		    my ($cdom,$cnum,$csec)=split(/\//,$where);
1.137     raeburn   146: # check for course groups
                    147:                     my %coursegroups = &Apache::lonnet::get_active_groups(
                    148:                           $env{'user.domain'},$env{'user.name'},$cdom, $cnum);
                    149:                     my $cgrps = join(':',keys(%coursegroups));
                    150: 
1.111     albertel  151: # store role if recent_role list being kept
1.118     albertel  152:                     if ($env{'environment.recentroles'}) {
1.158     albertel  153:                         my %frozen_roles =
                    154:                            &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
1.111     albertel  155: 			&Apache::lonhtmlcommon::store_recent('roles',
1.158     albertel  156: 							     $trolecode,' ',$frozen_roles{$trolecode});
1.111     albertel  157:                     }
                    158: 
                    159: 
1.53      www       160: # check for keyed access
1.55      albertel  161: 		    if (($role eq 'st') && 
1.118     albertel  162:                        ($env{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
1.89      www       163: # who is key authority?
                    164: 			my $authdom=$cdom;
                    165: 			my $authnum=$cnum;
1.118     albertel  166: 			if ($env{'course.'.$cdom.'_'.$cnum.'.keyauth'}) {
1.89      www       167: 			    ($authnum,$authdom)=
1.172     albertel  168: 				split(/:/,$env{'course.'.$cdom.'_'.$cnum.'.keyauth'});
1.89      www       169: 			}
                    170: # check with key authority
                    171: 			unless (&Apache::lonnet::validate_access_key(
1.118     albertel  172: 				     $env{'environment.key.'.$cdom.'_'.$cnum},
1.89      www       173: 					     $authdom,$authnum)) {
1.53      www       174: # there is no valid key
1.118     albertel  175: 			     if ($env{'form.newkey'}) {
1.53      www       176: # student attempts to register a new key
1.89      www       177: 				 &Apache::loncommon::content_type($r,'text/html');
                    178: 				 &Apache::loncommon::no_cache($r);
                    179: 				 $r->send_http_header;
                    180: 				 my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  181: 				 my $start_page=&Apache::loncommon::start_page
1.89      www       182: 				    ('Verifying Access Key to Unlock this Course');
1.147     albertel  183: 				 my $end_page=&Apache::loncommon::end_page();
1.90      www       184: 				 my $buttontext=&mt('Enter Course');
                    185: 				 my $message=&mt('Successfully registered key');
                    186: 				 my $assignresult=
                    187: 				     &Apache::lonnet::assign_access_key(
1.118     albertel  188: 						     $env{'form.newkey'},
1.90      www       189: 						     $authdom,$authnum,
1.91      www       190: 						     $cdom,$cnum,
1.118     albertel  191:                                                      $env{'user.domain'},
                    192: 						     $env{'user.name'},
1.90      www       193: 	      'Assigned from '.$ENV{'REMOTE_ADDR'}.' at '.localtime().' for '.
                    194:                                                      $trolecode);
                    195: 				 unless ($assignresult eq 'ok') {
                    196: 				     $assignresult=~s/^error\:\s*//;
                    197: 				     $message=&mt($assignresult).
                    198: 				     '<br /><a href="/adm/logout">'.
1.89      www       199: 				     &mt('Logout').'</a>';
1.90      www       200: 				     $buttontext=&mt('Re-Enter Key');
                    201: 				 }
1.89      www       202: 				 $r->print(<<ENDENTEREDKEY);
1.147     albertel  203: $start_page
1.179     raeburn   204: <script type="text/javascript">
1.89      www       205: $swinfo
                    206: </script>
                    207: <form method="post">
                    208: <input type="hidden" name="selectrole" value="1" />
                    209: <input type="hidden" name="$trolecode" value="1" />
1.90      www       210: <font size="+2">$message</font><br />
1.89      www       211: <input type="submit" value="$buttontext" />
                    212: </form>
1.147     albertel  213: $end_page
1.89      www       214: ENDENTEREDKEY
                    215:                                  return OK;
1.55      albertel  216: 			     } else {
1.53      www       217: # print form to enter a new key
1.73      www       218: 				 &Apache::loncommon::content_type($r,'text/html');
1.55      albertel  219: 				 &Apache::loncommon::no_cache($r);
                    220: 				 $r->send_http_header;
                    221: 				 my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  222: 				 my $start_page=&Apache::loncommon::start_page
1.55      albertel  223: 				    ('Enter Access Key to Unlock this Course');
1.147     albertel  224: 				 my $end_page=&Apache::loncommon::end_page();
1.55      albertel  225: 				 $r->print(<<ENDENTERKEY);
1.147     albertel  226: $start_page
1.179     raeburn   227: <script type="text/javascript">
1.53      www       228: $swinfo
                    229: </script>
                    230: <form method="post">
1.89      www       231: <input type="hidden" name="selectrole" value="1" />
                    232: <input type="hidden" name="$trolecode" value="1" />
1.118     albertel  233: <input type="text" size="20" name="newkey" value="$env{'form.newkey'}" />
1.53      www       234: <input type="submit" value="Enter key" />
                    235: </form>
1.147     albertel  236: $end_page
1.53      www       237: ENDENTERKEY
1.55      albertel  238: 				 return OK;
                    239: 			     }
                    240: 			 }
                    241: 		     }
1.118     albertel  242: 		    &Apache::lonnet::log($env{'user.domain'},
                    243: 					 $env{'user.name'},
                    244: 					 $env{'user.home'},
1.87      www       245: 					 "Role ".$trolecode);
1.101     albertel  246: 		    
1.56      www       247: 		    &Apache::lonnet::appenv(
1.101     albertel  248: 					   'request.role'        => $trolecode,
1.56      www       249: 					   'request.role.domain' => $cdom,
1.137     raeburn   250: 					   'request.course.sec'  => $csec,
                    251:                                            'request.course.groups' => $cgrps);
1.101     albertel  252:                     my $tadv=0;
1.62      matthew   253: 
1.125     www       254: 		    if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
1.152     raeburn   255:                         my $msg;
1.55      albertel  256: 			my ($furl,$ferr)=
                    257: 			    &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
1.118     albertel  258: 			if (($env{'form.orgurl'}) && 
                    259: 			    ($env{'form.orgurl'}!~/^\/adm\/flip/)) {
                    260: 			    my $dest=$env{'form.orgurl'};
1.117     albertel  261: 			    if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
                    262: 			    &Apache::lonnet::appenv('request.role.adv'=>$tadv);
1.150     www       263:                             if (($ferr) && ($tadv)) {
                    264: 				&error_page($r,$ferr,$dest);
                    265: 			    } else {
                    266: 				$r->internal_redirect($dest);
                    267: 			    }
1.55      albertel  268: 			    return OK;
                    269: 			} else {
1.155     albertel  270: 			    if (!$env{'request.course.id'}) {
1.55      albertel  271: 				&Apache::lonnet::appenv(
                    272: 				      "request.course.id"  => $cdom.'_'.$cnum);
1.61      www       273: 				$furl='/adm/roles?tryagain=1';
1.55      albertel  274: 				$msg=
1.157     albertel  275: 				    '<h1><span class="LC_error">'.
1.162     albertel  276: 				    &mt('Could not initialize [_1] at this time.',
                    277: 					$env{'course.'.$cdom.'_'.$cnum.'.description'}).
1.157     albertel  278: 				    '</span></h1><h3>'.&mt('Please try again.').'</h3>'.$ferr;
1.55      albertel  279: 			    }
1.117     albertel  280: 			    if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
                    281: 			    &Apache::lonnet::appenv('request.role.adv'=>$tadv);
1.152     raeburn   282: 
1.150     www       283: 			    if (($ferr) && ($tadv)) {
                    284: 				&error_page($r,$ferr,$furl);
                    285: 			    } else {
                    286: 				# Check to see if the user is a CC entering a course 
                    287: 				# for the first time
                    288: 				my (undef, undef, $role, $courseid) = split(/\./, $envkey);
                    289: 				if (substr($courseid, 0, 1) eq '/') {
                    290: 				    $courseid = substr($courseid, 1);
                    291: 				}
                    292: 				$courseid =~ s/\//_/;
                    293: 				if ($role eq 'cc' && $env{'course.' . $courseid . 
                    294: 							      '.course.helper.not.run'}) {
                    295: 				    $furl = "/adm/helper/course.initialization.helper";
                    296: 				    # Send the user to the course they selected
                    297: 				} elsif ($env{'request.course.id'}) {
                    298: 				    if (&Apache::lonnet::allowed('whn',
                    299: 								 $env{'request.course.id'})
                    300: 					|| &Apache::lonnet::allowed('whn',
                    301: 								    $env{'request.course.id'}.'/'
                    302: 								    .$env{'request.course.sec'})
                    303: 					) {
                    304: 					my $startpage = &courseloadpage($courseid);
                    305: 					unless ($startpage eq 'firstres') {         
1.162     albertel  306: 					    $msg = &mt('Entering [_1] ....',
                    307: 						       $env{'course.'.$courseid.'.description'});
1.150     www       308: 					    &redirect_user($r,&mt('New in course'),
                    309: 							   '/adm/whatsnew?refpage=start',$msg,
                    310: 							   $env{'environment.remotenavmap'});
                    311: 					    return OK;
                    312: 					}
                    313: 				    }
                    314: 				}
1.151     www       315: # Are we allowed to look at the first resource?
1.169     albertel  316: 				if ($furl !~ m|^/adm/|) {
1.151     www       317: # Guess not ...
                    318: 				    $furl=&Apache::lonpageflip::first_accessible_resource();
                    319: 				}
1.162     albertel  320:                                 $msg = &mt('Entering [_1] ...',
                    321: 					   $env{'course.'.$courseid.'.description'});
                    322: 				&redirect_user($r,&mt('Entering [_1]',
                    323: 						      $env{'course.'.$courseid.'.description'}),
1.150     www       324: 					       $furl,$msg,
                    325: 					       $env{'environment.remotenavmap'});
1.58      bowersj2  326: 			    }
1.124     albertel  327: 			    return OK;
1.55      albertel  328: 			}
                    329: 		    }
1.62      matthew   330:                     #
                    331:                     # Send the user to the construction space they selected
1.125     www       332:                     if ($role =~ /^(au|ca|aa)$/) {
1.62      matthew   333:                         my $redirect_url = '/priv/';
                    334:                         if ($role eq 'au') {
1.118     albertel  335:                             $redirect_url.=$env{'user.name'};
1.62      matthew   336:                         } else {
                    337:                             $where =~ /\/(.*)$/;
                    338:                             $redirect_url .= $1;
                    339:                         }
                    340:                         $redirect_url .= '/';
1.78      sakharuk  341:                         &redirect_user($r,&mt('Entering Construction Space'),
1.62      matthew   342:                                        $redirect_url);
                    343:                         return OK;
                    344:                     }
1.104     raeburn   345:                     if ($role eq 'dc') {
1.108     raeburn   346:                         my $redirect_url = '/adm/menu/';
                    347:                         &redirect_user($r,&mt('Loading Domain Coordinator Menu'),
1.104     raeburn   348:                                        $redirect_url);
1.108     raeburn   349:                         return OK;
1.104     raeburn   350:                     }
1.55      albertel  351: 		}
                    352:             }
1.6       www       353:         }
1.40      matthew   354:     }
1.44      www       355: 
1.10      www       356: 
1.6       www       357: # =============================================================== No Roles Init
1.10      www       358: 
1.73      www       359:     &Apache::loncommon::content_type($r,'text/html');
1.30      albertel  360:     &Apache::loncommon::no_cache($r);
1.10      www       361:     $r->send_http_header;
                    362:     return OK if $r->header_only;
                    363: 
1.52      www       364:     my $swinfo=&Apache::lonmenu::rawconfig();
1.147     albertel  365:     my $start_page=&Apache::loncommon::start_page('User Roles');
1.134     www       366:     my $standby=&mt('Role selected. Please stand by.');
1.135     albertel  367:     $standby=~s/\n/\\n/g;
1.181.2.1  raeburn   368:     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 />';
1.163     www       369: 
1.10      www       370:     $r->print(<<ENDHEADER);
1.147     albertel  371: $start_page
1.163     www       372: <br />
1.179     raeburn   373: <noscript>
                    374: $noscript
                    375: </noscript>
                    376: <script type="text/javascript">
1.26      www       377: $swinfo
                    378: window.focus();
1.134     www       379: 
                    380: active=true;
                    381: 
                    382: function enterrole (thisform,rolecode,buttonname) {
                    383:     if (active) {
                    384: 	active=false;
                    385:         document.title='$standby';
                    386:         window.status='$standby';
                    387: 	thisform.newrole.value=rolecode;
                    388: 	thisform.submit();
                    389:     } else {
                    390:        alert('$standby');
                    391:     }   
                    392: }
1.26      www       393: </script>
1.10      www       394: ENDHEADER
1.6       www       395: 
1.2       www       396: # ------------------------------------------ Get Error Message from Environment
                    397: 
1.118     albertel  398:     my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$env{'user.error.msg'});
                    399:     if ($env{'user.error.msg'}) {
1.55      albertel  400: 	$r->log_reason(
1.118     albertel  401:    "$msg for $env{'user.name'} domain $env{'user.domain'} access $priv",$fn);
1.12      www       402:     }
1.1       harris41  403: 
1.61      www       404: # ------------------------------------------------- Can this user re-init, etc?
1.6       www       405: 
1.118     albertel  406:     my $advanced=$env{'user.adv'};
1.61      www       407:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['tryagain']);
1.118     albertel  408:     my $tryagain=$env{'form.tryagain'};
1.6       www       409: 
1.2       www       410: # -------------------------------------------------------- Generate Page Output
1.6       www       411: # --------------------------------------------------------------- Error Header?
1.2       www       412:     if ($error) {
1.181.2.2! raeburn   413:         $r->print("<h1>".&mt('LON-CAPA Access Control')."</h1>");
1.174     albertel  414: 	$r->print("<!-- LONCAPAACCESSCONTROLERRORSCREEN --><hr /><pre>");
                    415: 	if ($priv ne '') {
1.181.2.2! raeburn   416:             $r->print(&mt('Access  : ').&Apache::lonnet::plaintext($priv)."\n");
1.174     albertel  417: 	}
                    418: 	if ($fn ne '') {
1.181.2.2! raeburn   419:             $r->print(&mt('Resource: ').&Apache::lonenc::check_encrypt($fn)."\n");
1.174     albertel  420: 	}
                    421: 	if ($msg ne '') {
1.181.2.2! raeburn   422:             $r->print(&mt('Action  : ').$msg."\n");
1.174     albertel  423: 	}
                    424: 	$r->print("</pre><hr />");
1.120     albertel  425: 	my $url=$fn;
                    426: 	my $last;
                    427: 	if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                    428: 		&GDBM_READER(),0640)) {
                    429: 	    $last=$hash{'last_known'};
                    430: 	    untie(%hash);
                    431: 	}
1.149     www       432: 	if ($last) { $fn.='?symb='.&escape($last); }
1.120     albertel  433: 
                    434: 	&Apache::londocs::changewarning($r,undef,'You have modified your course recently, [_1] may fix this access problem.',
                    435: 					&Apache::lonenc::check_encrypt($fn));
1.2       www       436:     } else {
1.118     albertel  437:         if ($env{'user.error.msg'}) {
1.25      www       438: 	    $r->print(
1.157     albertel  439:  '<h3><span class="LC_error">'.
                    440:  &mt('You need to choose another user role or enter a specific course for this function').'</span></h3>');
1.25      www       441: 	}
1.2       www       442:     }
1.6       www       443: # -------------------------------------------------------- Choice or no choice?
1.2       www       444:     if ($nochoose) {
1.177     www       445: 	$r->print("<h2>".&mt('Sorry ...')."</h2>\n<span class='LC_error'>".
                    446: 		  &mt('This action is currently not authorized.').'</span>'.
1.150     www       447: 		  &Apache::loncommon::end_page());
                    448: 	return OK;
1.6       www       449:     } else {
1.18      www       450:         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
                    451:     	    $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
1.6       www       452:         }
1.84      www       453:         $r->print('<form method="post" name="rolechoice" action="'.(($fn)?$fn:$r->uri).'">');
1.116     albertel  454:         $r->print('<input type="hidden" name="orgurl" value="'.$fn.'" />');
                    455:         $r->print('<input type="hidden" name="selectrole" value="1" />');
1.134     www       456:         $r->print('<input type="hidden" name="newrole" value="" />');
1.6       www       457:     }
1.118     albertel  458:     if ($env{'user.adv'}) {
1.63      www       459: 	$r->print(
1.177     www       460: 	      '<br /><span class="LC_rolesinfo"><label>'.&mt('Show all roles').': <input type="checkbox" name="showall"');
1.118     albertel  461: 	if ($env{'form.showall'}) { $r->print(' checked="checked" '); }
1.177     www       462: 	$r->print(' /></label><input type="submit" value="'.&mt('Display').'" /></span>');
1.63      www       463:     }
1.4       www       464: 
1.75      albertel  465:     my (%roletext,%sortrole,%roleclass);
1.84      www       466:     my $countactive=0;
                    467:     my $inrole=0;
                    468:     my $possiblerole='';
1.118     albertel  469:     foreach $envkey (sort keys %env) {
1.35      matthew   470:         my $button = 1;
1.49      www       471:         my $switchserver='';
1.75      albertel  472: 	my $roletext;
                    473: 	my $sortkey;
1.2       www       474:         if ($envkey=~/^user\.role\./) {
1.102     raeburn   475:             my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont);
                    476:             &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
1.136     raeburn   477:             next if (!defined($role) || $role eq '' || $role =~ /^gr/);
1.102     raeburn   478:             $tremark='';
                    479:             $tpstart='&nbsp;';
                    480:             $tpend='&nbsp;';
                    481:             $tfont='#000000';
1.4       www       482:             if ($tstart) {
1.74      www       483:                 $tpstart=&Apache::lonlocal::locallocaltime($tstart);
1.4       www       484:             }
                    485:             if ($tend) {
1.74      www       486:                 $tpend=&Apache::lonlocal::locallocaltime($tend);
1.4       www       487:             }
1.118     albertel  488:             if ($env{'request.role'} eq $trolecode) {
1.6       www       489: 		$tstatus='selected';
                    490:             }
1.4       www       491:             my $tbg;
1.164     albertel  492:             if (($tstatus eq 'is') 
                    493: 		|| ($tstatus eq 'selected') 
                    494: 		|| ($tstatus eq 'will') 
                    495: 		|| ($tstatus eq 'future') 
                    496:                 || ($env{'form.showall'})) {
1.35      matthew   497:                 if ($tstatus eq 'is') {
                    498:                     $tbg='#77FF77';
1.47      www       499:                     $tfont='#003300';
1.84      www       500: 		    $possiblerole=$trolecode;
                    501: 		    $countactive++;
1.35      matthew   502:                 } elsif ($tstatus eq 'future') {
                    503:                     $tbg='#FFFF77';
1.49      www       504:                     $button=0;
1.35      matthew   505:                 } elsif ($tstatus eq 'will') {
                    506:                     $tbg='#FFAA77';
1.72      www       507:                     $tremark.=&mt('Active at next login. ');
1.35      matthew   508:                 } elsif ($tstatus eq 'expired') {
                    509:                     $tbg='#FF7777';
1.47      www       510:                     $tfont='#330000';
1.49      www       511:                     $button=0;
1.35      matthew   512:                 } elsif ($tstatus eq 'will_not') {
                    513:                     $tbg='#AAFF77';
1.72      www       514:                     $tremark.=&mt('Expired after logout. ');
1.35      matthew   515:                 } elsif ($tstatus eq 'selected') {
                    516:                     $tbg='#11CC55';
1.47      www       517:                     $tfont='#002200';
1.84      www       518: 		    $inrole=1;
1.86      albertel  519: 		    $countactive++;
1.72      www       520:                     $tremark.=&mt('Currently selected. ');
1.35      matthew   521:                 }
                    522:                 my $trole;
                    523:                 if ($role =~ /^cr\//) {
                    524:                     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
1.132     albertel  525: 		    if ($tremark) { $tremark.='<br />'; }
                    526:                     $tremark.=&mt('Defined by ').$rauthor.
1.72      www       527: 			&mt(' at ').$rdomain.'.';
1.159     albertel  528: 		}
                    529: 		$trole=Apache::lonnet::plaintext($role);
1.35      matthew   530:                 my $ttype;
                    531:                 my $twhere;
                    532:                 my ($tdom,$trest,$tsection)=
                    533:                     split(/\//,Apache::lonnet::declutter($where));
                    534:                 # First, Co-Authorship roles
1.125     www       535:                 if (($role eq 'ca') || ($role eq 'aa')) {
1.39      stredwic  536:                     my $home = &Apache::lonnet::homeserver($trest,$tdom);
1.83      albertel  537: 		    my $allowed=0;
                    538: 		    my @ids=&Apache::lonnet::current_machine_ids();
                    539: 		    foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                    540:                     if (!$allowed) {
1.49      www       541: 			$button=0;
1.130     albertel  542:                         $switchserver='otherserver='.$home.'&role='.$trolecode;
1.49      www       543:                     }
1.35      matthew   544:                     #next if ($home eq 'no_host');
1.176     albertel  545:                     $home = &Apache::lonnet::hostname($home);
1.78      sakharuk  546:                     $ttype='Construction Space';
1.72      www       547:                     $twhere=&mt('User').': '.$trest.'<br />'.&mt('Domain').
                    548: 			': '.$tdom.'<br />'.
                    549:                         ' '.&mt('Server').':&nbsp;'.$home;
1.118     albertel  550:                     $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
1.82      www       551: 		    $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/');
1.75      albertel  552: 		    $sortkey=$role."$trest:$tdom";
1.35      matthew   553:                 } elsif ($role eq 'au') {
                    554:                     # Authors
                    555:                     my $home = &Apache::lonnet::homeserver
1.118     albertel  556:                         ($env{'user.name'},$env{'user.domain'});
1.83      albertel  557: 		    my $allowed=0;
                    558: 		    my @ids=&Apache::lonnet::current_machine_ids();
                    559: 		    foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
                    560:                     if (!$allowed) {
1.49      www       561: 			$button=0;
1.143     albertel  562:                         $switchserver='otherserver='.$home.'&role='.$trolecode;
1.49      www       563:                     }
1.35      matthew   564:                     #next if ($home eq 'no_host');
1.176     albertel  565:                     $home = &Apache::lonnet::hostname($home);
1.78      sakharuk  566:                     $ttype='Construction Space';
1.72      www       567:                     $twhere=&mt('Domain').': '.$tdom.'<br />'.&mt('Server').
                    568: 			':&nbsp;'.$home;
1.118     albertel  569:                     $env{'course.'.$tdom.'_'.$trest.'.description'}='ca';
                    570: 		    $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/');
1.75      albertel  571: 		    $sortkey=$role;
1.35      matthew   572:                 } elsif ($trest) {
                    573:                     my $tcourseid=$tdom.'_'.$trest;
1.153     raeburn   574:                     $ttype = &Apache::loncommon::course_type($tcourseid);
                    575:                     $trole = &Apache::lonnet::plaintext($role,$ttype);
1.118     albertel  576:                     if ($env{'course.'.$tcourseid.'.description'}) {
                    577:                         $twhere=$env{'course.'.$tcourseid.'.description'};
1.80      albertel  578: 			$sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
1.72      www       579:                         unless ($twhere eq &mt('Currently not available')) {
1.55      albertel  580: 			    $twhere.=' <font size="-2">'.
1.72      www       581:         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont).
1.49      www       582:                                     '</font>';
1.55      albertel  583: 			}
1.8       www       584:                     } else {
1.105     raeburn   585:                         my %newhash=&Apache::lonnet::coursedescription($tcourseid);
1.35      matthew   586:                         if (%newhash) {
1.80      albertel  587: 			    $sortkey=$role."\0".$tdom."\0".$newhash{'description'}.
1.77      albertel  588: 				"\0".$envkey;
1.49      www       589:                             $twhere=$newhash{'description'}.
                    590:                               ' <font size="-2">'.
1.72      www       591:         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom,$tfont).
1.49      www       592:                               '</font>';
1.152     raeburn   593:                             $ttype = $newhash{'type'};
1.153     raeburn   594:                             $trole = &Apache::lonnet::plaintext($role,$ttype);
1.35      matthew   595:                         } else {
1.72      www       596:                             $twhere=&mt('Currently not available');
1.118     albertel  597:                             $env{'course.'.$tcourseid.'.description'}=$twhere;
1.80      albertel  598: 			    $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey;
1.152     raeburn   599:                             $ttype = 'Unavailable';
1.35      matthew   600:                         }
1.8       www       601:                     }
1.121     albertel  602:                     if ($tsection) {
1.175     albertel  603:                         $twhere.='<br />'.&mt('Section').': '.$tsection;
1.121     albertel  604: 		    }
1.72      www       605: 		    if ($role ne 'st') { $twhere.="<br />".&mt('Domain').":".$tdom; }
1.35      matthew   606:                 } elsif ($tdom) {
1.78      sakharuk  607:                     $ttype='Domain';
1.35      matthew   608:                     $twhere=$tdom;
1.75      albertel  609: 		    $sortkey=$role.$twhere;
1.35      matthew   610:                 } else {
1.78      sakharuk  611:                     $ttype='System';
1.72      www       612:                     $twhere=&mt('system wide');
1.75      albertel  613: 		    $sortkey=$role.$twhere;
1.13      www       614:                 }
1.152     raeburn   615:                 $roletext.=&build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$tfont,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver);
1.75      albertel  616: 		$roletext{$envkey}=$roletext;
                    617: 		if (!$sortkey) {$sortkey=$twhere."\0".$envkey;}
                    618: 		$sortrole{$sortkey}=$envkey;
                    619: 		$roleclass{$envkey}=$ttype;
1.55      albertel  620: 	    }
1.4       www       621:         }
1.75      albertel  622:     }
1.84      www       623: # No active roles
                    624:     if ($countactive==0) {
                    625: 	if ($inrole) {
                    626: 	    $r->print('<h2>'.&mt('Currently no additional roles or courses').'</h2>');
                    627: 	} else {
                    628: 	    $r->print('<h2>'.&mt('Currently no active roles or courses').'</h2>');
                    629: 	}
1.147     albertel  630: 	$r->print('</form>'.&Apache::loncommon::end_page());
1.84      www       631: 	return OK;
                    632: # Is there only one choice?
1.118     albertel  633:     } elsif (($countactive==1) && ($env{'request.role'} eq 'cm')) {
1.84      www       634: 	$r->print('<h3>'.&mt('Please stand by.').'</h3>'.
1.179     raeburn   635: 	    '<input type="hidden" name="'.$possiblerole.'" value="1" />'.
                    636:             '<noscript><br /><input type="submit" name="submit" value="'.&mt('Continue').'" /></noscript>');
1.84      www       637: 	$r->print("</form>\n");
                    638: 	$r->rflush();
1.179     raeburn   639: 	$r->print('<script type="text/javascript">document.forms.rolechoice.submit();</script>');
1.147     albertel  640: 	$r->print(&Apache::loncommon::end_page());
1.84      www       641: 	return OK;
                    642:     }
                    643: # More than one possible role
                    644: # ----------------------------------------------------------------------- Table
1.181     albertel  645:     unless ((!&Apache::lonmenu::show_course()) || ($nochoose)) {
1.173     albertel  646: 	$r->print("<h2>".&mt('Select a Course to Enter')."</h2>\n");
1.84      www       647:     }
1.177     www       648:     $r->print('<br /><table id="LC_rolesmenu"><tr>');
1.84      www       649:     unless ($nochoose) { $r->print('<th>&nbsp;</th>'); }
1.121     albertel  650:     $r->print('<th>'.&mt('User Role').'</th><th>'.&mt('Extent').
1.132     albertel  651:          '</th><th>'.&mt('Start').'</th><th>'.&mt('End').'</th></tr>'."\n");
1.76      albertel  652:     my $doheaders=-1;
1.173     albertel  653:     foreach my $type ('Domain','Construction Space','Course','Unavailable','System') {
1.76      albertel  654: 	my $haverole=0;
1.75      albertel  655: 	foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
                    656: 	    if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { 
1.76      albertel  657: 		$haverole=1;
1.75      albertel  658: 	    }
1.76      albertel  659: 	}
                    660: 	if ($haverole) { $doheaders++; }
                    661:     }
1.111     albertel  662: 
1.118     albertel  663:     if ($env{'environment.recentroles'}) {
1.111     albertel  664:         my %recent_roles =
1.118     albertel  665:                &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'});
1.111     albertel  666: 	my $output='';
                    667: 	foreach (sort(keys(%recent_roles))) {
                    668: 	    if (defined($roletext{'user.role.'.$_})) {
                    669: 		$output.=$roletext{'user.role.'.$_};
1.170     albertel  670:                 if ($_ =~ m-dc\./($match_domain)/- 
                    671: 		    && $dcroles{$1}) {
1.138     raeburn   672: 		    $output .= &allcourses_row($1,'recent');
1.133     albertel  673:                 }
1.113     raeburn   674: 	    } elsif ($numdc > 0) {
                    675:                 unless ($_ =~/^error\:/) {
                    676:                     $output.=&display_cc_role('user.role.'.$_);
                    677:                 }
                    678:             } 
1.111     albertel  679: 	}
                    680: 	if ($output) {
1.132     albertel  681: 	    $r->print("<tr><td align='center' colspan='5'><font face='arial'>".
1.126     www       682: 		      &mt('Recent Roles')."</font></td>");
1.111     albertel  683: 	    $r->print($output);
                    684: 	    $r->print("</tr>");
1.114     raeburn   685:             $doheaders ++;
1.111     albertel  686: 	}
                    687:     }
                    688: 
1.104     raeburn   689:     if ($numdc > 0) {
1.112     raeburn   690:         $r->print(&coursepick_jscript());
                    691:         $r->print(&Apache::loncommon::coursebrowser_javascript());
1.108     raeburn   692:     }
1.173     albertel  693:     foreach my $type ('Construction Space','Domain','Course','Unavailable','System') {
1.108     raeburn   694: 	my $output;
                    695: 	foreach my $which (sort {uc($a) cmp uc($b)} (keys(%sortrole))) {
                    696: 	    if ($roleclass{$sortrole{$which}} =~ /^\Q$type\E/) { 
                    697: 		$output.=$roletext{$sortrole{$which}};
1.170     albertel  698:                 if ($sortrole{$which} =~ m-dc\./($match_domain)/-) {
1.108     raeburn   699:                     if ($dcroles{$1}) {
1.138     raeburn   700:                         $output .= &allcourses_row($1,'');
1.104     raeburn   701:                     }
                    702:                 }
1.76      albertel  703: 	    }
1.108     raeburn   704: 	}
                    705: 	if ($output) {
                    706: 	    if ($doheaders > 0) {
1.126     www       707: 		$r->print("<tr>".
1.132     albertel  708: 			  "<td align='center' colspan='5'><font face='arial'>".&mt($type)."</font></td></tr>");
1.76      albertel  709: 	    }
1.108     raeburn   710: 	    $r->print($output);	
                    711: 	}
1.4       www       712:     }
1.14      www       713:     my $tremark='';
1.47      www       714:     my $tfont='#003300';
1.118     albertel  715:     if ($env{'request.role'} eq 'cm') {
1.19      www       716: 	$r->print('<tr bgcolor="#11CC55">');
1.72      www       717:         $tremark=&mt('Currently selected. ');
1.47      www       718:         $tfont='#002200';
1.14      www       719:     } else {
                    720:         $r->print('<tr bgcolor="#77FF77">');
                    721:     }
                    722:     unless ($nochoose) {
1.118     albertel  723: 	if ($env{'request.role'} ne 'cm') {
1.134     www       724: 	    $r->print('<td><input type="submit" value="'.
1.72      www       725: 		      &mt('Select').'" name="cm"></td>');
1.55      albertel  726: 	} else {
                    727: 	    $r->print('<td>&nbsp;</td>');
                    728: 	}
1.14      www       729:     }
1.177     www       730:     $r->print('<td colspan="3"><font color="'.$tfont.'"><span class="LC_rolesinfo">'.&mt('No role specified').
                    731:       '</font></span></td><td><font color="'.$tfont.'">'.$tremark.
1.47      www       732:       '&nbsp;</font></td></tr>'."\n");
1.4       www       733: 
                    734:     $r->print('</table>');
                    735:     unless ($nochoose) {
                    736: 	$r->print("</form>\n");
                    737:     }
1.22      harris41  738: # ------------------------------------------------------------ Privileges Info
1.118     albertel  739:     if (($advanced) && (($env{'user.error.msg'}) || ($error))) {
1.127     albertel  740: 	$r->print('<hr /><h2>Current Privileges</h2>');
1.175     albertel  741: 	$r->print(&privileges_info());
1.4       www       742:     }
1.66      www       743:     $r->print(&Apache::lonnet::getannounce());
1.65      www       744:     if ($advanced) {
                    745: 	$r->print('<p><small><i>This is LON-CAPA '.
1.85      www       746: 		  $r->dir_config('lonVersion').'</i><br />'.
                    747: 		  '<a href="/adm/logout">'.&mt('Logout').'</a></small></p>');
1.65      www       748:     }
1.147     albertel  749:     $r->print(&Apache::loncommon::end_page());
1.1       harris41  750:     return OK;
1.102     raeburn   751: }
                    752: 
1.175     albertel  753: sub privileges_info {
                    754:     my ($which) = @_;
                    755:     my $output;
                    756: 
                    757:     $which ||= $env{'request.role'};
                    758: 
                    759:     foreach my $envkey (sort(keys(%env))) {
                    760: 	next if ($envkey!~/^user\.priv\.\Q$which\E\.(.*)/);
                    761: 
                    762: 	my $where=$1;
                    763: 	my $ttype;
                    764: 	my $twhere;
                    765: 	my (undef,$tdom,$trest,$tsec)=split(m{/},$where);
                    766: 	if ($trest) {
                    767: 	    if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
                    768: 		$ttype='Construction Space';
                    769: 		$twhere='User: '.$trest.', Domain: '.$tdom;
                    770: 	    } else {
                    771: 		$ttype= &Apache::loncommon::course_type($tdom.'_'.$trest);
                    772: 		$twhere=$env{'course.'.$tdom.'_'.$trest.'.description'};
                    773: 		if ($tsec) {
                    774: 		    my $sec_type = 'Section';
                    775: 		    if (exists($env{"user.role.gr.$where"})) {
                    776: 			$sec_type = 'Group';
                    777: 		    }
                    778: 		    $twhere.=' ('.$sec_type.': '.$tsec.')';
                    779: 		}
                    780: 	    }
                    781: 	} elsif ($tdom) {
                    782: 	    $ttype='Domain';
                    783: 	    $twhere=$tdom;
                    784: 	} else {
                    785: 	    $ttype='System';
                    786: 	    $twhere='/';
                    787: 	}
                    788: 	$output .= "\n<h3>".$ttype.': '.$twhere.'</h3>'."\n<ul>";
                    789: 	foreach my $priv (sort(split(/:/,$env{$envkey}))) {
                    790: 	    next if (!$priv);
                    791: 
                    792: 	    my ($prv,$restr)=split(/\&/,$priv);
                    793: 	    my $trestr='';
                    794: 	    if ($restr ne 'F') {
                    795: 		$trestr.=' ('.
                    796: 		    join(', ',
                    797: 			 map { &Apache::lonnet::plaintext($_) } 
                    798: 			     (split('',$restr))).') ';
                    799: 	    }
                    800: 	    $output .= "\n\t".
                    801: 		'<li>'.&Apache::lonnet::plaintext($prv).$trestr.'</li>';
                    802: 	}
                    803: 	$output .= "\n".'</ul>';
                    804:     }
                    805:     return $output;
                    806: }
                    807: 
1.102     raeburn   808: sub role_status {
                    809:     my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
                    810:     my @pwhere = ();
1.118     albertel  811:     if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
1.102     raeburn   812:         (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
                    813:         unless (!defined($$role) || $$role eq '') {
                    814:             $$where=join('.',@pwhere);
                    815:             $$trolecode=$$role.'.'.$$where;
1.118     albertel  816:             ($$tstart,$$tend)=split(/\./,$env{$rolekey});
1.102     raeburn   817:             $$tstatus='is';
1.105     raeburn   818:             if ($$tstart && $$tstart>$then) {
                    819: 		$$tstatus='future';
                    820: 		if ($$tstart<$now) { $$tstatus='will'; }
1.102     raeburn   821:             }
                    822:             if ($$tend) {
                    823:                 if ($$tend<$then) {
                    824:                     $$tstatus='expired';
1.103     raeburn   825:                 } elsif ($$tend<$now) {
1.104     raeburn   826:                     $$tstatus='will_not';
1.102     raeburn   827:                 }
                    828:             }
                    829:         }
                    830:     }
                    831: }
1.1       harris41  832: 
1.110     raeburn   833: sub build_roletext {
1.152     raeburn   834:     my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$tfont,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver) = @_;
1.177     www       835:     my $roletext='<tr bgcolor="'.$tbg.'" class="LC_rolesmenu_'.$tstatus.'">';
1.132     albertel  836:     my $is_dc=($trolecode =~ m/^dc\./);
                    837:     my $rowspan=($is_dc) ? ''
                    838:                          : ' rowspan="2" ';
                    839: 
1.110     raeburn   840:     unless ($nochoose) {
1.134     www       841:         my $buttonname=$trolecode;
                    842:         $buttonname=~s/\W//g;
1.110     raeburn   843:         if (!$button) {
                    844:             if ($switchserver) {
1.177     www       845:                 $roletext.='<td'.$rowspan.'><span class="LC_rolesinfo"><a href="/adm/switchserver?'.
                    846:                 $switchserver.'">'.&mt('Switch Server').'</a></span></td>';
1.110     raeburn   847:             } else {
1.164     albertel  848:                 $roletext.=('<td'.$rowspan.'>&nbsp;</td>');
1.110     raeburn   849:             }
                    850:         } elsif ($tstatus eq 'is') {
1.134     www       851:             $roletext.='<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'.
                    852:                         &mt('Select').'" onClick="javascript:enterrole(this.form,\''.
                    853:                         $trolecode."','".$buttonname.'\');"></td>';
1.110     raeburn   854:         } elsif ($tryagain) {
                    855:             $roletext.=
1.134     www       856:                 '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'.
                    857:                 &mt('Try Selecting Again').'" onClick="javascript:enterrole(this.form,\''.
                    858:                         $trolecode."','".$buttonname.'\');"></td>';
1.110     raeburn   859:         } elsif ($advanced) {
                    860:             $roletext.=
1.134     www       861:                 '<td'.$rowspan.'><input name="'.$buttonname.'" type="button" value="'.
                    862:                 &mt('Re-Initialize').'" onClick="javascript:enterrole(this.form,\''.
                    863:                         $trolecode."','".$buttonname.'\');"></td>';
1.110     raeburn   864:         } else {
1.132     albertel  865:             $roletext.='<td'.$rowspan.'>&nbsp;</td>';
1.110     raeburn   866:         }
                    867:     }
1.165     albertel  868:     if ($trolecode !~ m/^(dc|ca|au|aa)\./) {
                    869: 	$tremark.=&Apache::lonannounce::showday(time,1,
                    870: 			 &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
                    871:     }
1.110     raeburn   872:     $roletext.='<td><font color="'.$tfont.'">'.$trole.
1.121     albertel  873: 	       '</font></td><td><font color="'.$tfont.'">'.$twhere.
1.110     raeburn   874:                '</font></td><td><font color="'.$tfont.'">'.$tpstart.
                    875:                '</font></td><td><font color="'.$tfont.'">'.$tpend.
1.132     albertel  876:                '</font></td></tr>';
                    877:     if (!$is_dc) {
1.177     www       878: 	$roletext.='<tr bgcolor="'.$tbg.'"><td colspan="4"><font color="'.$tfont.'"><span class="LC_rolesinfo">'.$tremark.
                    879: 	    '</span>&nbsp;</font></td></tr><tr><td colspan="5" height="3"></td></tr>'."\n";
1.132     albertel  880:     }
1.110     raeburn   881:     return $roletext;
                    882: }
                    883: 
                    884: sub check_privs {
1.146     raeburn   885:     my ($cdom,$cnum,$then,$now) = @_;
                    886:     my $cckey = 'user.role.cc./'.$cdom.'/'.$cnum; 
1.118     albertel  887:     if ($env{$cckey}) {
1.110     raeburn   888:         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend,$tfont);
                    889:         &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
                    890:         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
1.146     raeburn   891:             &set_privileges($cdom,$cnum);
1.110     raeburn   892:         }
                    893:     } else {
1.146     raeburn   894:         &set_privileges($cdom,$cnum);
1.110     raeburn   895:     }
                    896: }
                    897: 
1.104     raeburn   898: sub check_fordc {
                    899:     my ($dcroles,$then) = @_;
                    900:     my $numdc = 0;
1.118     albertel  901:     if ($env{'user.adv'}) {
                    902:         foreach my $envkey (sort keys %env) {
1.170     albertel  903:             if ($envkey=~/^user\.role\.dc\.\/($match_domain)\/$/) {
1.104     raeburn   904:                 my $dcdom = $1;
                    905:                 my $livedc = 1;
1.118     albertel  906:                 my ($tstart,$tend)=split(/\./,$env{$envkey});
1.105     raeburn   907:                 if ($tstart && $tstart>$then) { $livedc = 0; }
                    908:                 if ($tend   && $tend  <$then) { $livedc = 0; }
1.104     raeburn   909:                 if ($livedc) {
                    910:                     $$dcroles{$dcdom} = $envkey;
1.105     raeburn   911:                     $numdc++;
1.104     raeburn   912:                 }
                    913:             }
                    914:         }
                    915:     }
                    916:     return $numdc;
                    917: }
                    918: 
1.108     raeburn   919: sub courselink {
1.152     raeburn   920:     my ($dcdom,$rowtype,$selecttype) = @_;
1.109     raeburn   921:     my $courseform=&Apache::loncommon::selectcourse_link
1.152     raeburn   922:                    ('rolechoice','dccourse'.$rowtype.'_'.$dcdom,
                    923:                     'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.
1.173     albertel  924:                     $dcdom,$dcdom,undef);
1.138     raeburn   925:     my $hiddenitems = '<input type="hidden" name="dcdomain'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
                    926:                       '<input type="hidden" name="origdom'.$rowtype.'_'.$dcdom.'" value="'.$dcdom.'" />'.
                    927:                       '<input type="hidden" name="dccourse'.$rowtype.'_'.$dcdom.'" value="" />'.
                    928:                       '<input type="hidden" name="coursedesc'.$rowtype.'_'.$dcdom.'" value="" />';
1.112     raeburn   929:     return $courseform.$hiddenitems;
1.109     raeburn   930: }
                    931: 
                    932: sub coursepick_jscript {
1.181.2.1  raeburn   933:     my %lt = &Apache::lonlocal::texthash(
                    934:                   plsu => "Please use the 'Select Course' link to open a separate pick course window where you may select the course you wish to enter.",
                    935:                   youc => 'You can only use this screen to select courses in the current domain.',
                    936:             );
1.104     raeburn   937:     my $verify_script = <<"END";
1.179     raeburn   938: <script type="text/javascript">
1.108     raeburn   939: function verifyCoursePick(caller) {
                    940:     var numbutton = getIndex(caller)
1.112     raeburn   941:     var pickedCourse = document.rolechoice.elements[numbutton+4].value
                    942:     var pickedDomain = document.rolechoice.elements[numbutton+2].value
                    943:     if (document.rolechoice.elements[numbutton+2].value == document.rolechoice.elements[numbutton+3].value) {
1.104     raeburn   944:         if (pickedCourse != '') {
1.108     raeburn   945:             if (numbutton != -1) {
                    946:                 var courseTarget = "cc./"+pickedDomain+"/"+pickedCourse
                    947:                 document.rolechoice.elements[numbutton+1].name = courseTarget
                    948:                 document.rolechoice.submit()
                    949:             }
1.104     raeburn   950:         }
                    951:         else {
1.181.2.1  raeburn   952:             alert("$lt{'plsu'}");
1.104     raeburn   953:         }
                    954:     }
                    955:     else {
1.181.2.1  raeburn   956:         alert("$lt{'youc'}");
1.104     raeburn   957:     }
                    958: }
1.109     raeburn   959: function getIndex(caller) {
1.108     raeburn   960:     for (var i=0;i<document.rolechoice.elements.length;i++) {
1.109     raeburn   961:         if (document.rolechoice.elements[i] == caller) {
1.108     raeburn   962:             return i;
                    963:         }
                    964:     }
                    965:     return -1;
                    966: }
1.104     raeburn   967: </script>
                    968: END
1.109     raeburn   969:     return $verify_script;
1.104     raeburn   970: }
                    971: 
1.113     raeburn   972: sub display_cc_role {
                    973:     my $rolekey = shift;
                    974:     my $roletext;
1.118     albertel  975:     my $advanced = $env{'user.adv'};
                    976:     my $tryagain = $env{'form.tryagain'};
1.113     raeburn   977:     unless ($rolekey =~/^error\:/) {
1.171     albertel  978:         if ($rolekey =~ m-^user\.role.cc\./($match_domain)/($match_courseid)$-) {
1.113     raeburn   979:             my $tcourseid = $1.'_'.$2;
                    980:             my $trolecode = 'cc./'.$1.'/'.$2;
                    981:             my $twhere;
1.152     raeburn   982:             my $ttype;
1.113     raeburn   983:             my $tbg='#77FF77';
                    984:             my $tfont='#003300';
                    985:             my %newhash=&Apache::lonnet::coursedescription($tcourseid);
                    986:             if (%newhash) {
                    987:                 $twhere=$newhash{'description'}.
                    988:                         ' <font size="-2">'.
                    989:                         &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$2,$1,$tfont).
                    990:                         '</font>';
1.153     raeburn   991:                 $ttype = $newhash{'type'};
1.113     raeburn   992:             } else {
                    993:                 $twhere=&mt('Currently not available');
1.118     albertel  994:                 $env{'course.'.$tcourseid.'.description'}=$twhere;
1.110     raeburn   995:             }
1.153     raeburn   996:             my $trole = &Apache::lonnet::plaintext('cc',$ttype);
1.113     raeburn   997:             $twhere.="<br />".&mt('Domain').":".$1;
1.152     raeburn   998:             $roletext = &build_roletext($trolecode,$1,$2,'is',$tryagain,$advanced,'',$tbg,$tfont,$trole,$twhere,'','','',1,'');
1.104     raeburn   999:         }
                   1000:     }
1.152     raeburn  1001:     return ($roletext);
1.104     raeburn  1002: }
                   1003: 
1.108     raeburn  1004: sub allcourses_row {
1.138     raeburn  1005:     my ($dcdom,$rowtype) = @_;
1.132     albertel 1006:     my $output = '<tr bgcolor="#77FF77">'.
1.152     raeburn  1007:                  ' <td colspan="5">';
1.173     albertel 1008:     my $selectlink = &courselink($dcdom,$rowtype);
                   1009:     my $ccrole = &Apache::lonnet::plaintext('cc');
1.177     www      1010:     $output.= '<span class="LC_rolesinfo">'.
                   1011:             &mt('[_1]: [_2] from domain [_3]',$ccrole,$selectlink,$dcdom).
                   1012:             '</span><br /></tr><tr><td colspan="5" height="3"></td></tr>'."\n";
1.108     raeburn  1013:     return $output;
                   1014: }
                   1015: 
1.104     raeburn  1016: sub recent_filename {
                   1017:     my $area=shift;
1.149     www      1018:     return 'nohist_recent_'.&escape($area);
1.104     raeburn  1019: }
                   1020: 
1.106     raeburn  1021: sub set_privileges {
                   1022:     my ($dcdom,$pickedcourse) = @_;
                   1023:     my $area = '/'.$dcdom.'/'.$pickedcourse;
                   1024:     my $role = 'cc';
                   1025:     my $spec = $role.'.'.$area;
1.168     albertel 1026:     my %userroles = &Apache::lonnet::set_arearole($role,$area,'','',
                   1027: 						  $env{'user.domain'},
                   1028: 						  $env{'user.name'});
1.106     raeburn  1029:     my %ccrole = ();
                   1030:     &Apache::lonnet::standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
1.154     albertel 1031:     my ($author,$adv)= &Apache::lonnet::set_userprivs(\%userroles,\%ccrole);
                   1032:     &Apache::lonnet::appenv(%userroles);
1.118     albertel 1033:     &Apache::lonnet::log($env{'user.domain'},
                   1034:                          $env{'user.name'},
                   1035:                          $env{'user.home'},
1.106     raeburn  1036:                         "Role ".$role);
                   1037:     &Apache::lonnet::appenv(
1.146     raeburn  1038:                           'request.role'        => $spec,
1.106     raeburn  1039:                           'request.role.domain' => $dcdom,
                   1040:                           'request.course.sec'  => '');
                   1041:     my $tadv=0;
                   1042:     if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
                   1043:     &Apache::lonnet::appenv('request.role.adv'    => $tadv);
                   1044: }
                   1045: 
1.139     raeburn  1046: sub courseloadpage {
                   1047:     my ($courseid) = @_;
                   1048:     my $startpage;
1.144     albertel 1049:     my %entry_settings = &Apache::lonnet::get('nohist_whatsnew',
                   1050: 					      [$courseid.':courseinit']);
1.139     raeburn  1051:     my ($tmp) = %entry_settings;
1.144     albertel 1052:     unless ($tmp =~ /^error: 2 /) {
1.139     raeburn  1053:         $startpage = $entry_settings{$courseid.':courseinit'};
                   1054:     }
                   1055:     if ($startpage eq '') {
                   1056:         if (exists($env{'environment.course_init_display'})) {
                   1057:             $startpage = $env{'environment.course_init_display'};
                   1058:         }
                   1059:     }
                   1060:     return $startpage;
                   1061: }
                   1062: 
1.1       harris41 1063: 1;
                   1064: __END__
1.32      harris41 1065: 
                   1066: =head1 NAME
                   1067: 
                   1068: Apache::lonroles - User Roles Screen
                   1069: 
                   1070: =head1 SYNOPSIS
                   1071: 
                   1072: Invoked by /etc/httpd/conf/srm.conf:
                   1073: 
                   1074:  <Location /adm/roles>
                   1075:  PerlAccessHandler       Apache::lonacc
                   1076:  SetHandler perl-script
                   1077:  PerlHandler Apache::lonroles
                   1078:  ErrorDocument     403 /adm/login
                   1079:  ErrorDocument	  500 /adm/errorhandler
                   1080:  </Location>
1.64      bowersj2 1081: 
                   1082: =head1 OVERVIEW
                   1083: 
                   1084: =head2 Choosing Roles
                   1085: 
                   1086: C<lonroles> is a handler that allows a user to switch roles in
                   1087: mid-session. LON-CAPA attempts to work with "No Role Specified", the
                   1088: default role that a user has before selecting a role, as widely as
                   1089: possible, but certain handlers for example need specification which
                   1090: course they should act on, etc. Both in this scenario, and when the
                   1091: handler determines via C<lonnet>'s C<&allowed> function that a certain
                   1092: action is not allowed, C<lonroles> is used as error handler. This
                   1093: allows the user to select another role which may have permission to do
                   1094: what they were trying to do. C<lonroles> can also be accessed via the
                   1095: B<CRS> button in the Remote Control. 
                   1096: 
                   1097: =begin latex
                   1098: 
                   1099: \begin{figure}
                   1100: \begin{center}
                   1101: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
                   1102:   \caption{\label{Sample_Roles_Screen}Sample Roles Screen} 
                   1103: \end{center}
                   1104: \end{figure}
                   1105: 
                   1106: =end latex
                   1107: 
                   1108: =head2 Role Initialization
                   1109: 
                   1110: 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.
1.32      harris41 1111: 
                   1112: =head1 INTRODUCTION
                   1113: 
                   1114: This module enables a user to select what role he wishes to
                   1115: operate under (instructor, student, teaching assistant, course
                   1116: coordinator, etc).  These roles are pre-established by the actions
                   1117: of upper-level users.
                   1118: 
                   1119: This is part of the LearningOnline Network with CAPA project
                   1120: described at http://www.lon-capa.org.
                   1121: 
                   1122: =head1 HANDLER SUBROUTINE
                   1123: 
                   1124: This routine is called by Apache and mod_perl.
                   1125: 
                   1126: =over 4
                   1127: 
                   1128: =item *
                   1129: 
                   1130: Roles Initialization (yes/no)
                   1131: 
                   1132: =item *
                   1133: 
                   1134: Get Error Message from Environment
                   1135: 
                   1136: =item *
                   1137: 
                   1138: Who is this?
                   1139: 
                   1140: =item *
                   1141: 
                   1142: Generate Page Output
                   1143: 
                   1144: =item *
                   1145: 
                   1146: Choice or no choice
                   1147: 
                   1148: =item *
                   1149: 
                   1150: Table
                   1151: 
                   1152: =item *
                   1153: 
                   1154: Privileges
                   1155: 
                   1156: =back
                   1157: 
                   1158: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.