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

1.1       harris41    1: # The LearningOnline Network with CAPA
                      2: # User Roles Screen
1.31      www         3: #
1.65    ! www         4: # $Id: lonroles.pm,v 1.64 2003/07/25 01:16:29 bowersj2 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.1       harris41   28: # (Directory Indexer
                     29: # (Login Screen
1.32      harris41   30: # YEAR=1999
1.1       harris41   31: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
                     32: # 11/23 Gerd Kortemeyer)
1.32      harris41   33: # YEAR=2000
1.7       www        34: # 1/14,03/06,06/01,07/22,07/24,07/25,
1.19      www        35: # 09/04,09/06,09/28,09/29,09/30,10/2,10/5,10/26,10/28,
1.20      www        36: # 12/08,12/28,
1.32      harris41   37: # YEAR=2001
1.20      www        38: # 01/15/01 Gerd Kortemeyer
1.28      www        39: # 03/02,05/03,05/25,05/30,06/01,07/06,08/06 Gerd Kortemeyer
1.33      www        40: # 12/29 Gerd Kortemeyer
1.32      harris41   41: #
                     42: ###
1.22      harris41   43: 
1.1       harris41   44: package Apache::lonroles;
                     45: 
                     46: use strict;
                     47: use Apache::lonnet();
1.7       www        48: use Apache::lonuserstate();
1.1       harris41   49: use Apache::Constants qw(:common);
1.2       www        50: use Apache::File();
1.26      www        51: use Apache::lonmenu;
1.29      albertel   52: use Apache::loncommon;
1.57      www        53: use Apache::lonannounce;
1.1       harris41   54: 
1.62      matthew    55: sub redirect_user {
                     56:     my ($r,$title,$url,$msg) = @_;
                     57:     $msg = $title if (! defined($msg));
                     58:     $r->content_type('text/html');
                     59:     &Apache::loncommon::no_cache($r);
                     60:     $r->send_http_header;
                     61:     my $swinfo=&Apache::lonmenu::rawconfig();
                     62:     my $bodytag=&Apache::loncommon::bodytag('Switching Role');
                     63:     $r->print (<<ENDREDIR);
                     64: <head><title>$title</title>
                     65: <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$url">
                     66: </head>
                     67: <html>
                     68: $bodytag
                     69: <script>
                     70: $swinfo
                     71: </script>
                     72: <h1>$msg</h1>
                     73: </body>
                     74: </html>
                     75: ENDREDIR
                     76:     return;
                     77: }
                     78: 
1.1       harris41   79: sub handler {
1.10      www        80: 
1.1       harris41   81:     my $r = shift;
                     82: 
1.6       www        83:     my $now=time;
                     84:     my $then=$ENV{'user.login.time'};
                     85:     my $envkey;
                     86: 
1.10      www        87: 
1.6       www        88: # ================================================================== Roles Init
                     89: 
                     90:     if ($ENV{'form.selectrole'}) {
1.33      www        91: 	if ($ENV{'request.course.id'}) {
                     92: 	    my %temp=('logout_'.$ENV{'request.course.id'} => time);
                     93: 	    &Apache::lonnet::put('email_status',\%temp);
                     94:         }
1.55      albertel   95: 	&Apache::lonnet::appenv("request.course.id"   => '',
                     96: 				"request.course.fn"   => '',
                     97: 				"request.course.uri"  => '',
                     98: 				"request.course.sec"  => '',
                     99: 				"request.role"        => 'cm',
1.56      www       100:                                 "request.role.adv"    => $ENV{'user.adv'},
1.55      albertel  101: 				"request.role.domain" => $ENV{'user.domain'});
1.13      www       102:         foreach $envkey (keys %ENV) {
1.40      matthew   103:             next if ($envkey!~/^user\.role\./);
                    104: 	    my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
1.6       www       105:             my $where=join('.',@pwhere);
                    106:             my $trolecode=$role.'.'.$where;
                    107:             if ($ENV{'form.'.$trolecode}) {
1.55      albertel  108: 		my ($tstart,$tend)=split(/\./,$ENV{$envkey});
                    109: 		my $tstatus='is';
                    110: 		if ($tstart) {
                    111: 		    if ($tstart>$then) { 
                    112: 			$tstatus='future';
                    113: 		    }
                    114: 		}
                    115: 		if ($tend) {
                    116: 		    if ($tend<$then) { $tstatus='expired'; }
                    117: 		    if ($tend<$now) { $tstatus='will_not'; }
                    118: 		}
                    119: 		if ($tstatus eq 'is') {
                    120: 		    $where=~s/^\///;
                    121: 		    my ($cdom,$cnum,$csec)=split(/\//,$where);
1.53      www       122: # check for keyed access
1.55      albertel  123: 		    if (($role eq 'st') && 
                    124:                        ($ENV{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
                    125: 		         unless (&Apache::lonnet::validate_access_key(
                    126: 				     $ENV{'environment.key.'.$cdom.'_'.$cnum},
                    127: 					     $cdom,$cnum)) {
1.53      www       128: # there is no valid key
1.55      albertel  129: 			     if ($ENV{'form.newkey'}) {
1.53      www       130: # student attempts to register a new key
1.55      albertel  131: 			     } else {
1.53      www       132: # print form to enter a new key
1.55      albertel  133: 				 $r->content_type('text/html');
                    134: 				 &Apache::loncommon::no_cache($r);
                    135: 				 $r->send_http_header;
                    136: 				 my $swinfo=&Apache::lonmenu::rawconfig();
                    137: 				 my $bodytag=&Apache::loncommon::bodytag
                    138: 				    ('Enter Access Key to Unlock this Course');
                    139: 				 $r->print(<<ENDENTERKEY);
1.53      www       140: <head><title>Entering Course Access Key</title>
                    141: </head>
                    142: <html>
                    143: $bodytag
                    144: <script>
                    145: $swinfo
                    146: </script>
                    147: <form method="post">
                    148: <input type="hidden" name="selectrole" value="$ENV{'form.selectrole'}" />
                    149: <input type="text" size="20" name="newkey" value="$ENV{'form.newkey'}" />
                    150: <input type="submit" value="Enter key" />
                    151: </form>
                    152: </body></html>
                    153: ENDENTERKEY
1.55      albertel  154: 				 return OK;
                    155: 			     }
                    156: 			 }
                    157: 		     }
1.56      www       158:                     my $tadv=0;
                    159:                     if (($trolecode!~/^st/) && 
                    160:                         ($trolecode!~/^ta/) && 
                    161:                         ($trolecode!~/^cm/)) { $tadv=1; }
                    162: 		    &Apache::lonnet::appenv(
                    163:                                            'request.role'        => $trolecode,
                    164: 					   'request.role.adv'    => $tadv,
                    165: 					   'request.role.domain' => $cdom,
                    166: 					   'request.course.sec'  => $csec);
1.55      albertel  167: 		    my $msg='Entering course ...';
1.62      matthew   168: 
1.55      albertel  169: 		    if (($cnum) && ($role ne 'ca')) {
                    170: 			my ($furl,$ferr)=
                    171: 			    &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
                    172: 			if (($ENV{'form.orgurl'}) && 
                    173: 			    ($ENV{'form.orgurl'}!~/^\/adm\/flip/)) {
                    174: 			    $r->internal_redirect($ENV{'form.orgurl'});
                    175: 			    return OK;
                    176: 			} else {
                    177: 			    unless ($ENV{'request.course.id'}) {
                    178: 				&Apache::lonnet::appenv(
                    179: 				      "request.course.id"  => $cdom.'_'.$cnum);
1.61      www       180: 				$furl='/adm/roles?tryagain=1';
1.55      albertel  181: 				$msg=
1.60      www       182: 	 '<h1><font color=red>Could not initialize course at this time.</font></h1><h3>Please try again.</h3>';
1.55      albertel  183: 			    }
1.58      bowersj2  184: 
                    185: 			    # Check to see if the user is a CC entering a course 
                    186: 			    # for the first time
                    187: 			    my (undef, undef, $role, $courseid) = split(/\./, $envkey);
                    188: 			    if (substr($courseid, 0, 1) eq '/') {
                    189: 				$courseid = substr($courseid, 1);
                    190: 			    }
                    191: 			    $courseid =~ s/\//_/;
                    192: 			    if ($role eq 'cc' && $ENV{'course.' . $courseid . 
                    193: 							  '.course.helper.not.run'}) {
                    194: 				$furl = "/adm/helper/course.initialization.helper";
                    195: 			    }
1.62      matthew   196:                             #
                    197:                             # Send the user to the course they selected
                    198:                             &redirect_user($r,'Entering Course',
                    199:                                            $furl,$msg);
1.20      www       200:                             return OK;
1.55      albertel  201: 			}
                    202: 		    }
1.62      matthew   203:                     #
                    204:                     # Send the user to the construction space they selected
                    205:                     if ($role =~ /^(au|ca)$/) {
                    206:                         my $redirect_url = '/priv/';
                    207:                         if ($role eq 'au') {
                    208:                             $redirect_url.=$ENV{'user.name'};
                    209:                         } else {
                    210:                             $where =~ /\/(.*)$/;
                    211:                             $redirect_url .= $1;
                    212:                         }
                    213:                         $redirect_url .= '/';
                    214:                         &redirect_user($r,'Entering Construction Space',
                    215:                                        $redirect_url);
                    216:                         return OK;
                    217:                     }
1.55      albertel  218: 		}
                    219:             }
1.6       www       220:         }
1.40      matthew   221:     }
1.44      www       222: 
1.10      www       223: 
1.6       www       224: # =============================================================== No Roles Init
1.10      www       225: 
                    226:     $r->content_type('text/html');
1.30      albertel  227:     &Apache::loncommon::no_cache($r);
1.10      www       228:     $r->send_http_header;
                    229:     return OK if $r->header_only;
                    230: 
1.52      www       231:     my $swinfo=&Apache::lonmenu::rawconfig();
1.41      www       232:     my $bodytag=&Apache::loncommon::bodytag('User Roles');
1.48      www       233:     my $helptag=&Apache::loncommon::help_open_topic
1.52      www       234:      ("General_Intro","Click here for help");
1.10      www       235:     $r->print(<<ENDHEADER);
                    236: <html>
                    237: <head>
                    238: <title>LON-CAPA User Roles</title>
1.41      www       239: </head>
                    240: $bodytag
1.45      www       241: $helptag<br />
1.26      www       242: <script>
                    243: $swinfo
                    244: window.focus();
                    245: </script>
1.10      www       246: ENDHEADER
1.6       www       247: 
1.2       www       248: # ------------------------------------------ Get Error Message from Environment
                    249: 
                    250:     my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
1.12      www       251:     if ($ENV{'user.error.msg'}) {
1.55      albertel  252: 	$r->log_reason(
                    253:    "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
1.12      www       254:     }
1.1       harris41  255: 
1.61      www       256: # ------------------------------------------------- Can this user re-init, etc?
1.6       www       257: 
1.61      www       258:     my $advanced=$ENV{'user.adv'};
                    259:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['tryagain']);
                    260:     my $tryagain=$ENV{'form.tryagain'};
1.6       www       261: 
1.2       www       262: # -------------------------------------------------------- Generate Page Output
1.6       www       263: # --------------------------------------------------------------- Error Header?
1.2       www       264:     if ($error) {
                    265: 	$r->print("<h1>LON-CAPA Access Control</h1>");
1.4       www       266:         $r->print("<hr><pre>Access  : ".
                    267:                   Apache::lonnet::plaintext($priv)."\n");
                    268:         $r->print("Resource: $fn\n");
                    269:         $r->print("Action  : $msg\n</pre><hr>");
1.2       www       270:     } else {
1.25      www       271:         if ($ENV{'user.error.msg'}) {
                    272: 	    $r->print(
                    273:  '<h3><font color=red>You need to choose another user role or '.
                    274:  'enter a specific course for this function</font></h3>');
                    275: 	}
1.2       www       276:     }
1.6       www       277: # -------------------------------------------------------- Choice or no choice?
1.2       www       278:     if ($nochoose) {
1.6       www       279:         if ($advanced) {
1.55      albertel  280: 	    $r->print("<h2>Assigned User Roles</h2>\n");
1.6       www       281:         } else {
1.55      albertel  282: 	    $r->print("<h2>Sorry ...</h2>\nThis resource might be part of");
                    283: 	    if ($ENV{'request.course.id'}) {
                    284: 		$r->print(' another');
                    285: 	    } else {
                    286: 		$r->print(' a certain');
                    287: 	    } 
                    288: 	    $r->print(' course.</body></html>');
                    289: 	    return OK;
1.6       www       290:         } 
                    291:     } else {
                    292:         if ($advanced) {
1.55      albertel  293: 	    $r->print("Your home server is ".
                    294: 		      $Apache::lonnet::hostname{&Apache::lonnet::homeserver
                    295:                       ($ENV{'user.name'},$ENV{'user.domain'})}.
                    296: 		      "<br />\n");
                    297: 	    $r->print("Author and Co-Author roles may not be available on ".
                    298: 		      "servers other than your home server.");
1.6       www       299:         } else {
1.59      albertel  300: 	    $r->print("<h2>Select a Course to Enter</h2>\n");
1.17      www       301:         }
1.18      www       302:         if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
                    303:     	    $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
1.6       www       304:         }
1.11      www       305:         $r->print('<form method=post action="'.(($fn)?$fn:$r->uri).'">');
1.6       www       306:         $r->print('<input type=hidden name=orgurl value="'.$fn.'">');
                    307:         $r->print('<input type=hidden name=selectrole value=1>');
                    308:     }
1.63      www       309:     if ($ENV{'user.adv'}) {
                    310: 	$r->print(
                    311: 	      '<br />Show all roles: <input type="checkbox" name="showall"');
                    312: 	if ($ENV{'form.showall'}) { $r->print(' checked'); }
                    313: 	$r->print('><input type=submit value="Display">');
                    314:     }
1.6       www       315: # ----------------------------------------------------------------------- Table
1.63      www       316:     $r->print('<br /><table><tr>');
1.6       www       317:     unless ($nochoose) { $r->print('<th>&nbsp;</th>'); }
1.55      albertel  318:     $r->print('<th>User Role</th><th colspan=2>Extent</th>'.
                    319: 	      '<th>Start</th><th>End</th><th>Remark</th></tr>'."\n");
1.4       www       320: 
1.3       albertel  321:     foreach $envkey (sort keys %ENV) {
1.35      matthew   322:         my $button = 1;
1.49      www       323:         my $switchserver='';
1.2       www       324:         if ($envkey=~/^user\.role\./) {
1.40      matthew   325: 	    my (undef,undef,$role,@pwhere)=split(/\./,$envkey);
1.46      matthew   326:             next if (!defined($role) || $role eq '');
1.4       www       327:             my $where=join('.',@pwhere);
1.6       www       328:             my $trolecode=$role.'.'.$where;
1.4       www       329:             my ($tstart,$tend)=split(/\./,$ENV{$envkey});
                    330:             my $tremark='';
                    331:             my $tstatus='is';
                    332:             my $tpstart='&nbsp;';
                    333:             my $tpend='&nbsp;';
1.47      www       334:             my $tfont='#000000';
1.4       www       335:             if ($tstart) {
                    336: 		if ($tstart>$then) { 
1.35      matthew   337:                     $tstatus='future';
                    338:                     if ($tstart<$now) { $tstatus='will'; }
1.4       www       339:                 }
                    340:                 $tpstart=localtime($tstart);
                    341:             }
                    342:             if ($tend) {
1.23      www       343:                 if ($tend<$then) { 
1.35      matthew   344:                     $tstatus='expired'; 
1.23      www       345:                 } elsif ($tend<$now) { 
1.35      matthew   346:                     $tstatus='will_not'; 
1.23      www       347:                 }
1.4       www       348:                 $tpend=localtime($tend);
                    349:             }
1.6       www       350:             if ($ENV{'request.role'} eq $trolecode) {
                    351: 		$tstatus='selected';
                    352:             }
1.4       www       353:             my $tbg;
1.35      matthew   354:             if (($tstatus eq 'is') || ($tstatus eq 'selected') ||
                    355:                 ($ENV{'form.showall'})) {
                    356:                 if ($tstatus eq 'is') {
                    357:                     $tbg='#77FF77';
1.47      www       358:                     $tfont='#003300';
1.35      matthew   359:                 } elsif ($tstatus eq 'future') {
                    360:                     $tbg='#FFFF77';
1.49      www       361:                     $button=0;
1.35      matthew   362:                 } elsif ($tstatus eq 'will') {
                    363:                     $tbg='#FFAA77';
                    364:                     $tremark.='Active at next login. ';
                    365:                 } elsif ($tstatus eq 'expired') {
                    366:                     $tbg='#FF7777';
1.47      www       367:                     $tfont='#330000';
1.49      www       368:                     $button=0;
1.35      matthew   369:                 } elsif ($tstatus eq 'will_not') {
                    370:                     $tbg='#AAFF77';
                    371:                     $tremark.='Expired after logout. ';
                    372:                 } elsif ($tstatus eq 'selected') {
                    373:                     $tbg='#11CC55';
1.47      www       374:                     $tfont='#002200';
1.35      matthew   375:                     $tremark.='Currently selected. ';
                    376:                 }
                    377:                 my $trole;
                    378:                 if ($role =~ /^cr\//) {
                    379:                     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
                    380:                     $tremark.='<br>Defined by '.$rauthor.' at '.$rdomain.'.';
                    381:                     $trole=$rrole;
1.8       www       382:                 } else {
1.35      matthew   383:                     $trole=Apache::lonnet::plaintext($role);
                    384:                 }
                    385:                 my $ttype;
                    386:                 my $twhere;
                    387:                 my ($tdom,$trest,$tsection)=
                    388:                     split(/\//,Apache::lonnet::declutter($where));
                    389:                 # First, Co-Authorship roles
                    390:                 if ($role eq 'ca') {
1.39      stredwic  391:                     my $home = &Apache::lonnet::homeserver($trest,$tdom);
1.49      www       392:                     if ($home ne $r->dir_config('lonHostID')) {
                    393: 			$button=0;
1.51      www       394:                         $switchserver=&Apache::lonnet::escape('http://'.
                    395:                          $Apache::lonnet::hostname{$home}.
                    396:                          '/adm/login?domain='.$ENV{'user.domain'}.
                    397: 			  '&username='.$ENV{'user.name'}.
                    398:                           '&firsturl=/priv/'.$trest);
1.49      www       399:                     }
1.35      matthew   400:                     #next if ($home eq 'no_host');
                    401:                     $home = $Apache::lonnet::hostname{$home};
                    402:                     $ttype='Construction Space';
                    403:                     $twhere='User: '.$trest.'<br />Domain: '.$tdom.'<br />'.
                    404:                         ' Server:&nbsp;'.$home;
                    405:                     $ENV{'course.'.$tdom.'_'.$trest.'.description'}='ca';
                    406:                 } elsif ($role eq 'au') {
                    407:                     # Authors
                    408:                     my $home = &Apache::lonnet::homeserver
1.39      stredwic  409:                         ($ENV{'user.name'},$ENV{'user.domain'});
1.49      www       410:                     if ($home ne $r->dir_config('lonHostID')) {
                    411: 			$button=0;
1.51      www       412:                         $switchserver=&Apache::lonnet::escape('http://'.
                    413:                          $Apache::lonnet::hostname{$home}.
                    414:                           '/adm/login?domain='.$ENV{'user.domain'}.
                    415: 			   '&username='.$ENV{'user.name'}.
                    416:                            '&firsturl=/priv/'.$ENV{'user.name'});
1.49      www       417:                     }
1.35      matthew   418:                     #next if ($home eq 'no_host');
                    419:                     $home = $Apache::lonnet::hostname{$home};
                    420:                     $ttype='Construction Space';
                    421:                     $twhere='Domain: '.$tdom.'<br />Server:&nbsp;'.$home;
                    422:                     $ENV{'course.'.$tdom.'_'.$trest.'.description'}='ca';
                    423:                 } elsif ($trest) {
                    424:                     $ttype='Course';
                    425:                     if ($tsection) {
                    426:                         $ttype.='<br>Section/Group: '.$tsection;
1.37      albertel  427: 		    }
1.35      matthew   428:                     my $tcourseid=$tdom.'_'.$trest;
                    429:                     if ($ENV{'course.'.$tcourseid.'.description'}) {
1.47      www       430:                         $twhere=$ENV{'course.'.$tcourseid.'.description'};
                    431:                         unless ($twhere eq 'Currently not available') {
1.55      albertel  432: 			    $twhere.=' <font size="-2">'.
1.49      www       433:         &Apache::loncommon::syllabuswrapper('Syllabus',$trest,$tdom,$tfont).
                    434:                                     '</font>';
1.55      albertel  435: 			}
1.8       www       436:                     } else {
1.35      matthew   437:                         my %newhash=Apache::lonnet::coursedescription
                    438:                             ($tcourseid);
                    439:                         if (%newhash) {
1.49      www       440:                             $twhere=$newhash{'description'}.
                    441:                               ' <font size="-2">'.
                    442:         &Apache::loncommon::syllabuswrapper('Syllabus',$trest,$tdom,$tfont).
                    443:                               '</font>';
1.35      matthew   444:                         } else {
                    445:                             $twhere='Currently not available';
                    446:                             $ENV{'course.'.$tcourseid.'.description'}=$twhere;
                    447:                         }
1.8       www       448:                     }
1.37      albertel  449: 		    if ($role ne 'st') { $twhere.="<br />Domain:".$tdom; }
1.35      matthew   450:                 } elsif ($tdom) {
                    451:                     $ttype='Domain';
                    452:                     $twhere=$tdom;
                    453:                 } else {
                    454:                     $ttype='System';
                    455:                     $twhere='system wide';
1.13      www       456:                 }
1.35      matthew   457:  
                    458:                 $r->print('<tr bgcolor='.$tbg.'>');
                    459:                 unless ($nochoose) {
                    460:                     if (!$button) {
1.49      www       461: 			if ($switchserver) {
                    462: 			    $r->print('<td><a href="/adm/logout?handover='.
                    463:                               $switchserver.'">Switch Server</a></td>');
                    464:                         } else {
                    465:                             $r->print('<td>&nbsp;</td>');
                    466:                         }
1.35      matthew   467:                     } elsif ($tstatus eq 'is') {
                    468:                         $r->print('<td><input type=submit value=Select name="'.
                    469:                                   $trolecode.'"></td>');
1.61      www       470:                     } elsif ($tryagain) {
                    471:                         $r->print
                    472:                         ('<td><input type=submit value="Try Selecting Again"'.
                    473:                              ' name="'.$trolecode.'"></td>');
                    474:                     } elsif ($advanced) {
1.35      matthew   475:                         $r->print
                    476:                             ('<td><input type=submit value="Re-Initialize"'.
                    477:                              ' name="'.$trolecode.'"></td>');
                    478:                     } else {
                    479:                         $r->print('<td>&nbsp;</td>');
                    480:                     }
1.6       www       481:                 }
1.57      www       482:                 $tremark.=&Apache::lonannounce::showday(time,1,
                    483:                          &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
                    484:                 
1.55      albertel  485: 		$r->print('<td><font color="'.$tfont.'">'.$trole.
1.47      www       486:                       '</font></td><td><font color="'.$tfont.'">'.$ttype.
                    487:                       '</font></td><td><font color="'.$tfont.'">'.$twhere.
                    488:                       '</font></td><td><font color="'.$tfont.'">'.$tpstart.
                    489:                       '</font></td><td><font color="'.$tfont.'">'.$tpend.
                    490:                       '</font></td><td><font color="'.$tfont.'">'.$tremark.
                    491:                       '&nbsp;</font></td></tr>'."\n");
1.55      albertel  492: 	    }
1.4       www       493:         }
                    494:     }
1.14      www       495:     my $tremark='';
1.47      www       496:     my $tfont='#003300';
1.14      www       497:     if ($ENV{'request.role'} eq 'cm') {
1.19      www       498: 	$r->print('<tr bgcolor="#11CC55">');
1.14      www       499:         $tremark='Currently selected.';
1.47      www       500:         $tfont='#002200';
1.14      www       501:     } else {
                    502:         $r->print('<tr bgcolor="#77FF77">');
                    503:     }
                    504:     unless ($nochoose) {
1.55      albertel  505: 	if ($ENV{'request.role'} ne 'cm') {
                    506: 	    $r->print('<td><input type=submit value=Select name="cm"></td>');
                    507: 	} else {
                    508: 	    $r->print('<td>&nbsp;</td>');
                    509: 	}
1.14      www       510:     }
1.47      www       511:     $r->print('<td colspan=5><font color="'.$tfont.'">No role specified'.
                    512:       '</font></td><td><font color="'.$tfont.'">'.$tremark.
                    513:       '&nbsp;</font></td></tr>'."\n");
1.4       www       514: 
                    515:     $r->print('</table>');
                    516:     unless ($nochoose) {
                    517: 	$r->print("</form>\n");
                    518:     }
1.22      harris41  519: # ------------------------------------------------------------ Privileges Info
1.55      albertel  520:     if (($advanced) && (($ENV{'user.error.msg'}) || ($error))) {
                    521: 	$r->print('<hr><h2>Current Privileges</h2>');
1.4       www       522: 
1.55      albertel  523: 	foreach $envkey (sort keys %ENV) {
                    524: 	    if ($envkey=~/^user\.priv\.$ENV{'request.role'}\./) {
                    525: 		my $where=$envkey;
                    526: 		$where=~s/^user\.priv\.$ENV{'request.role'}\.//;
                    527: 		my $ttype;
                    528: 		my $twhere;
                    529: 		my ($tdom,$trest,$tsec)=
                    530: 		    split(/\//,Apache::lonnet::declutter($where));
                    531: 		if ($trest) {
                    532: 		    if ($ENV{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') {
                    533: 			$ttype='Construction Space';
                    534: 			$twhere='User: '.$trest.', Domain: '.$tdom;
                    535: 		    } else {
                    536: 			$ttype='Course';
                    537: 			$twhere=$ENV{'course.'.$tdom.'_'.$trest.'.description'};
                    538: 			if ($tsec) {
                    539: 			    $twhere.=' (Section/Group: '.$tsec.')';
                    540: 			}
                    541: 		    }
                    542: 		} elsif ($tdom) {
                    543: 		    $ttype='Domain';
                    544: 		    $twhere=$tdom;
                    545: 		} else {
                    546: 		    $ttype='System';
                    547: 		    $twhere='/';
                    548: 		}
                    549: 		$r->print("\n<h3>".$ttype.': '.$twhere.'</h3><ul>');
                    550: 		foreach (sort split(/:/,$ENV{$envkey})) {
                    551: 		    if ($_) {
                    552: 			my ($prv,$restr)=split(/\&/,$_);
                    553: 			my $trestr='';
                    554: 			if ($restr ne 'F') {
                    555: 			    my $i;
                    556: 			    $trestr.=' (';
                    557: 			    for ($i=0;$i<length($restr);$i++) {
                    558: 				$trestr.=
                    559: 			       Apache::lonnet::plaintext(substr($restr,$i,1));
                    560: 				if ($i<length($restr)-1) { $trestr.=', '; }
                    561: 			    }
                    562: 			    $trestr.=')';
                    563: 			}
                    564: 			$r->print('<li>'.
                    565: 				  Apache::lonnet::plaintext($prv).$trestr.
                    566: 				  '</li>');
                    567: 		    }
                    568: 		}
                    569: 		$r->print('</ul>');
                    570: 	    }
                    571: 	}
1.4       www       572:     }
1.65    ! www       573:     if ($advanced) {
        !           574: 	$r->print('<p><small><i>This is LON-CAPA '.
        !           575: 		  $r->dir_config('lonVersion').'</i></small></p>');
        !           576:     }
1.1       harris41  577:     $r->print("</body></html>\n");
                    578:     return OK;
                    579: } 
                    580: 
                    581: 1;
                    582: __END__
1.32      harris41  583: 
                    584: =head1 NAME
                    585: 
                    586: Apache::lonroles - User Roles Screen
                    587: 
                    588: =head1 SYNOPSIS
                    589: 
                    590: Invoked by /etc/httpd/conf/srm.conf:
                    591: 
                    592:  <Location /adm/roles>
                    593:  PerlAccessHandler       Apache::lonacc
                    594:  SetHandler perl-script
                    595:  PerlHandler Apache::lonroles
                    596:  ErrorDocument     403 /adm/login
                    597:  ErrorDocument	  500 /adm/errorhandler
                    598:  </Location>
1.64      bowersj2  599: 
                    600: =head1 OVERVIEW
                    601: 
                    602: =head2 Choosing Roles
                    603: 
                    604: C<lonroles> is a handler that allows a user to switch roles in
                    605: mid-session. LON-CAPA attempts to work with "No Role Specified", the
                    606: default role that a user has before selecting a role, as widely as
                    607: possible, but certain handlers for example need specification which
                    608: course they should act on, etc. Both in this scenario, and when the
                    609: handler determines via C<lonnet>'s C<&allowed> function that a certain
                    610: action is not allowed, C<lonroles> is used as error handler. This
                    611: allows the user to select another role which may have permission to do
                    612: what they were trying to do. C<lonroles> can also be accessed via the
                    613: B<CRS> button in the Remote Control. 
                    614: 
                    615: =begin latex
                    616: 
                    617: \begin{figure}
                    618: \begin{center}
                    619: \includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
                    620:   \caption{\label{Sample_Roles_Screen}Sample Roles Screen} 
                    621: \end{center}
                    622: \end{figure}
                    623: 
                    624: =end latex
                    625: 
                    626: =head2 Role Initialization
                    627: 
                    628: 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  629: 
                    630: =head1 INTRODUCTION
                    631: 
                    632: This module enables a user to select what role he wishes to
                    633: operate under (instructor, student, teaching assistant, course
                    634: coordinator, etc).  These roles are pre-established by the actions
                    635: of upper-level users.
                    636: 
                    637: This is part of the LearningOnline Network with CAPA project
                    638: described at http://www.lon-capa.org.
                    639: 
                    640: =head1 HANDLER SUBROUTINE
                    641: 
                    642: This routine is called by Apache and mod_perl.
                    643: 
                    644: =over 4
                    645: 
                    646: =item *
                    647: 
                    648: Roles Initialization (yes/no)
                    649: 
                    650: =item *
                    651: 
                    652: Get Error Message from Environment
                    653: 
                    654: =item *
                    655: 
                    656: Who is this?
                    657: 
                    658: =item *
                    659: 
                    660: Generate Page Output
                    661: 
                    662: =item *
                    663: 
                    664: Choice or no choice
                    665: 
                    666: =item *
                    667: 
                    668: Table
                    669: 
                    670: =item *
                    671: 
                    672: Privileges
                    673: 
                    674: =back
                    675: 
                    676: =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.